[Nyctos Kasignete]

Одно время было интересно — написала программку определения цвета пиксела в точке расположения указателя мыши. На Win32 API.

Код:

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.