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

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, которая определяет цвет пикселя под курсором и отображает его в реальном времени на форме. Программа использует поток для непрерывного мониторинга позиции курсора и обновления отображения.

Обзор работы программы:

1. Класс TPixTimer определяется как подкласс TThread. Этот класс переопределяет метод Execute, который вызывается при запуске потока.
2. В методе Execute программа использует функцию GetCursorPos для получения текущей позиции курсора и проверяет, изменилась ли она с момента предыдущего цикла. Если да, то вызывает метод RefreshInfo для обновления отображения.
3. Метод RefreshInfo получает цвет пикселя на текущей позиции курсора с помощью канваса DeskTopCanvas и рассчитывает RGB-значения цвета.
4. Затем программа обновляет отображение, рисуя прямоугольник вокруг пикселя с расчитанным цветом и отображая RGB-значения в метках на форме.

Программа также включает в себя основную форму (TForm1), которая создает экземпляр класса TPixTimer и запускает его. Форма также содержит несколько меток для отображения информации о позиции курсора и цвете.

В целом, это полезная программа для разработчиков, которые需要 troubleshoot pixel-уровневые проблемы с их приложениями или просто хотят исследовать цвета на экране.

Некоторые предложения по улучшению программы:

1. Обработка ошибок: Программа не обрабатывает ошибки хорошо. Например, если функция GetCursorPos терпит неудачу, программа будет завершаться неожиданно.
2. Выполнение: Программа использует поток для непрерывного мониторинга позиции курсора и обновления отображения. Однако это может быть медленным и может вызвать проблемы с производительностью на более медленных системах.
3. Организация кода: Код программы несколько разбросан, методы и переменные рассредоточены по единицам. Лучше было бы организовать код в логические секции или модули.

Альтернативное решение, использующее таймер вместо потока:

1. Создайте компонент таймер на форме и установите интервал его работы (например, 100 мс).
2. В обработчике события OnTimer получите текущую позицию курсора с помощью функции GetCursorPos и обновьте отображение, как описано выше.
3. Используйте свойство Timer.Enabled для управления запуском таймера.

Эта APPROACH может быть более эффективной, чем использование потока, особенно на медленных системах. Однако она может не обеспечивать такой же уровень реагирования, как оригинальная программа.

Программа определяет код цвета пикселя под курсором мыши, используя класс TThread и модуль TPixTimer.

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

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

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