Animowana pozycja w menu

Sposób na zrobienie animacji w menu (nie chodzi tu o animacje całego menu, a tylko jednej pozycji).

Na formularz wstawiamy MainMenu1:TMainMenu, Timer1:TTimer. MainMenu.OwnerDraw ustawiamy na true, oraz interwał timera na ok 400.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    gfdg1: TMenuItem;
    gdfg1: TMenuItem;
    Timer1: TTimer;
    ddd1: TMenuItem;
    dddd1: TMenuItem;
    dfsd1: TMenuItem;
    fsdf1: TMenuItem;
    procedure gdfg1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  protected
    zaznaczony:boolean;
    naszemenu:boolean;
    MenuHandle:THandle;
    MenuRect:TRect;
    MenuText:String;
    procedure WndProc(var Message: TMessage) ; override;
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WndProc(var Message: TMessage);
begin
   case message.Msg of
     WM_EXITMENULOOP :
       naszemenu := false;
     WM_MENUSELECT :
       zaznaczony :=  gdfg1.Command = loword(message.WParam);
   end;
   inherited;
end;

procedure TForm1.gdfg1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; State: TOwnerDrawState);
begin
  MenuRect := ARect;
  MenuHandle :=  WindowFromDC(ACanvas.Handle);
  naszemenu := true;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
 naszemenu := false;
 MenuText := 'menu animowane w delphi';
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
 i:integer;
 l,s:integer;
 c:byte;
 MenuCanvas:TCanvas;
begin
   if not naszemenu then exit;


   //mozna IsWIndow
   MenuCanvas := TCanvas.Create();
   try

   MenuCanvas.Handle := GetDC(MenuHandle);

   if zaznaczony then
       MenuCanvas.Brush.Color := clRed
   else
       MenuCanvas.Brush.Color := clLime;
   MenuCanvas.FillRect(MenuRect);
   //duze litery ascii (65 - 90)
   l := 1;
   s := length(MenuText);

   for i:=1 to s do
   begin
     c := ord(MenuText[i]);
     if (c>=65) and (c<=90) then
     begin
       l:= i;
       break;
     end;
   end;
   MenuText[l] := LowerCase(MenuText[l])[1];
   if (l=s) then l := 1 else
   begin
    repeat
    l:=l+1;
    until MenuText[l] <> ' ';

   end;
   MenuText[l] := UpperCase(MenuText[l])[1];

   if not naszemenu then exit;
   MenuCanvas.TextOut(MenuRect.Left,MenuRect.Top,MenuText);
   except
     //lapiemy

     //  EInvalidOperation  'Canvas does not allow drawing'

     //dobrym rozwiazaniem bylo by dziedziczenie po Canvas i zawsze kontrola czy mozna malowac jak nie
     //to ominac. Po prostu timer dziala a menu juz nie ma ...

   end;

   MenuCanvas.Free;
end;

end.

Pełen kod źródłowy:
http://rudy.mif.pg.gda.pl/~reichel/down.php?id=250