Entwickler-Ecke

Windows API - Farbe erkennen? kein plan mehr.....


Mario Elßner - Sa 14.09.13 22:56
Titel: Farbe erkennen? kein plan mehr.....
Hallöle,

hier im Forum gibt es ja schon 2-3 Beiträge über das Thema Farben erkennen und hier gibt es ja ein Script dafür http://delphi-treff.de/tipps/grafik/grafikeigenschaften/pixelfarben-auf-dem-desktop-ermitteln/

Folgende function und abfrage mit Timer benutze ich:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
function DesktopColor(const X, Y: integer): TColor;
var
  C: TCanvas;

begin
  C := TCanvas.Create;
  try
    C.Handle := GetWindowDC(GetDesktopWindow);
    Result := GetPixel(C.Handle, X, Y);
  finally
    FreeAndNil(C);
  end;
end;



Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
procedure TForm1.DesktopColorTimer(Sender: TObject);
var
  CursorPos: TPoint;

begin
  GetCursorPos(CursorPos);
  Panel1.Color:= DesktopColor(Mouse.CursorPos.X - Form1.Left, Mouse.CursorPos.Y - Form1.Top);
//  Panel1.Color:= DesktopColor(100, 100);
//  Panel1.Caption:= DesktopColor(Mouse.CursorPos.X - Form1.Left, Mouse.CursorPos.Y - Form1.Top);
end;


allerdings habe ich das Problem das die Farbe nicht in in meinem Panel angezeigt wird. Woran liegt das bloß?
Kann mir da jemand weiter helfen was ich falsch mache?

Vielen Dank schon im voraus


Gerd Kayser - So 15.09.13 06:01

user profile iconMario Elßner hat folgendes geschrieben Zum zitierten Posting springen:
allerdings habe ich das Problem das die Farbe nicht in in meinem Panel angezeigt wird. Woran liegt das bloß?

Versuche es mal so:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
procedure TMainform.Timer1Timer(Sender: TObject);
var
  CursorPos : TPoint;
  DesktopDC : HDC;
  DesktopCanvas : TCanvas;
begin
  GetCursorPos(CursorPos);
  DesktopDC := GetDC(0);
  try
    DesktopCanvas := TCanvas.Create;
    try
      DesktopCanvas.Handle := DesktopDC;
      Panel1.Color := DesktopCanvas.Pixels[CursorPos.X, CursorPos.Y];
    finally
      DesktopCanvas.Free;
    end;
  finally
    ReleaseDC(0, DesktopDC);
  end;
end;


jaenicke - So 15.09.13 06:59

Sorry, aber das ist doch Blödsinn... wofür der Canvas Overhead? :shock:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
function DesktopColor(const X, Y: integer): TColor;
var
  DesktopDC: HDC;
begin
  DesktopDC := GetDC(0);
  try
    Panel1.Color := GetPixel(DesktopDC, X, Y);
  finally
    ReleaseDC(0, DesktopDC);
  end;
end;

// EDIT:
Und für häufige Abfragen besser gleich so:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
type
  TFormX = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DesktopColorTimer(Sender: TObject);
  private
    FDesktopDC: HDC;
  end;

// ...

procedure TFormX.FormCreate(Sender: TObject);
begin
  FDesktopDC := GetDC(0);
end;

procedure TFormX.FormDestroy(Sender: TObject);
begin
  ReleaseDC(0, FDesktopDC);
end;

procedure TFormX.DesktopColorTimer(Sender: TObject);
var
  CursorPos : TPoint;
begin
  GetCursorPos(CursorPos);
  Panel1.Color := GetPixel(FDesktopDC, CursorPos.X, CursorPos.Y);
end;

// EDIT2:
Kann es schlicht sein, dass ParentBackground bei dem Panel gesetzt ist, so dass es nur den Hintergrund des Formulars anzeigt? Dann ist die Farbe logischerweise gar nicht zu sehen... das hätte allerdings der Debugger zeigen müssen, wenn die Farbe eigentlich richtig ermittelt wird... (denn korrekt sieht schon der erste Quelltext aus, abgesehen von der etwas seltsamen Positionsberechnung)


Mario Elßner - So 15.09.13 09:57

Ich bedanke mich schon mal bei eurer Hilfe und habe ebenfalls mal eure Varianten Probiert.

Ich habe im Timer interval =1 und ParentBackground = false stehen aber dennoch wird die ermittelte Farbe unter meiner Mouseposition nicht angezeigt.
Woran es liegt kein plan mehr habe auch feste XY Kords gesetzt auch da funktioniert es nicht.

Diese seltsamen Positionsberechnungen sollten eigentlich nur sein das die Kords aus dem aktiven Fenster nur innerhalb den Programms erfolgen soll und nicht vom gesammten Desktop.


IhopeonlyReader - So 15.09.13 11:29


Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
function DesktopColor(const X, Y: integer): TColor;
var C: HDC;
begin
  C := GetWindowDC(GetDesktopWindow);
  Result := GetPixel( C, X, Y );
end;



procedure TForm1.DesktopColorTimer(Sender: TObject);
var P: TPoint;
begin
GetCursorPos( P );
if (P.X>Form1.Left) and (P.X<Form1.Left+Form1.Width)
and (P.Y>Form1.Top) and (P.Y<Form1.Top+Form1.Height) then
  Panel1.Color:= DesktopColor( P.X, P.Y);
end;

das funktioniert bei mir einwandfrei!
die if abfrage im timer habe ich eingeführt, da dadurch die farbe des Panels nur geändert wird, wenn die mouse sich auf dem Formular befindet (mit rand)

Nachtrag: Ändere mal manuell im Timer regelmäßig die Farbe und schau ob es passiert. Wenn du es nicht siehst, weißt du immerhin dass es an der Form und nicht an deinem vorliegenem Quelltext liegt.


WasWeißDennIch - So 15.09.13 11:48

Da hätte ich auch noch einen Vorschlag:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
function DesktopColorAt(P: TPoint): TColor;
var
  DC: hDC;
begin
  DC := GetWindowDC(0);
  try
    Result := GetPixel(DC, P.X, P.Y);
  finally
    ReleaseDC(0, DC);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Mouse: TPoint;
  R: TRect;
begin
  GetCursorPos(Mouse);
  GetWindowRect(Handle, R);
  if PtInRect(R, Mouse) then
    Panel1.Color := DesktopColorAt(Mouse);
end;

Wie schon erwähnt muss aber ParentBackground des Panels auf false stehen.


jaenicke - So 15.09.13 11:54

Sonst häng doch einfach mal dein Projekt an. ;-)


IhopeonlyReader - So 15.09.13 12:27

Ich gehe davon aus, dass er die Abfrage ob die Maus im Fenster ist falsch gemacht hat und es deshalb nie zum "panelfarbesetzten" kommt.
(sieht man ja an seiner Berechnung :D )