Смена шрифтов

[Vasyatka]

Салют! Подскажите, плиз, ответ на такой вопрос. Есть прога с кучей компонентов, есть возможность менять шрифт всех из них, кроме меню и вплывающих подсказок (например, подсказка для кнопки). Как сделать смену шрифта для этих "штук"?

[Wiggle]

Компонент.Font.(Color | Name | Size), если я тебя правильно понял...

[Vasyatka]

нет не правильно. это свойство я использую для всех компонентов, кроме меню у него это свойство, где? тоже самое с подсказкой для кнопки

[RSLoader]

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;
type
  TMyHintWindow = class(THintWindow)
     constructor Create(AOwner: TComponent); override;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure N1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
constructor TMyHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Canvas.Font.Size:=Canvas.Font.Size+5;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass:=TMyHintWindow;
  Application.ShowHint:=False;
  Application.ShowHint:=True;
end;
procedure TForm1.N1DrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin 
  MainMenu1.OwnerDraw:=True;
  with ACanvas do
  begin
    Font.Color:=clRed;
    if Selected then
    begin
      Font.Color:=clRed;
      Brush.Color:=clGreen;
    end
    else
    begin
      Font.Color:=clGreen;
      Brush.Color:=clRed;
    end;
    Rectangle(ARect);
    TextOut(ARect.Left,ARect.Top,(Sender as TMenuItem).Caption);
  end;
end;
end.

Не забудь предварительно выставить свойство MainMenu OwnerDraw:=True;

[Vasyatka]

Спасибо! Я нечто делала с меню, а тут еще и подсказки!!!!

[Vasyatka]

Пункты меню - получились, НО, вот что странно. До прорисовки пункты меню "третьей иерархии" отражались нормально, например Путь1, а после прорисовки эти надписи странные - Путь&1. Почему? И как это исправить? (именно третья ступень меню)
А вот с подсказками не получилось. . Никак не реагирует на смену шрифта подсказка к кнопке. Почему?
И еще, как изменить шрифт заголовка формы? Он тоже не меняется...

[Voland]

Рисовать текст лучше функцией DrawText, она эти & заменит на подчёркивания букв. Ну или используй StripHotkey чтобы их вырезать. Вообще-то отрисовать пункт меню по всем правилам - целая наука. Я как-то написал простенький модуль для альтернативной отрисовки меню, если надо, могу выложить (правда у меня там шрифт не меняется, но добавить несложно).

Насчёт заголовка формы - просто так не изменишь. Опять же, надо всё самому отрисовывать будет, перехватывая сообщение WM_NCPAINT.

[Vasyatka]

Спасибо! Voland, если можете, скинте мне е-mail

[Voland]

Лучше здесь напишу, может ещё кому пригодится.

Вобщем... После многочисленных экспериментов и долгого изучения исходников VCL, я выяснил следующее:
1. Для смены шрифта меню предусмотрен стандартный способ: объект Screen.MenuFont Он влияет только если у меню OwnerDraw:=True
2. Сменить щрифт на всплывающих подсказках можно аналогичным способом: Screen.HintFont С этим никаких проблем нет.
3. Изменить ВЫСОТУ пунктов меню верхнего уровня (то есть строки меню) не удаётся никак. Поэтому, если установить размер шрифта больше системного, строка меню будет отрисовываться неправильно.

Поэтому в своём модуле я сделал так, что пункты верхнего уровня рисуются стандартным шрифтом, а остальные - заданным.

Как пользоваться:

...
implementation

uses FontAMD;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  MenuDrawer.AssignToMenu(MainMenu1);  // <-- при необходимости вызываем этот метод для каждого меню
end;
...

Чтобы использовать нестандартный шрифт, устанавливаем MenuDrawer.UseFont:=True и меняем MenuDrawer.Font
Кому интересно - почитайте исходник, прокомментируйте.