Delphi - Kör alakú áttetsző analóg óra készítése

forráskód letöltése
Az aktuális időt ugyan kijelzi számunkra az operációs rendszer, de aki ragaszkodik az analóg formához, annak hasznos lehet a most bemutatásra kerülő program. Készítünk ugyanis egy analóg órát, mely egy kör alakú Form-on foglal helyet, és azért, hogy ne legyen zavaró a képernyőn, némi áttetszőséget is adunk neki.
Figyelem! Áttetsző ablakot csak a Windows 2000/XP operációs rendszerek képesek megjeleníteni!
Először nézzük meg, hogyan is tudjuk a négyzet alakú Form-ot átalakítani körré. Létre kell hoznunk egy kör alakú régiót, majd mindezt rá kell „húznunk” a Form-unkra. Mindezt az OnCreate esemény létrejöttekor végezzük el.
procedure TForm1.FormCreate(Sender: TObject);
Var
  R       : TRect;
  Len2    : integer;
begin
   hRegion := 0;
Meghatározzuk a Form középpontjának koordinátáját, ami egyben az óra középpontja is lesz.
   X0 := ClientWidth div 2;
   Y0 := ClientHeight div 2;
   if X0<Y0 then
     Len := X0 * 9 div 10
   else
     Len := Y0 * 9 div 10;
   CurrentTime := Time;
   Len2 := len * 10 div 9;
Meghatározzuk a TRect típusú terület széleinek koordinátáit.
   R.Top    := Y0 - Len2;
   R.Bottom := Y0 + Len2;
   R.Left   := X0 - Len2;
   R.Right  := X0 + Len2;
Az ellipszis (kör) alakú területet a CreateEllipticRgnIndirect függvénnyel hozzuk létre. Ezután a SetWindowRgn meghívásával tudjuk hozzárendelni azt a Form-hoz.
   hRegion := CreateEllipticRgnIndirect(R);
   SetWindowRgn(handle, hRegion, true);
end;
Az így elkészült körre kirajzolunk 12 db referenciapontot, melyek az órákat szimbolizálják. Mindezt a Form OnPaint eseményében tesszük.
procedure TForm1.FormPaint(Sender: TObject);
Var
   X1, Y1, i : integer;
   Angle     : double;
begin
  Canvas.Brush.Color:=clRed;
  Canvas.Pen.Mode := pmXor;
  Canvas.Pen.Color := clGreen;
  for i:=1 to 12 do
    begin
      Angle := i * 2 * Pi / 12;
Az egyes referenciapontok középpontjának koordinátáit az X1,Y1 változókban tároljuk el. Ezekbe a pontokba kirajzolunk egy-egy 8 pixel oldalú kis négyzetet.
      X1 := trunc(X0 + Len * Sin(Angle));
      Y1 := trunc(Y0 - Len * Cos(Angle));
      Canvas.Rectangle(X1-4,Y1-4,X1+4,Y1+4)
    end;
  Canvas.Pen.Mode := pmCopy;
  Canvas.Pen.Color := clBlack;
end;
Készítünk egy DrawWatchHand nevű függvényt, mely az egyes óramutatók kirajzolását végzi.
procedure TForm1.DrawWatchHand;
Var
  X1, Y1      : integer;
  H, M, S, MS : Word;
  Angle       : Double;
begin
Először a DecodeTime függvény segítségével felbontjuk az aktuális időt óra, perc, másodperc részekre.
  DecodeTime(CurrentTime, H, M, S, MS);
Először a másodpercmutatót rajzoljuk ki. Az S változóban az aktuális másodperc érték van eltárolva. Ennek segítségével kiszámítjuk a másodpercmutató körvonal menti koordinátáit is az X1 és Y1 változókba. Ezután a kör középpontjától (X0,Y0) rajzolunk egy vonalat az X1,Y1 koordináták által meghatározott pontba.
  Canvas.MoveTo(X0, Y0);
  Angle := S * 2 * Pi / 60;
  X1 := trunc(X0 + 9*Len * Sin(Angle)/10);
  Y1 := trunc(Y0 - 9*Len * Cos(Angle)/10);
  Canvas.LineTo(X1, Y1);
Hasonlóképpen végezzük el a perc és óramutatók kirajzolását is, ügyelve a mutatók megfelelő hosszára.
  Canvas.MoveTo(X0, Y0);
  Angle := M * 2 * Pi / 60;
  X1 := trunc(X0 + 3*Len * Sin(Angle)/4);
  Y1 := trunc(Y0 - 3*Len * Cos(Angle)/4);
  Canvas.LineTo(X1, Y1);
  Canvas.MoveTo(X0, Y0);
  Angle := H * 2 * Pi / 12;
  X1 := trunc(X0 + Len * Sin(Angle)/2);
  Y1 := trunc(Y0 - Len * Cos(Angle)/2);
  Canvas.LineTo(X1, Y1);
end;
Az óramutatók kirajzolását folyamatosan frissíteni kell, ezért másodpercenként újrarajzoljuk azokat. Ehhez el kell helyeznünk egy Timer komponenst a Form-on, melynek intervallumát 1 másodpercre állítjuk. Ennek OnTimer eseményében először a Form háttérszínével megegyező színnel „letöröljük” a mutatókat, majd vörös színnel kirajzoljuk az aktuális időnek megfelelőket.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Canvas.Pen.Color := $00EDCF92;
   DrawWatchHand;
   CurrentTime := Time;
   Canvas.Pen.Color := clRed;
   DrawWatchHand;
end;
Mivel az óránk nem rendelkezik fejléccel, ezért meg kell oldanunk, hogy az mozgatható legyen. A komponensnek figyelnie kell, hogy mikor történik a területén az egér gomb lenyomása. Ehhez a MouseDown eljárást kell felülírnunk. Amennyiben azt tapasztaljuk, hogy bal gomb került lenyomásra, akkor kell küldenünk a Form-nak egy WM_SYSCOMMAND üzenet, melynek paraméterként a MOVE paranccsal megegyező hexadecimális értéket adunk. Az üzenet küldése előtt meg kell még hívnunk a ReleaseCapture eljárást, különben nem keletkezne további egérüzenet.
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(wm_Syscommand, $f012, 0)
end;
Végül nem marad más dolgunk, minthogy óránkat áttetszővé tegyük. A Delphi 6-os verziójától ez a funkció már könnyedén megtehető a Form AlphaBlend tulajdonságának beállításával, azonban régebbi verziók esetén ez nem működik. Ezért a következő megoldást kell alkalmaznunk.
constructor TForm1.Create(AOwner: TComponent);
var vi : _OSVERSIONINFO;
      oldStyle : DWORD;
begin
    inherited Create(AOwner);
Először megvizsgáljuk, hogy milyen operációs rendszeren futtatják a programunkat. Erre azért van szükség, mert a Windows 2000/XP-n kívül más Windows verziók nem tudják megjeleníteni az áttetsző ablakokat.
    GetVersionEx(vi);
    if vi.dwMajorVersion >= 5 then 
Amennyiben Windows 2000/XP-vel van dolgunk, meghívjuk a SetLayeredWindowAttributes függvényt, melyben az aktuális ablak tulajdonságait tudjuk beállítani. Itt az ALPHA_VALUE értékben határozhatjuk meg az áttetszőség mértékét (0-255). Minél kisebbre állítjuk ezt az értéket, annál áttetszőbb lesz az ablakunk.
    begin
      oldStyle := GetWindowLong(Self.Handle, GWL_EXSTYLE);
      SetWindowLong(Self.Handle, GWL_EXSTYLE, oldStyle or
        WS_EX_LAYERED);
      SetLayeredWindowAttributes(Self.Handle, clBlack, ALPHA_VALUE,
        LWA_ALPHA);
A RedrawWindow függvény segítségével újrarajzoljuk az ablakot.
      RedrawWindow(Self.Handle, nil, 0,
          RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
    end;
end;