Pascal: Überszuper rajzprogram

A programunk nem egy újabb rajzprogram, hanem csak egy FP-s megoldás arra, hogyan firkáljuk össze a windóz asztalát, vagy bármely más ablak területét.

[ Letöltöm! ]

A Forráskód:

program dtpaint;

uses
Windows;

// Elérhetővé tesszük(importáljuk) a program számára a GetConsoleWindow függvényt,
// ami a programunk konzolablakának a leíróját szolgáltatja.
// Ez a függvény csak a jedi-unitban található meg(winunits-jedi), de azt
// most inkább kihagyjuk.
function GetConsoleWindow: HWND; external ‘kernel32.dll’;

var
bAppTerminated: Boolean;

// Ez itt a szálfüggvény.
// Ez azt jelenti, hogy a program többszálú: vagyis van a főszál,
// ami a begin end. között van, és van ez, ami egy függvény alakjába realizálódik.
// Az asztal összefirkálsa valójában itt történik, miközben a főszálban egy
// Readln-el várakozunk az ENTER lenyomására.
function ThreadProc(parameter: Pointer): Longint;

var
hwndDest: HWND;

// Visszaadja az egérmutató pozícióját a hwndDest leírójú ablak kliensterületéhez
// igazodva.
function GetCurPos: TPoint;
var
p: TPoint;
begin
GetCursorPos(GetCurPos);
ScreenToClient(hwndDest, GetCurPos);
end;

var
DC: HDC;
ActCurPos, CurPos: TPoint;
begin
// Az ablak leírója(azonosítója), ahova rajzolni akarunk.
// Jelen esetben ez 0, ami a teljes képernyőt jelenti.
// Megadhatjuk még a GetConsoleWindow-t is, ha csak a konzolablakunkban
// akarunk firkálni.
hwndDest := 0;

// DC az egy eszközkapcsolat leírója lesz, aminek a segítségével
// rajzolhatunk a képernyőre.
DC := GetDC(hwndDest);

// Lekérjük az egérmutató pozícióját ActCurPos változóba, amiben mindig a
// legutolsó pozíció van.
ActCurPos := GetCurPos;

// A grafikus kurzorpozíciót beállítjuk ActCurPos-nak megfelelően.
MoveToEx(DC, ActCurPos.X, ActCurPos.Y, nil);

// A ciklus addig fut, amíg a főszálban be nem állítjuk a bAppTerminated
// változót True-ra. Ha nem tennénk ezt meg a főszálban, akkor is megszünne
// ez a szál(a program kilépésekor), csak éppen ott szakadna meg a futása,
// ahol éppen tartott a végrehajtása. Mi viszont azt akarjuk, hogy fusson le
// a ciklus utáni kód is.
while not bAppTerminated do
begin
// A jelenlegi kurzorpozíciót lekérdezzük CurPos-ba.
CurPos := GetCurPos;

// Ha jelenlegi kurzorpozíció nem egyezik a legutóbb eltárolttal, akkor
// rajzolhatunk.
if (CurPos.X <> ActCurPos.X) or (CurPos.Y <> ActCurPos.Y) then
begin
// Itt létrehozunk egy új tollat az eszközhöz.
// A toll 5 pont vastag és véletlenszerű színű lesz.
// A tollat a CreatePen függvénnyel hozzuk létre, ami visszaadja a
// toll leíróját. Ezt a leírót kapja meg a SelectObject, hogy kijelöljük
// az eszközkapcsolathoz. A SelectObject az előzőleg kijelölt toll
// leíróját adja vissza, amit a DeleteObject fügvénnyel megsemmisítünk.
DeleteObject(
SelectObject(DC,
CreatePen(PS_SOLID, 5, RGB(Random(256), Random(256), Random(256)))));

// Adott tollal vonalat húzunk a grafikus kurzor pozíciójából oda,
// ahol az egérkurzor éppen van. A grafikus kurzor pedig felveszi ezt
// a pozíciót. Ezt csak akkor tesszük meg, ha CTRL billentyű nincs lenyomva.
// Ha le van nyomva, akkor nincs vonalhúzás, hanem csak a grafikus kurzort állítjuk
// az egérkurzor pozíciójába.
if GetKeyState(VK_CONTROL) and $8000 = 0 then
LineTo(DC, CurPos.X, CurPos.Y) else
MoveToEx(DC, CurPos.X, CurPos.Y, nil);

// A jelenlegi kurzorpozíciót pedig eltároljuk.
ActCurPos := CurPos;
end;

// Itt elvileg azt adjuk meg, hogy 1 ezredmásodpercet várakozzunk, de ez
// inkább arra való, hogy a szál(ezzel együtt a programunk) ne foglalja le
// a neki szánt összes CPU-időt, hanem mondjon le róla és adódjon át a vezérlés
// egyébb programoknak.
Sleep(1);
end;

// Felszabadítjuk az eszközkapcsolatot.
ReleaseDC(hwndDest, DC);

// Az adott ablakot – ahol firkáltunk – frissíti, hogy programunk
// kilépése után ne maradjon már minden tiszta irka-firka.
InvalidateRect(hwndDest, nil, True);
end;

var
ThreadId: TThreadiD;

begin
Randomize;

// Itt létrehozunk egy új szálat, aminek a paramétere a szálfügvényre mutat.
// A BeginThread visszatérési értéke egy szálazonosító, amit még később
// használni fogunk.
ThreadId := BeginThread(@ThreadProc);

Write(‘Mozgasd az egeredet… a kilepeshez meg nyomj ENTER-t!’);

// Itt várakozunk egy ENTER-re, miközben a szálunk fut.
Readln;

// Itt kiléptetjük a szálat a while-ciklusból…
bAppTerminated := True;

// …itt meg megvárjuk, amíg a szál ténylegesen is megszűnik, hogy a ciklus
// utáni rész is lefusson.
WaitForThreadTerminate(ThreadId, 5000);
end.

A végeredmény: