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

Kategoria: Delphi » Gotowce

2 komentarze

Avatar: reichel
Napisany 2008-01-23 17:47 przez reichel

Domyslam sie ze problem byl w incjacji zmiennej (kilknelem na menu a nie forme ...)

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

i zmienna naszemenu byla ustawiona na true (u mnie na false ale ...) a uchwyt ustawial sie na zero okna - zetem pulpit.

Avatar: AdamP
Napisany 2008-01-22 15:52 przez AdamP

mi pojawia sie pasek z animacją w lewym górym rogu ekranu, dopiero za drugim razem jak wejde w menu pojawia się na miejscu

Facebook
4programmers.net