Pascal: Mutatós óra

Semmi különös, csak egy mutatós(analóg) óra.

GDI+ unitok letöltése

{$MODE DELPHI}
{$APPTYPE GUI}
program aclock;

uses
Windows, SysUtils, DateUtils, Math,
// Itt használatba vesszük a windows GDI+ könyvtárát, hogy bizonyos
// helyeken elkerüljük a lépcsőhatást.
// Ezek a unitok nincsenek benne FPC-ben.
GDIPAPI, GDIPOBJ;
const
STitle = ‘Óra’;
SWinClass = ‘myclock’;

var
hAppWin: HWND;
hfontClock: HFONT;
// Az óralap sugara.
Radius: Longword = 300;

procedure SetFontSize(size: Integer);
var
lf: TLogFont;
begin
GetObject(hfontClock, SizeOf(lf), @lf);
lf.lfHeight := -(size * GetDeviceCaps(GetDC(0), LOGPIXELSY) div 72);
DeleteObject(hfontClock);
hfontClock := CreateFontIndirect(lf);
end;

// Kirajzolja az órát a dc eszközkapcsolatba.
procedure DrawClock(dc: HDC);
const
// Egy foknak megfeleló radián.
Rad = Pi / 180;

var
gr: TGPGraphics;
pen: TGPPen;

// Vonalat forgat az óralap középtengelye körül.
procedure RotateLine(deg: Single; FromY, ToY: Single);
begin
// Beállitjuk a világ transzformációs mátrixot az óralap közepére,
// vagyis hát ott lesz az origó.
gr.TranslateTransform(Radius, Radius);

// Itt elforgatjuk deg fokkal a vonalat…
gr.RotateTransform(deg);

// … amit itt rajzolunk meg – egy függöleges vonal, ami FromY-tól indul
// és ToY-ig tart. A 0.0 az óra közepe, mivel origót előzőleg
// beállítottuk rá.
gr.DrawLine(pen, 0.0, FromY, 0.0, ToY);

// Itt minden transzformációt visszaállítunk.
gr.ResetTransform;
end;

var
i: Byte;
x, y: Integer;
Hour, Min, Sec, ms: Word;
size: TSize;
// HandSize a mutató mérete.
HandSize, HandStart, DiskSize, deg: Single;
s: String;
br: TGPSolidBrush;
r: TRect;
begin
gr := TGPGraphics.Create(dc);
br := TGPSolidBrush.Create(aclFloralWhite);
pen := TGPPen.Create(aclBlack, 2);
pen.SetAlignment(PenAlignmentInset);

// Töröljük a teljes képet kékkel, mivel az lesz az ablak átlátszó színe.
gr.Clear(aclBlue);

// Megrajzoljuk az óralap kitöltött körét és keretét.
gr.FillEllipse(br, 0, 0, Radius * 2, Radius * 2);
gr.DrawEllipse(pen, 0, 0, Radius * 2, Radius * 2);

pen.SetWidth(1.0);

// Elsimítjuk a vonalakat.
gr.SetSmoothingMode(SmoothingModeHighQuality);

// Kirajzoljuk a (másod)perceket jelképező vonalakat.
for i := 0 to 59 do
if i mod 5 > 0 then RotateLine(i * 6, -Radius * 0.92, -Radius * 0.93);

SetBkMode(dc, TRANSPARENT);
SetFontSize(Round(Radius * 0.0744));
SelectObject(dc, hfontClock);

for i := 1 to 12 do
begin
x := Radius + Round((Radius * 0.91) * Sin(Rad * i * 30));
y := Radius – Round((Radius * 0.91) * Cos(Rad * i * 30));
s := IntToStr(i);
GetTextExtentPoint(dc, PChar(s), Length(s), size);
TextOut(dc, x – size.cx div 2, y – size.cy div 2, PChar(s), Length(s));
end;

// Lekérjük az aktuális időből az órát,percet,másodpercet.
DecodeTime(Now, Hour, Min, Sec, ms);

// Ez a rész a napszakot és a hónap napját rajzolja ki.
SetFontSize(Round(Radius * 0.03));
SelectObject(dc, hfontClock);
SetTextColor(dc, $00FFFFFF);
if Hour < 12 then s := ‘DE’ else s := ‘DU’;
s := s + ‘ | ‘ + IntToStr(DayOf(Now));
GetTextExtentPoint(dc, PChar(s), Length(s), size);
x := Round(size.cx * 1.2);
y := Round(size.cy * 1.3);
r.Left := Round(Radius * 1.8) – x;
r.Right := r.Left + x;
r.Top := Radius – y div 2;
r.Bottom := r.Top + y;
FillRect(dc, r, GetStockObject(BLACK_BRUSH));
DrawText(dc, PCHar(s), -1, r, DT_CENTER or DT_VCENTER or DT_SINGLELINE);

HandStart := 0;

// 0: kismutató; 1: nagymutató; 2: másodperc
for i := 0 to 2 do
begin
// A mutató színe alapesetben fekete…
pen.SetColor(aclBlack);
// … vastagsága pedig arányos az óralap méretével.
pen.SetWidth(Radius * 0.015);

case i of
0: begin
// Kismutató minden percben 0.5 fokot lép.
// Az adott órának megfelelően először beállitjuk a kezdő fokot is,
// ami 30 fokonként helyezkedik el.
deg := Hour mod 12 * 30 + Min * 0.5;
HandSize := Radius * 0.75;
end;

1: begin
// Percmutató léphet 6 fokonként, de ha \\ jelet kivesszük,
// akkor 0.1 fokonként is – minden másodpercben.
deg := Min * 6;// + Sec * 0.1;
HandSize := Radius * 0.95;
end;

2: begin
// A másodpercmutató piros …
pen.SetColor(aclRed);
// … és kicsit vékonyabb a másik kettőnél.
pen.SetWidth(Radius * 0.005);

// Másodpercmutató 6 fokonként lépeget.
deg := Sec * 6;

HandSize := Radius * 0.89;

// A vége kicsit kilóg a tárcsa másik felén.
HandStart := Radius * 0.1;
end;
end;

// Itt elforgatjuk deg fokkal a mutatót.
RotateLine(deg, HandStart, -HandSize);
end;

// Itt megrajzoljuk a másodpercmutató, középen elhelyezett kis tárcsáját.
DiskSize := Radius * 0.05;
br.SetColor(aclRed);
gr.TranslateTransform(Radius, Radius);
gr.FillEllipse(br, -DiskSize / 2, -DiskSize / 2, DiskSize, DiskSize);

pen.Free;
br.Free;
gr.Free;
end;

// Ezt a függvényt hívja meg a windows bizonyos időközönként, hogy
// frissíteni tudjuk az óránkat.
procedure Timer(hwnd: HWND; uMsg, idEvent, dwTime: Longword); stdcall;
begin
// Itt újrarajzoljuk a program ablakát.
InvalidateRect(hAppWin, nil, False);
end;

// A programunk ablakához tartozó alakkezelő függvény.
// A windows – a mi programunkhoz címzet – üzenetei itt kötnek ki,
// amit mit feldolgozunk; nem mindent, csak azt, ami szükséges.
function WndProc(hwnd: HWND; uMsg: Longword; wParam: WPARAM; lParam: LPARAM):
LRESULT; stdcall;
var
ps: TPaintStruct;
hCompDC: HDC;
hCompBM: HBITMAP;
Wheel: ShortInt;
begin
case uMsg of
// Ha lenyomtak egy billentyűt.
WM_KEYDOWN:
begin
if wParam = VK_ESCAPE then DestroyWindow(hwnd);
end;

// Ha újra kell rajzolni az ablakunkat.
WM_PAINT:
begin
BeginPaint(hwnd, ps);

// Dupla-buffereléssel rajzolunk, hogy még csak eszébe se jusson
// villogni. A dupla-bufferelés tulajdonképpen az, amikor nem közvetlenül
// a képernyőre rajzolunk, hanem egy olyan helyre, ami éppen nem jelenik
// meg a képenyőn – ez az esetünkben a rendszermemória, de akár lehet
// a videómemória is. Ha kirajzoltunk mindent a bufferbe, utána
// egyszerűen csak a képenyőre másoljuk a tartalmát, ezzel elkerülendő
// a villogás. A villogás általában abból adódik, hogy valamit letörlünk
// a képernyőről, majd újra kirajzoljuk.
// A dupla-bufferelést megoldhatnánk  úgy is, hogy
// az ablak létrehozásánál megadjuk a WS_EX_COMPOSITED stílust, de
// az csak rétegelt ablakoknál(WS_EX_LAYERED) hatásos. Így viszont
// szemléletesebb, és aki esetleg eddig nem ismerte ezt a technikát,
// az most örülni fog.

// Létrehozunk egy memória-eszközkapcsolatot és
// egy bittérképet, ami akkora, amekkora a program ablaka.
hCompDC := CreateCompatibleDC(ps.hDC);
hCompBM := CreateCompatibleBitmap(ps.hDC, Radius * 2, Radius * 2);

// Kiválasztjuk az eszközkapcsolathoz a bittérképet, mivel az
// eszközkapcsolat segítségével tulajdonképpen a bittérképre
// történik a rajzolás.
SelectObject(hCompDC, hCompBM);

// Az órát kirajzoljuk a bufferbe…
DrawClock(hCompDC);

// … majd a tartalmát a képernyőre.
BitBlt(ps.hDC, 0, 0, Radius * 2, Radius * 2, hCompDC, 0, 0, SRCCOPY);

// Eszközkapcsolatot és a bittérképet töröljük.
DeleteObject(hCompBM);
DeleteDC(hCompDC);

EndPaint(hwnd, ps);
end;

// Itt azt írjuk elő, hogy bárhova kattintunk az ablakban, azt úgy vegye,
// mintha az ablak fejlécére kattintanánk.
WM_NCHITTEST:
begin
Result := HTCAPTION;
Exit;
end;

// Ha ablakunk megsemmísült, kiléptetjük az üzenetkezelő ciklusból a
// PostQuitMessage függvénnyel.
WM_DESTROY:
begin
KillTimer(hwnd, 1);
PostQuitMessage(0);
end;
end;

// Az alapértelmezett ablakkezelő függvényt meghívjuk.
Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;

// Itt elkészítjük programunk ablakát és némi beállitásokat is eszközlünk.
procedure CreateAppWindow;
var
wc: TWndClass;
begin
// Minden ablak tartozik valamilyen osztályba, ami egy strukturával
// van megvalósítva. Az osztályhoz tartozik pár tulajdonság is.
wc.style := 0;
// Az ablakkezelő függvény címe.
wc.lpfnWndProc := @WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := HInstance;
// Ikon a programunk ablakához, itt csak a taskbaron látszik.
wc.hIcon := 0;
// Egérkurzor.
wc.hCursor := LoadCursor(0, IDC_ARROW);
// Az ablak háttere.
wc.hbrBackground := 0;
// Az ablakhoz tartozó menü, ami jelen esetben nincs.
wc.lpszMenuName := nil;
// Az ablakosztály neve.
wc.lpszClassName := SWinClass;

// Az osztályt beregisztráljuk.
if RegisterClass(wc) = 0 then
// Ha nem sikerült, kilépünk.
Halt(0);

// Az ablakunk létrehozása és leírója a hAppWin változóba helyezése.
hAppWin := CreateWindowEx(
// Ezzel a stílussal tudjuk átlátszóvá tenni ablakunkat.
WS_EX_LAYERED, // or WS_EX_COMPOSITED,
// Az ablakosztály neve.
SWinClass,
// Ablakunk címe.
STitle,
// Ablakunk stílusa.
WS_SYSMENU or WS_MINIMIZEBOX or WS_POPUP or WS_VISIBLE,
// Pozíció és méret.
GetSystemMetrics(SM_CXSCREEN) div 2 - Radius,
GetSystemMetrics(SM_CYSCREEN) div 2 - Radius,
Radius * 2, Radius * 2,
0,
0,
hInstance,
nil);

if hAppWin = 0 then
// Ha nem sikerült létrehozni, kilépünk.
Halt(0);

// Az ablak átlátszó színét és áttetszőségét itt adjuk meg.
SetLayeredWindowAttributes(hAppWin, RGB(0, 0, 255), 230,
LWA_COLORKEY or LWA_ALPHA);

// Az időzítő elindul.
SetTimer(hAppWin, 1, 500, @Timer);

// Az óralap betűtípusának elkészítése.
hfontClock := CreateFont(
0,
0,
0,
0,
FW_BOLD,
0,
0,
0,
ANSI_CHARSET,
OUT_DEFAULT_PRECIS,
CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY,
DEFAULT_PITCH ,
‘Verdana’);
end;

// Itt található az üzenetkezelő ciklus.
procedure Run;
var
msg: TMsg;
begin
// A program addig fut, amíg GetMessage értéke nem lesz Hamis.
// Ha volt üzenet az ablakunkhoz, akkor belép a ciklusba, egyébként pedig
// várakozik.
while GetMessage(msg, 0, 0, 0) do
begin
// Ez billentyű üzenetet konvertál karakterüzenetté és teszi be az
// üzenetsorba, amit a következő GetMessage kivesz.
TranslateMessage(msg);
// Itt elküldjük az üzenetet az ablakkezelő függvényünkhöz.
DispatchMessage(msg);
end;
end;

begin
CreateAppWindow;
Run;
end.