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

Delphi , Графика и Игры , Цвета и Палитра

Автор: Fenik
WEB-сайт: http://delphibase.endimus.com

{ **** 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.

Статья Определение кода цвета пикселя под курсором раздела Графика и Игры Цвета и Палитра может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Цвета и Палитра ::