Menu jak w Office XP

Trochę mi się nudziło, więc sobie napisałem małą procedurkę przekształcającą mainmenu i popupmenu na podobne do tych znanych z Office'a XP.

procedure rysuj(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
const
x=6;
y=6;
begin
if TMenuItem(Sender).Tag=1 then
begin
if selected then
begin
acanvas.Brush.Color:=15651521;
acanvas.Pen.Color:=12937777;
acanvas.Rectangle(arect.Left+1, arect.Top+1, arect.Right-1, arect.Bottom);
end
else
begin
acanvas.Brush.Color:=14609903;
acanvas.Pen.Color:=14609903;
acanvas.Rectangle(arect.Left+1, arect.Top+1, arect.Right, arect.Bottom+1);
acanvas.Brush.Color:=16777215;
acanvas.Pen.Color:=16777215;
acanvas.Rectangle(arect.Left+19, arect.Top+1, arect.Right, arect.Bottom);
end;
if TMenuItem(Sender).Checked then
begin
acanvas.Pen.Color:=0;
acanvas.MoveTo(x, arect.Top+y+2);
acanvas.LineTo(x, arect.Top+y+5);
acanvas.MoveTo(x+1, arect.Top+y+3);
acanvas.LineTo(x+1, arect.Top+y+6);
acanvas.MoveTo(x+2, arect.Top+y+4);
acanvas.LineTo(x+2, arect.Top+y+7);
acanvas.MoveTo(x+3, arect.Top+y+3);
acanvas.LineTo(x+3, arect.Top+y+6);
acanvas.MoveTo(x+4, arect.Top+y+2);
acanvas.LineTo(x+4, arect.Top+y+5);
acanvas.MoveTo(x+5, arect.Top+y+1);
acanvas.LineTo(x+5, arect.Top+y+4);
acanvas.MoveTo(x+6, arect.Top+y+0);
acanvas.LineTo(x+6, arect.Top+y+3);
end;
acanvas.Brush.Style:=bsclear;
acanvas.Font.Color:=0;
acanvas.TextOut(23, arect.Top+3, TMenuItem(Sender).caption);
acanvas.Pen.Color:=0;
acanvas.Rectangle(0, 0, arect.Right, height);
acanvas.Brush.Style:=bssolid;
end;
if TMenuItem(Sender).Tag=2 then
begin
if selected then
begin
acanvas.Brush.Color:=15651521;
acanvas.Pen.Color:=12937777;
acanvas.Rectangle(arect.Left+1, arect.Top+1, arect.Right-1, arect.Bottom-1);
end
else
begin
acanvas.Brush.Color:=14609903;
acanvas.Pen.Color:=14609903;
acanvas.Rectangle(arect.Left+1, arect.Top+1, arect.Right, arect.Bottom+1);
acanvas.Brush.Color:=16777215;
acanvas.Pen.Color:=16777215;
acanvas.Rectangle(arect.Left+19, arect.Top+1, arect.Right, arect.Bottom);
end;
if TMenuItem(Sender).Checked then
begin
acanvas.Pen.Color:=0;
acanvas.MoveTo(x, arect.Top+y+2);
acanvas.LineTo(x, arect.Top+y+5);
acanvas.MoveTo(x+1, arect.Top+y+3);
acanvas.LineTo(x+1, arect.Top+y+6);
acanvas.MoveTo(x+2, arect.Top+y+4);
acanvas.LineTo(x+2, arect.Top+y+7);
acanvas.MoveTo(x+3, arect.Top+y+3);
acanvas.LineTo(x+3, arect.Top+y+6);
acanvas.MoveTo(x+4, arect.Top+y+2);
acanvas.LineTo(x+4, arect.Top+y+5);
acanvas.MoveTo(x+5, arect.Top+y+1);
acanvas.LineTo(x+5, arect.Top+y+4);
acanvas.MoveTo(x+6, arect.Top+y+0);
acanvas.LineTo(x+6, arect.Top+y+3);
end;
acanvas.Brush.Style:=bsclear;
acanvas.Font.Color:=0;
acanvas.TextOut(23, arect.Top+3, TMenuItem(Sender).caption);
acanvas.Pen.Color:=0;
acanvas.Rectangle(0, 0, arect.Right, arect.Bottom);
acanvas.Brush.Style:=bssolid;
end;
if TMenuItem(Sender).Tag=3 then
begin
if selected then
begin
acanvas.Brush.Color:=15651521;
acanvas.Pen.Color:=12937777;
acanvas.Rectangle(arect.Left, arect.Top, arect.Right, arect.Bottom);
end
else
begin
acanvas.Brush.Color:=14609903;
acanvas.Pen.Color:=14609903;
acanvas.Rectangle(arect.Left, arect.Top, arect.Right, arect.Bottom);
end;
acanvas.Brush.Style:=bsclear;
acanvas.Font.Color:=0;
acanvas.TextOut(arect.Left+6, arect.Top+3, TMenuItem(Sender).caption);
acanvas.Brush.Style:=bssolid;
end;
end;

A to trzeba dać w oncreate:

var
i:integer;
begin
for i:=0 to ComponentCount-1 do
if (Tmenuitem(Components[i]).Tag=1) or (Tmenuitem(Components[i]).Tag=2) or (Tmenuitem(Components[i]).Tag=3) then
begin
Tmenuitem(Components[i]).OnDrawItem:=rysuj;
if (TMenuItem(Components[i]).caption[length(TMenuItem(Components[i]).caption)]&lt&gt' ') and (Tmenuitem(Components[i]).Tag&lt&gt3) then
TMenuItem(Components[i]).caption:=TMenuItem(Components[i]).caption+' ';
end;

I teraz dajemy dla TMenuItem wartość Tag=1 jeśli jest to zwykły item, Tag=2 jeśli to jest zwykły item umiejscowiony na samym dole menu, Tag=3 jeśli item jest nagłówkiem w mainmenu (np. plik, edycja, itd.). Oczywiście wartość OwnerDraw TPopupMenu lub TMainMenu ustawiamy na true, a wartość AutoHotKeys na maManual. Nie wiem czy komuś sie to przyda, ale jak już mówiłem, nudziło mi się :)---------------------------
Delphi 6

Pozdrówka

huh, ale się napisałeś! gratulacje! Le ja mimo wszystko wolę używać komponentu XPMenu (daje trochę więcej mozliwości). Ale i tak podziwiam, za taką procedurę!--Pozdrawiam
Ktos :)

Aż tak dużo to się nie napisałem, głównie ctrl+c i ctrl+v. A tak swoją drogą, to komponent XPMenu nie chce mi działać (przy delphi 6) :(---------------------------
Delphi 6

Pozdrówka

Nie działa. Nie mam komponentu XPMenu bo mam Delphi 6 Personal --Darth Vader

dziwne, ja mam Delphi 6 Personal i XPMenu działa bez zarzutu. Może dlatego że z Chipa?
--Pozdrawiam
Ktos :)