program ScanClr;
uses
Windows,
Messages,
SysUtils;
{$R *.res}
const
WNDCLASSNAME = 'ScanClr';
var
Inst: Cardinal;
TimerId: Cardinal;
WndClass: TWndClass;
HndlW, HndlE: HWnd;
Msg: TMsg;
ScreenDC: HDC;
procedure Bye;
begin
ReleaseDC(0, ScreenDC);
KillTimer(HndlW, TimerId);
Halt;
end;
function WindowProc(HandleWnd, Messg, wPrm, lPrm: Longint): Longint; stdcall;
var
pt: TPoint;
clr, hex: Cardinal;
EditData: THandle;
EditTxt: PChar;
begin
Result := DefWindowProc(HandleWnd, Messg, wPrm, lPrm);
case Messg of
WM_TIMER:
begin
{ При срабатывании таймера получаем цвет пикселя под курсором и
вписываем его шестнадцатеричное значение в поле 'Edit' }
GetCursorPos(pt);
clr := GetPixel(ScreenDC, pt.X, pt.Y);
hex := GetBValue(clr) or (GetGValue(clr) shl 8) or (GetRValue(clr) shl 16);
SetWindowText(HndlE, PChar(IntToHex(hex, 6)));
end;
WM_KEYUP:
begin
if wPrm <> VK_SPACE then Exit;
{ Если событие вызвано клавишей 'Пробел', то копируем из поля 'Edit'
в буфер строку, содержащую шестнадцатеричное значение цвета }
EditData := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, 8);
EditTxt := GlobalLock(EditData);
GetWindowText(HndlE, EditTxt, 7);
GlobalUnlock(EditData);
OpenClipboard(0);
EmptyClipboard();
SetClipboardData(CF_TEXT, EditData);
CloseClipboard();
GlobalFree(EditData);
end;
WM_DESTROY: Bye();
end;
end;
begin
Inst := GetModuleHandle(nil);
WndClass.style := CS_HREDRAW or CS_VREDRAW;
WndClass.lpfnWndProc := @WindowProc;
WndClass.hInstance := Inst;
WndClass.hbrBackground := COLOR_WINDOW;
WndClass.lpszClassName := @WNDCLASSNAME[1];
WndClass.hCursor := LoadCursor(0, IDC_ARROW);
RegisterClass(WndClass);
HndlW := CreateWindowEx(WS_EX_TOPMOST, @WNDCLASSNAME[1], @WNDCLASSNAME[1],
WS_POPUPWINDOW or WS_CAPTION, 1, 1, 200, 200, 0, 0,
Inst, nil); // окно будет всегда сверху (WS_EX_TOPMOST)
HndlE := CreateWindow(PChar('EDIT'), PChar('FFFFFF'),
WS_VISIBLE or WS_CHILD or ES_READONLY or ES_CENTER,
10, 5, 100, 21, HndlW, 0, Inst, nil);
ShowWindow(HndlW, SW_SHOWNORMAL);
UpdateWindow(HndlW);
ScreenDC := GetDC(0); // контекст экрана
TimerId := SetTimer(HndlW, 1, 100, nil);
while (GetMessage(Msg, 0, 0, 0)) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
ReleaseDC(0, ScreenDC);
KillTimer(HndlW, TimerId);
Halt;
end.