Delphi - Color Picker

[M!X0R]

المشاركة الأصلية كتبت بواسطة Sn!per X‏ يوم 23-11-2015 على الساعة 10:09 AM

 

 

program ColorPicker;


uses Windows, Messages, SysUtils;


const
g_strKlasaOkna = 'od0dogk_ColorPicker_Window';
var
g_hwndOkno: HWND = 0;
g_hdcEkran: HDC = 0;
g_clKolor: COLORREF; // = RGB(255, 255, 255); // poczatkowo bialy


function WindowEventProc(hWnd, uMsg: Longint; wParam: WPARAM; lParam: LPARAM):
Longint; stdcall;
var
ptKursor: TPOINT;
ps: PAINTSTRUCT;
hdcOkno: HDC;
rcObszarKlienta: TRECT;
hbrPedzel: HBRUSH;
Strumien: string;
begin
Result := 0;
case uMsg of
WM_LBUTTONDOWN:
begin
SetCapture(hWnd);
SetCursor(LoadCursor(0, IDC_CROSS));
Result := 0;
end;
WM_MOUSEMOVE:
begin
if (GetCapture() = hWnd) then
begin
// odczytujemy wspَlrzedne kursora
ptKursor.x := LOWORD(lParam);// LOWORD = GET_X_LPARAM
ptKursor.y := HIWORD(lParam); // HIWORD = GET_Y_LPARAM


// przeliczamy je na koordynaty ekranowe
ClientToScreen(hWnd, ptKursor);


// pobieramy kolor z miejsca kursora
g_clKolor := GetPixel(g_hdcEkran,
ptKursor.x, ptKursor.y);


// wymuszamy odswiezenie okna programu,
// aby pokazac pobrany kolor
InvalidateRect(hWnd, nil, TRUE);
end;
Result := 0;
end;
WM_LBUTTONUP:
begin
// uwalniamy mysz
ReleaseCapture();
// ustawiamy kursor strzalki
SetCursor(LoadCursor(0, IDC_ARROW));
Result := 0;
end;
WM_PAINT:
begin
// odrysowanie zawartosci okna
// zaczynamy
hdcOkno := BeginPaint(hWnd, ps);


// pobieramy obszar klienta okna
GetClientRect(hWnd, rcObszarKlienta);


// wypelniamy go pobranym kolorem
// w tym celu najpierw tworzymy odpowiedni pedzel,
// a potem wypelniamy prostokat obszaru klienta
// potem usuwamy pedzel
hbrPedzel := CreateSolidBrush(g_clKolor);
FillRect(hdcOkno, rcObszarKlienta, hbrPedzel);
DeleteObject(hbrPedzel);


// konczymy rysowanie
EndPaint(hWnd, ps);


// pokazanie skladowych koloru
// pobieramy te skladowe i konwertujemy na napis
Strumien := 'RGB: ' + IntToStr(GetRValue(g_clKolor))
+ ', ' + IntToStr(GetGValue(g_clKolor))
+ ', ' + IntToStr(GetBValue(g_clKolor));


// ustawiamy ten napis jako tytul okna programu
SetWindowText(hWnd, PChar(Strumien));
Result := 0;
end;
WM_DESTROY:
begin
// zwalniamy kontekst ekranu
ReleaseDC(0, g_hdcEkran);
// konczymy program
PostQuitMessage(0);
Result := 0;
end;
end;
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;


var
KlasaOkna: WNDCLASSEX;
msgKomunikat: TMSG;
begin
// wypelniamy strukture WNDCLASSEX
ZeroMemory(@KlasaOkna, sizeof(WNDCLASSEX));
KlasaOkna.cbSize := sizeof(WNDCLASSEX);
KlasaOkna.hInstance := hInstance;
KlasaOkna.lpfnWndProc := @WindowEventProc;
KlasaOkna.lpszClassName := g_strKlasaOkna;
KlasaOkna.hCursor := LoadCursor(0, IDC_ARROW);
KlasaOkna.hIcon := LoadIcon(0, IDI_APPLICATION);


// rejestrujemy klase okna
RegisterClassEx(KlasaOkna);


// tworzymy okno funkcja CreateWindowEx
g_hwndOkno := CreateWindowEx(WS_EX_TOOLWINDOW,
g_strKlasaOkna,
0,
WS_OVERLAPPED or WS_BORDER
or WS_CAPTION or WS_SYSMENU,
0, 0,
125,
80,
0,
0,
hInstance,
0);


// pokazujemy nasze okno i je od razu odswiezamy
ShowWindow(g_hwndOkno, SW_SHOW);
UpdateWindow(g_hwndOkno);


//* pobieramy kontekst urzadzenia ekranu */
g_hdcEkran := GetDC(0);


//* petla komunikatَw */


while (GetMessage(msgKomunikat, 0, 0, 0)) do
begin
TranslateMessage(msgKomunikat);
DispatchMessage(msgKomunikat);
end;
end.

 

27-11-2015:
Added Showing Hex Color Value.