eine bestimmte farbe suchen geschlossen

[1337schi]

Hallo erstmal,

ich bin naja kein totaler delphi noob kann die grundlagen wie for, if schleifen,etc.

Ich suche nun nach einer funktion, die im aktuellen fenster, desktop, video naja was grad im vordergrund ist eine farbe sucht und mit der maus sofort hinspringt.
Man sollte die Funktion mit einem timer versehen können, damit die abfrage z.b. jede sekunde stattfinden kann.


Um standart antwort vorzubeugen: Habe bereits auf gidf.de geschaut und sufu benutzt

Hoffe mir kann jmd helfen!

 

[corema]

ich hab das mal so "gelöst":
hab den code geändert

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure ScreenShot;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var x,y:integer;
b:TBitmap;
begin
visible:=false;
image1.Width := screen.Width;
image1.Height := screen.Height;
screenshot;
for x := 1 to image1.Width do
begin
for y := 0 to image1.Height do
begin
if(image1.Canvas.Pixels[x,y] = clRed) then
begin
SetCursorPos(x,y);
exit;
end;
end;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
close;
end;

procedure TForm1.ScreenShot;
var
aDC:hDC;
aBmp:TBitmap;
mh, hBmp:THandle;
begin
aBmp:=TBitmap.Create;
aBmp.Width:=Screen.Width;
aBmp.Height:=Screen.Height;
aDC:=GetDC(0);
hBmp:=CreateCompatibleBitmap(aDC, Screen.Width, Screen.Height);
mh:=SelectObject(aDC, hBmp);
try
BitBlt(aBmp.Canvas.Handle, 0, 0, aBmp.Width, aBmp.Height,
aDC, 0, 0, SRCCopy);
image1.Picture.Bitmap := aBmp;
finally
SelectObject(aDC, mh);
DeleteObject(hBmp);
ReleaseDC(Self.Handle, aDC);
end;
end;

end.

dabei habe ich folgende veränderung and den eingenschaften vorgenommen:
image1.visible := false
form1.color := clBlack
form1.TransparentColorValue := clBlack
form1.TransparentColor := true;

 

[1337schi]

Ok, danke für die schnelle Antwort
Ich war bisher net mehr am PC...ich probiere es wenn ich zuhause bin glleich ma aus!

Also, hab mir das mal angeschaut...

stimm es, dass dieser part

"begin
if(image1.Canvas.Pixels[x,y] = clRed) then
begin
SetCursorPos(x,y);
exit;"

Die farbe sucht und mit der maus hinspringt? Also in dem fall wäre dass dann rot?


Des weiteren würde ich das prog gerne so lange laufen lassen bis ich es beende. das sollte doch mit einer repeat schleife möglich sein.
Wo muss die schleife anfangen und wo aufhören?


Hoffe du bist bereit mir zu helfen aber aufjeden fall schonma

 

[corema]

mit strg+shift+s machst sucht das programm nach der farbe.
mit strg+shift+q schließt du das programm
form hat width:=1 height:=1 windowstate:=wsnormal geändert bekommen

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure ScreenShot;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
id : integer;
procedure WmHotkey(var Msg: TMessage); message WM_HOTKEY;

{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle, id);
end;

procedure TForm1.WmHotkey(var Msg: TMessage);
var x,y:integer;
begin
if (Msg.WParam = 1) then begin
screenshot;
for x := 1 to image1.Width do
begin
for y := 0 to image1.Height do
begin
if(image1.Canvas.Pixels[x,y] = clRed) then
begin
SetCursorPos(x,y);
exit;
end;
end;
end;
end;

if(Msg.WParam = 2) then
begin
close;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var x,y:integer;
b:TBitmap;
begin
RegisterHotKey(Handle, 1, MOD_CONTROL or MOD_SHIFT, Ord('S'));
RegisterHotKey(Handle, 2, MOD_CONTROL or MOD_SHIFT, Ord('Q'));

visible:=false;
image1.Width := screen.Width;
image1.Height := screen.Height;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
self.Visible := false;
timer1.Enabled := false;
end;

procedure TForm1.ScreenShot;
var
aDC:hDC;
aBmp:TBitmap;
mh, hBmp:THandle;
begin
aBmp:=TBitmap.Create;
aBmp.Width:=Screen.Width;
aBmp.Height:=Screen.Height;
aDC:=GetDC(0);
hBmp:=CreateCompatibleBitmap(aDC, Screen.Width, Screen.Height);
mh:=SelectObject(aDC, hBmp);
try
BitBlt(aBmp.Canvas.Handle, 0, 0, aBmp.Width, aBmp.Height,
aDC, 0, 0, SRCCopy);
image1.Picture.Bitmap := aBmp;
finally
SelectObject(aDC, mh);
DeleteObject(hBmp);
ReleaseDC(Self.Handle, aDC);
end;
end;

end.

 

[1337schi]

ok danke für diene hilfsbereitschaft!!!

hocke grad in der schule und probiers gleich ma zuhaus aus

OK, sorry dass ich so ein "schwieriger Fall" bin

aber wenn ich das prog ausführe, öffnet sich einfach nur ein graues fenster. Ist das richtig?


Also das prog sollte eig immer automatisch nach der farbe checken und sofort mit der maus hinspringen.

Statt es immer gleich zu programmieren kannst du mir auch einfach die zu verändernde Stelle und den Befehl nennen (ist hoffentlich nicht zu kompliziert)

Nur für den Fall dass du kein Bock hast, mein Programmierer zu spielen.

Besten Dank!

 

[corema]

aber wenn ich das prog ausführe, öffnet sich einfach nur ein graues fenster. Ist das richtig?

nein

diese einstellungen solltest du noch haben:
image1.visible := false
form1.color := clBlack
form1.TransparentColorValue := clBlack
form1.TransparentColor := true;
form1.width:=1
form1.height:=1
form1.windowstate:=wsnormal

es gibt folgende tastenkombinationen:
strg+shift+s machst sucht das programm nach der farbe.
strg+shift+q schließt du das programm

 

[1337schi]

Daaaaaanke

Es scheint zu funktionieren. Es öffnet sich aufjeden Fall das kleine Fenster.
Was mir aber noch nicht ganz klar ist die Funktion vom Timer.
Wärst du mir so net das noch zu erläutern?

 

[corema]

Was mir aber noch nicht ganz klar ist die Funktion vom Timer.
Wärst du mir so net das noch zu erläutern?

klar
mir war nicht eingefallen, wie ich die anwendung von der taskleiste wegbekomme bekomme. so hatte ich den timer genommen, der eigentlich angehen sollte, wenn die anwendung gestartet wird. dann versteckt er die anwenung und schaltet sich selbst aus. scheinbar funtioniert es bei dir nicht.
ich hab mal gegoogled:
öffne mal deine projekt datei (bei mir projekt1.dpr). bei mir hab ich das hier:

program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
Application.Initialize;
Application.MainFormOnTaskbar := False;
Application.ShowMainForm := false; //das hab ich hinzugefügt dann sollte das fenster nicht mehr erscheinen
Application.CreateForm(TForm1, Form1);
Application.ShowMainForm := false; 
Application.Run;
end.

dann werden die ganzen änderungen den eigenschaften an TFORM1 und so auch egal.

hab hier mal was geändert, damit du auch hex farben eingeben kannst, allerdings als rgb:

function RGBToColor(R,G,B:Byte): TColor;
begin
Result:=B Shl 16 Or
G Shl 8 Or
R;
end;

procedure TForm1.WmHotkey(var Msg: TMessage);
var x,y:integer;
color:TColor;
begin
color:=rgbtocolor(255,0,0);
if (Msg.WParam = 1) then begin
screenshot;
for x := 1 to image1.Width do
begin
for y := 0 to image1.Height do
begin
if(image1.Canvas.Pixels[x,y] = color) then
begin
SetCursorPos(x,y);
exit;
end;
end;
end;
end;

 

[1337schi]

Danke für die Hilfe jetzt funktioniert es!


Jetzt bleibt nur noch die Farben automatisch suchen zu lassen aber das krig ich schon allein hin

Besten Dank!




1337schi

 

[Broken Sword]

http://www.freesoft-board.to/f155/info-bezueglich-praefixumstellung-im-forum-coding-390580.html

=> Closed

Gruß
Broken Sword