Определение кода цвета пикселя под курсором

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Определение кода цвета пикселя под курсором

Это готовая к употреблению программа. Состоит из двух модулей:
основного и потокового. Принцип таков: часть экранной области,
находящейся в районе курсора, 'фотографируется' и помещается в
TImage с двойным увеличением. В центре находится координата
нужного нам пикселя. Извлекаем информацию об этом пикселе и
отображаем данные в виде основных представлениях данных.
Программа также показывает, как использовать класс TThread
вместо компонента TTimer, что гораздо выгоднее для любого приложения.
P.S.
Исходники этой проги пользуются большим спросом на других сайтах по Delphi.

Зависимости: Стандартный набор
Автор:       diaz, diaz@en.net.ua, ICQ:98181410, Ukraine-Nikopol
Copyright:   Copyright(C)Diaz's Studio, 1999-2004
Дата:        8 января 2004 г.
***************************************************** }

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Модуль класса TThread
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

unit
 TPixTimer_Unit;

interface


uses

  Windows, Classes, SysUtils, Forms,
  Pix_Unit; //подключить модуль формы

type

  TPixTimer = class
(TThread)
  private

    { Private declarations }
    procedure
 RefreshInfo;
  protected

    procedure
 Execute; override
;
  end
;

var

  PixTimer: TPixTimer;

implementation


{ TPixTimer }

{поток для расчетов}

procedure
 TPixTimer.Execute;
begin

  repeat

    GetCursorPos(CurPos);
    if
 (CurPos.x <> curX) or
 (CurPos.y <> curY) then

      Synchronize(RefreshInfo); //синхронизация потока
    sleep(10); //быстрее - нет особого смысла.
    //если вообще убрать sleep(), то скорость будет максимальной,
    //но конкретно для данного приложения это не будет полезно.
  until
 false;
end
;

{обновление данных для визуальных компонентов}

procedure
 TPixTimer.RefreshInfo;
var

  col: dword;
  r, g, b,
    ri, gi, bi: byte;
  glr, glg, glb: word;
begin

  curX := CurPos.x;
  curY := CurPos.y;

  CurColor := DeskTopCanvas.Pixels[curX, curY];
  r := getRvalue(CurColor);
  g := getGvalue(CurColor);
  b := getBvalue(CurColor);

  if
 r = 255 then

    glr := 1
  else

    glr := round((r / 255) * 1000);
  if
 g = 255 then

    glg := 1
  else

    glg := round((g / 255) * 1000);
  if
 b = 255 then

    glb := 1
  else

    glb := round((b / 255) * 1000);

  if
 (r >= 96) and
 (r <= 160) then

    ri := 255
  else

    ri := 255 - r;
  if
 (g >= 96) and
 (g <= 160) then

    gi := 255
  else

    gi := 255 - g;
  if
 (b >= 96) and
 (b <= 160) then

    bi := 255
  else

    bi := 255 - b;
  col := PALETTERGB(ri, gi, bi);

  ScrRect := Bounds(curX - whi div
 2, curY - whi div
 2, whi, whi);
  with
 ScallBm.Canvas do

  begin

    CopyRect(ScallRect, DeskTopCanvas, ScrRect);
    Pen.Color := col;
    {rect}
    MoveTo(0, 0);
    LineTo(who - 1, 0);
    LineTo(who - 1, who - 1);
    LineTo(0, who - 1);
    LineTo(0, 0);
    {cross}
    MoveTo(whi, 0);
    LineTo(whi, whi - 2);
    LineTo(whi + 1, whi - 2);
    LineTo(whi + 1, 0);
    MoveTo(whi, who - 1);
    LineTo(whi, whi + 3);
    LineTo(whi + 1, whi + 3);
    LineTo(whi + 1, who - 1);
    MoveTo(0, whi);
    LineTo(whi - 2, whi);
    LineTo(whi - 2, whi + 1);
    LineTo(0, whi + 1);
    MoveTo(who - 1, whi);
    LineTo(whi + 3, whi);
    LineTo(whi + 3, whi + 1);
    LineTo(who - 1, whi + 1);
  end
;

  with
 form1 do

  begin

    Image1.Picture.Bitmap := ScallBm;
    Left := curX + FPosX;
    top := curY + FPosY;
    label1.Font.Color := col;
    label1.Caption := inttohex(r, 2) + ' ' + inttohex(g, 2) + ' ' + inttohex(b,
      2); //(H)
    label2.Font.Color := col;
    label2.Caption := inttostr(r) + ' ' + inttostr(g) + ' ' + inttostr(b); //(D)
    label3.Font.Color := col;
    label3.Caption := inttostr(CurColor); //(D)
    label4.Font.Color := col;
    label4.Caption :=
      floattostr(glr) + ' ' + floattostr(glg) + ' ' + floattostr(glb);
        //OpenGL color

    Color := CurColor;

    {двигаем форму на краях экрана}
    if
 curX + ClientWidth div
 2 > screen.width then

      FPosX := -ClientWidth
    else

      FPosX := -ClientWidth div
 2;
    if
 curX - ClientWidth div
 2 < 0 then

      FPosX := 0;
    if
 curY + ClientHeight + ClientHeight div
 2 > screen.Height then

      FPosY := -ClientHeight - ClientHeight div
 2
    else

      FPosY := ClientHeight div
 2;
  end
;
end
;

end
.

Пример использования:

unit
 Pix_Unit;

interface


uses

  Windows, Classes, Forms, StdCtrls, Controls, ExtCtrls, Graphics,
  Menus;

type

  TForm1 = class
(TForm)
    Image1: TImage;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Label1: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    procedure
 FormCreate(Sender: TObject);
    procedure
 Exit1Click(Sender: TObject);
    procedure
 FormClose(Sender: TObject; var
 Action: TCloseAction);
  private

    { Private declarations }
  public

    { Public declarations }
  end
;

const

  whi = 32;
  who = whi * 2;

var

  Form1: TForm1;
  DeskTopCanvas: TCanvas;
  ScallBm: TBitmap;
  ScrRect,
    ScallRect: TRect;
  curX, curY: integer;
  CurPos: TPoint;
  CurColor: dword;

  FPosX, FPosY: integer;

implementation


uses

  TPixTimer_Unit; //подключить потоковый модуль

{$R *.DFM}

procedure
 TForm1.FormClose(Sender: TObject; var
 Action: TCloseAction);
begin

  PixTimer.Suspended := true; //остановить поток
  ScallBm.Free;
  DeskTopCanvas.Free;
  Action := caFree; //освободить все связанное с приложением
end
;

procedure
 TForm1.Exit1Click(Sender: TObject);
begin

  close;
end
;

procedure
 TForm1.FormCreate(Sender: TObject);
begin

  Form1.ClientWidth := who * 2;
  Form1.ClientHeight := who;
  image1.Width := who;
  image1.Height := who;
  {}
  GetCursorPos(CurPos);
  FPosX := curX - form1.ClientWidth div
 2;
  FPosY := form1.ClientHeight div
 2;
  DeskTopCanvas := TCanvas.Create;
  DeskTopCanvas.Handle := GetDC(HWnd_DeskTop);
  ScrRect := Bounds(curX - whi div
 2, curY - whi div
 2, whi, whi);
  ScallRect := Bounds(0, 0, who, who);
  ScallBm := TBitmap.Create;
  with
 ScallBm do

  begin

    pixelformat := pf32bit;
    Width := who;
    Height := who;
  end
;
  SetWindowPos(Form1.Handle, HWND_TOPMOST, 0, 0, 0, 0,
    SWP_NOACTIVATE or
 SWP_NOMOVE or
 SWP_NOSIZE); //поверх всех окон

  PixTimer := TPixTimer.Create(false); //создать поток и запустить его(false)
  PixTimer.Priority := tpNormal; //приоритет для потока
end
;

end
.

Другое по теме:

• Работа с палитрой
• Перевод RGB в GRAY
• Преобразование цвета RGB 34 HLS