MainMenu modifiye

[hido]

Merhaba,

MainMenu height değerini değiştirme ve mouse mainmenu bulunan linkke gelince cursora crHandPoint özellik vermek istiyorum araştırdım bulamadım bu konuda ne yapailirim...

[greenegitim]

bu şekilde bir görüntü için aşağıdaki kodu kullanmıştım

Kod: Tümünü seç

Procedure Tfrm_Faturalar.MeasureMenuitem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  mnu: TMenuitem;
begin
  mnu := Sender As TMenuitem;
  aCanvas.font.name := 'Arial';
  aCanvas.font.size := mnu.tag;
  width := aCanvas.TextWidth( mnu.caption )+25;
  height := aCanvas.TextHeight( mnu.caption ) + 4;
end;

procedure Tfrm_Faturalar.DrawMenuItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  mnu: TMenuitem;
begin
  mnu := Sender As TMenuitem;
  aCanvas.font.name := 'Arial';
  aCanvas.font.size := mnu.tag;
  If selected then begin
    aCanvas.font.color := clRed;
    aCanvas.brush.color := clAqua;
  end
  else begin
    aCanvas.font.color := clRed;
    aCanvas.brush.color := $C0FFFF;
  end;
  acanvas.brush.style := bsSolid;
  aCanvas.fillrect( aRect );
  acanvas.textrect( aRect, arect.left+4, arect.top+2, mnu.caption );
end;

[hido]

Hocam kodlamayı kendime göre uyarladım run yapınca herhangi hata vermiyor fakat form show eklediğim (sender) takılıyor.
xe5 kullanıyorum...


form show:

Kod: Tümünü seç

procedure TForm3.FormShow(Sender: TObject);
begin
    MainMenuUyarla(Sender);
    MeasureMenuitem(Sender);
end;

type:

Kod: Tümünü seç

    Procedure MeasureMenuitem(Sender: TObject; ACanvas: TCanvas;
      var Width, Height: Integer);
    procedure DrawMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);

Kod: Tümünü seç

Procedure TForm3.MeasureMenuitem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  mnu: TMenuitem;
begin
  mnu := Sender As TMenuitem;
  ACanvas.font.name := 'Arial';
  ACanvas.font.size := mnu.tag;
  Width := ACanvas.TextWidth(mnu.caption) + 25;
  Height := ACanvas.TextHeight(mnu.caption) + 4;
end;

Kod: Tümünü seç

procedure TForm3.DrawMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
var
  mnu: TMenuitem;
begin
  mnu := Sender As TMenuitem;
  ACanvas.font.name := 'Arial';
  ACanvas.font.size := mnu.tag;
  If Selected then
  begin
    ACanvas.font.color := clRed;
    ACanvas.brush.color := clAqua;
  end
else
begin
  ACanvas.font.color := clRed;
  ACanvas.brush.color := $C0FFFF;
end;
ACanvas.brush.style := bsSolid;
ACanvas.fillrect(ARect);
ACanvas.textrect(ARect, ARect.left + 4, ARect.top + 2, mnu.caption);
end;

[mrmarman]

Bu linki incele. Muhtemelen ownerdraw özelliğini açmamışsındır.

[ikra]

formun onshow metodundaki sender formun kendisi dir. menuitem degil.
yukaridaki kodda ise

Kod: Tümünü seç

sender as TMenuItem

seklinde kullanmissin. Bu sekilde pointer hatasi alirsin.

[3ddark]

Kod: Tümünü seç

procedure TForm3.FormShow(Sender: TObject);
begin
    MainMenuUyarla(Sender);
    MeasureMenuitem(Sender);

//üstteki satırların yerine bunları kullanırsan olacaktır.
    MainMenuUyarla(MainMenuUyarla);
    MeasureMenuitem(MeasureMenuitem);
end;

ikra hocanın dediği gibi formshow anında şu şekilde yazarsan sorunsuz açılacaktır.
FormShow Sender parametresi zaten TForm3'ün bilgisi yani TForm tipinden oluyor. Buda TMenuItem sınıfından bir bilgi degil. Haliyle senin alttaki kodda gelen Sender bilgisi aslında TForm ama sen TForm'u TMenuItem olarak kullanmaya çalışıyorsun.

Kod: Tümünü seç

mnu := Sender As TMenuitem;