Текущий архив: 2006.12.03;
Скачать: CL | DM;

Вниз

Как узнать цвет заданной точки экранна   Найти похожие ветки 

← →
Батыр   (2006-07-21 00:06) [0]

Мне нужно узнать цвет заданной точки экранны, возможно ли это.

---

← →
Игорь Шевченко ©   (2006-07-21 00:17) [1]

unit main;

interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls;

type
 TfMain = class(TForm)
   Shape1: TShape;
   Timer: TTimer;
   procedure TimerTimer(Sender: TObject);
 end;

var
 fMain: TfMain;

implementation

{$R *.dfm}

procedure TfMain.TimerTimer(Sender: TObject);
var
 Wnd: HWnd;
 CursorPos: TPoint;
 DC: HDC;
 Pixel: DWORD;
begin
 GetCursorPos(CursorPos);
 Wnd := WindowFromPoint(CursorPos);
 if IsWindow(Wnd) then begin
   MapWindowPoints(HWND_DESKTOP, Wnd, CursorPos, 1);
   DC := GetWindowDC(Wnd);
   try
     Pixel := GetPixel(DC, CursorPos.X, CursorPos.Y);
     Shape1.Brush.Color := Pixel;
   finally
     ReleaseDC(Wnd, DC);
   end;
 end;
end;

end.

Определяет цвет точки под курсором мыши

---

← →
Батыр   (2006-07-21 00:20) [2]

Игорь Шевченко огромное спасибо

---

← →
Loginov Dmitry ©   (2006-07-21 15:35) [3]

Вот вариант по-проще:


procedure TForm1.Timer1Timer(Sender: TObject);
begin
 with TCanvas.Create do
 try
   Handle := GetDC(0);
   Self.Color := Pixels[Mouse.CursorPos.X, Mouse.CursorPos.Y];
 finally
   Free;
 end;
end;


---

← →
KilkennyCat ©   (2006-07-21 23:17) [4]

> [3] Loginov Dmitry ©   (21.07.06 15:35)


А ReleaseDC?

---

← →
Loginov Dmitry ©   (2006-07-22 08:45) [5]

Ну тады так:


procedure TForm1.Timer1Timer(Sender: TObject);
begin
with TCanvas.Create do
try
  Handle := GetDC(0);
  Self.Color := Pixels[Mouse.CursorPos.X, Mouse.CursorPos.Y];
finally
  ReleaseDC(0, Handle);
  Free;
end;


Просто до этого не проверял на утечки памяти. Если таймер выставлен на 1000, то утечки памяти почему-то не наблюдаются, а если 100, то утечки без ReleaseDC очень даже заметны.

---

← →
Юрий Зотов ©   (2006-07-22 12:24) [6]

Если бороться за упрощение, то тогда уж так:

procedure TForm1.Timer1Timer(Sender: TObject);
var
 DC: HDC;
begin
 DC := GetDC(0);
 try
   Color := GetPixel(DC, Mouse.CursorPos.X, Mouse.CursorPos.Y)
 finally
   ReleaseDC(0, DC)
 end
end;

И если не страдать паранойей, как я,  то try-finally-end тоже можно выкинуть. Потому что исключение здесь практически невероятно.

---

Страницы: 1 вся ветка

Текущий архив: 2006.12.03;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.108 c