Farbe erkennen? kein plan mehr.....

Mario Elßner · Verfasst: Sa 14.09.13 22:56

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 delphi-treff.de/tipp...m-desktop-ermitteln/

Folgende function und abfrage mit Timer benutze ich:

markieren

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;

markieren

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 · Verfasst: So 15.09.13 06:01

Mario Elßner hat folgendes geschrieben :

allerdings habe ich das Problem das die Farbe nicht in in meinem Panel angezeigt wird. Woran liegt das bloß?

Versuche es mal so:

markieren

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 · Verfasst: So 15.09.13 06:59

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

markieren

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:

markieren

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 · Verfasst: 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 · Beiträge: 600 Erhaltene Danke: 23 Delphi 7 PE

markieren

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.

_________________
Sucht "neueres" Delphi

Wer nicht brauch was er hat, brauch auch nicht was er nicht hat!

WasWeißDennIch · Beiträge: 653 Erhaltene Danke: 160

Da hätte ich auch noch einen Vorschlag:

markieren

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 · Verfasst: So 15.09.13 11:54

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

IhopeonlyReader · Beiträge: 600 Erhaltene Danke: 23 Delphi 7 PE

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

)

_________________
Sucht "neueres" Delphi

Wer nicht brauch was er hat, brauch auch nicht was er nicht hat!

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme