آیا می توان فونت وسایر MainMenu را عوض کرد؟

**ali_abbasi22145** · یک شنبه 05 شهریور 1385, 16:19 عصر

سلام
آیا می توان فونت وسایر MainMenu را عوض کرد؟

**Mahyaa** · دوشنبه 06 شهریور 1385, 10:40 صبح

سلام

رویداد OnAdvanceDrawItems و OnMeasureItem تمام MenuItem ها رو به دو Procedure زیر Link کنید :
این تایپ توی کد رو هم به قسمت type اضافه کنید :



type

  TMyMenuItem = class(TMenuItem);

 

//--------------------------------

 

 

 

procedure TForm1.MeasureItem(Sender: TObject; ACanvas: TCanvas;

  var Width, Height: Integer);

var

  OldMeasureItem: TMenuMeasureItemEvent;

begin

  with (Sender as TMenuItem) do

  begin

    OldMeasureItem := OnMeasureItem;

    OnMeasureItem := nil;

    ACanvas.Font.Name := 'Courier New';

    ACanvas.Font.Size := 14;

    TMyMenuItem(Sender).MeasureItem(ACanvas, Width, Height);

    OnMeasureItem := OldMeasureItem;

  end;

end;

 

//--------------------------------

 

procedure TForm1.AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;

  ARect: TRect; State: TOwnerDrawState);

var 

  OldAdvancedDrawItem: TAdvancedMenuDrawItemEvent; 

begin 

  with Sender as TMenuItem do 

  begin 

    OldAdvancedDrawItem := OnAdvancedDrawItem; 

    OnAdvancedDrawItem := nil; 

    ACanvas.Font.Name := 'Comic Sans MS';

    ACanvas.Font.Size := 14;

    DrawMenuItem(TMenuItem(Sender), ACanvas, ARect, State);

    OnAdvancedDrawItem := OldAdvancedDrawItem; 

  end; 

end;