private
{ Private-Deklarationen }
CopyFrame: TRect;
CopyMouseDown: Boolean;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
TimerONOFF:boolean;
implementation
uses Unit2, Unit3;
{$R *.dfm}
type
pRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = ARRAY[0..$effffff] OF TRGBQuad;
function GetScreenShot: TBitmap;
var
Desktop: HDC;
begin
Result := TBitmap.Create;
Desktop := GetDC(0);
try
try
Result.PixelFormat := pf32bit;
Result.Width := strtoint(form1.edit1.text);
Result.Height := strtoint(form1.edit2.text);
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, form1.SpinEdit1.Value, form1.SpinEdit2.Value, SRCCOPY);
Result.Modified := True;
finally
ReleaseDC(0, Desktop);
end;
except
Result.Free;
Result := nil;
end;
end;
Function FindBitmap(Container,Find:TBitmap):TPoint;
var
SclS,SclF:pRGBQuadArray;
xc,yc:Integer;
x,y:Integer;
Found:Boolean;
begin
Container.PixelFormat := pf32Bit;
Find.PixelFormat := pf32Bit;
Result.X := -1;
Result.Y := -1;
yc:=0;
while (yc < (Container.Height-Find.Height - 1)) and (Result.X=-1) do
begin
xc:= 0;
while (xc < (Container.Width-Find.Width - 1)) and (Result.X=-1) do
begin
y := 0;
Found := true;
while (y<Find.Height-1) and Found do
begin
x := 0;
SclF := Find.ScanLine[y];
SclS:= Container.ScanLine[yc+y];
while (x < Find.Width -1) and Found do
begin
Found := Integer(SclS[xc+x])=Integer(SclF[x]);
inc(x);
end;
inc(y);
end;
if Found then
begin
Result.X := xc;
Result.Y := yc;
end;
inc(xc);
end;
inc(yc);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
p:TPoint;
begin
if listbox1.Items.Count<1 then begin
showmessage('Keine Such-Objekte angegeben');
abort;
end else button1.Enabled:=false;
if button2.Enabled=true then timeronoff:=true;
if form2.Visible=true then form2.Close;
if listbox1.itemindex=-1 then listbox1.itemindex:=0;
if listbox1.ItemIndex<listbox1.Items.Count-1 then listbox1.ItemIndex:=listbox1.ItemIndex+1 else listbox1.ItemIndex:=0;
image1.Picture.Bitmap:= GetScreenShot;
image2.Picture.LoadFromFile(ExtractFilePath(Application.Exename)+'\'+listbox1.items[listbox1.ItemIndex]);
p:= FindBitmap(form1.Image1.Picture.Bitmap,Image2.Picture.Bitmap) ;
if p.X=-1=false then
begin
SetCursorPos(form2.Left+ p.x , p.y+ form2.Top+ (image2.Picture.Height div 2));
if listbox1.ItemIndex>0 then listbox1.ItemIndex:=listbox1.ItemIndex-1 else listbox1.ItemIndex:=listbox1.Items.Count-1;
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end else begin
p.X:=-1;
p.Y:=-1;
end;
timer1.Enabled:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TimerOnOff:=false;
button2.Enabled:=false;
button1.Enabled:=true;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
form1.Close;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if form2.Visible=true then form2.Close;
image1.Picture.Bitmap:= GetScreenShot;
form1.Width:=707;
// if savepicturedialog1.Execute=true then image1.Picture.SaveToFile(savepicturedialog1.filename);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
form2.width:=strtoint(edit1.Text);
form2.Height:=strtoint(edit2.Text);
form2.Left:=spinedit1.Value;
form2.Top:=spinedit2.Value;
if form2.Visible=true then form2.Close else form2.Show;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
form3.Show;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
form1.Width:=290;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
var
search: string;
begin
if checkbox1.Checked=true then listbox1.Items.Add(checkbox1.Caption+'.bmp')
else begin
search := checkbox1.Caption;
if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
var
search: string;
begin
if checkbox2.Checked=true then listbox1.Items.Add(checkbox2.Caption+'.bmp')
else begin
search := checkbox2.Caption;
if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;
procedure TForm1.CheckBox3Click(Sender: TObject);
var
search: string;
begin
if checkbox3.Checked=true then listbox1.Items.Add(checkbox3.Caption+'.bmp')
else begin
search := checkbox3.Caption;
if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;
procedure TForm1.CheckBox4Click(Sender: TObject);
var
search: string;
begin
if checkbox4.Checked=true then listbox1.Items.Add(checkbox4.Caption+'.bmp')
else begin
search := checkbox4.Caption;
if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;
procedure TForm1.CheckBox5Click(Sender: TObject);
var
search: string;
begin
if checkbox5.Checked=true then listbox1.Items.Add(checkbox5.Caption+'.bmp')
else begin
search := checkbox5.Caption;
if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
form2.width:=strtoint(edit1.Text);
end;
procedure TForm1.Edit2Change(Sender: TObject);
begin
form2.Height:=strtoint(edit2.Text);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
form2.width:=strtoint(edit1.Text);
form2.Height:=strtoint(edit2.Text);
form2.Show;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CopyFrame.Left := X;
CopyFrame.Top := Y;
CopyMouseDown := True;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if PtInRect(Image1.ClientRect, Point(X, Y)) then
begin
CopyFrame.Right := X;
CopyFrame.Bottom := Y;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.PixelFormat := pf32Bit;
Bmp.Width := CopyFrame.Right - CopyFrame.Left;
Bmp.Height := CopyFrame.Bottom - CopyFrame.Top;
Bmp.Canvas.CopyRect(Rect(0, 0, Bmp.Width, Bmp.Height), Image1.Picture.Bitmap.Canvas, CopyFrame);
Image2.Picture.Bitmap.Assign(Bmp);
finally
Bmp.Free;
end;
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if timeronoff=false then begin
timer1.Enabled:=false;
timeronoff:=true;
button2.Enabled:=false;
button1.Enabled:=true;
abort;
end;
timer1.Enabled:=false;
button1.Click;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
form3.memo1.lines.loadfromfile(ExtractFilePath(Application.Exename)+'\Bilder.txt');
checkbox1.caption:=form3.memo1.lines[0];
form3.RadioGroup1.Items[0]:=form3.memo1.lines[0];
checkbox2.caption:=form3.memo1.lines[1];
form3.RadioGroup1.Items[1]:=form3.memo1.lines[1];
checkbox3.caption:=form3.memo1.lines[2];
form3.RadioGroup1.Items[2]:=form3.memo1.lines[2];
checkbox4.caption:=form3.memo1.lines[3];
form3.RadioGroup1.Items[3]:=form3.memo1.lines[3];
checkbox5.caption:=form3.memo1.lines[4];
form3.RadioGroup1.Items[4]:=form3.memo1.lines[4];
timer2.Enabled:=false;
end;