diff --git a/Units/MMLCore/input.pas b/Units/MMLCore/input.pas index 765acdf..3138c29 100644 --- a/Units/MMLCore/input.pas +++ b/Units/MMLCore/input.pas @@ -103,13 +103,14 @@ var {$IFDEF MSWINDOWS} var MousePoint : TPoint; + Rect : TRect; {$ENDIF} begin {$IFDEF MSWINDOWS} Windows.GetCursorPos(MousePoint); - Windows.ScreenToClient( TClient(Client).MWindow.TargetHandle, MousePoint); - x := MousePoint.x; - y := MousePoint.y; + GetWindowRect(TClient(Client).MWindow.TargetHandle,Rect); + x := MousePoint.x - Rect.Left; + y := MousePoint.y - Rect.Top; {$ENDIF} {$IFDEF LINUX} Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); @@ -131,6 +132,7 @@ begin {$IFDEF MSWINDOWS} GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect); Windows.SetCursorPos(x + Rect.Left, y + Rect.Top); + {$ENDIF} {$IFDEF LINUX} Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); @@ -229,8 +231,8 @@ begin {$IFDEF MSWINDOWS} case mType of Mouse_Left: Result := (GetAsyncKeyState(VK_LBUTTON) <> 0); - Mouse_Middle: Result := (GetAsyncKeyState(VK_MBUTTON) <> 0) - Mouse_Right: Result := (GetAsyncKeyState(VK_RBUTTON) <> 0) + Mouse_Middle: Result := (GetAsyncKeyState(VK_MBUTTON) <> 0); + mouse_Right: Result := (GetAsyncKeyState(VK_RBUTTON) <> 0); end; {$ENDIF} {$IFDEF LINUX} diff --git a/Units/MMLCore/window.pas b/Units/MMLCore/window.pas index c387249..7b292da 100644 --- a/Units/MMLCore/window.pas +++ b/Units/MMLCore/window.pas @@ -5,22 +5,28 @@ unit Window; interface uses - Classes, SysUtils, mufasatypes, graphics, + Classes, SysUtils, mufasatypes{$IFDEF MSWINDOWS},windows {$ENDIF}, graphics, LCLType {$IFDEF LINUX}, xlib, x, xutil, ctypes{$ENDIF}; type + + { TMWindow } + TMWindow = class(TObject) function ReturnData(xs, ys, width, height: Integer): PRGB32; procedure FreeReturnData; procedure GetDimensions(var W, H: Integer); function CopyClientToBitmap(xs, ys, xe, ye: integer): TBitmap; - + procedure ActivateClient; {$IFDEF LINUX} function SetTarget(XWindow: x.TWindow): integer; overload; {$ENDIF} + {$IFDEF MSWINDOWS} + function UpdateDrawBitmap:boolean; + {$ENDIF} function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload; function SetTarget(ArrPtr: PRGB32): integer; overload; @@ -33,9 +39,15 @@ type // Target Window Mode. TargetMode: TTargetWindowMode; + {$IFDEF MSWINDOWS} //Target handle; HWND TargetHandle : Hwnd; + DrawBmpDataPtr : PRGB32; + + //Works on linux as well, test it out + TargetDC : HDC; + DrawBitmap : TBitmap; {$ENDIF} {$IFDEF LINUX} @@ -90,6 +102,13 @@ constructor TMWindow.Create(Client: TObject); begin inherited Create; Self.Client := Client; + {$IFDEF MSWINDOWS} + Self.DrawBitmap := TBitmap.Create; + Self.TargetMode:= w_Window; + Self.TargetHandle:= windows.GetDesktopWindow; + Self.TargetDC:= GetWindowDC(Self.TargetHandle); + Self.UpdateDrawBitmap; + {$ENDIF} {$IFDEF LINUX} Self.TargetMode := w_XWindow; @@ -106,8 +125,6 @@ begin Self.DesktopWindow:= RootWindow(Self.XDisplay, Self.XScreenNum); Self.CurWindow:= Self.DesktopWindow; - {$ELSE} - // Set Target mode for windows. {$ENDIF} end; @@ -118,7 +135,11 @@ begin {$IFDEF LINUX} XCloseDisplay(Self.XDisplay); {$ENDIF} - + {$IFDEF MSWINDOWS} + if TargetMode = w_Window then + ReleaseDC(TargetHandle,TargetDC); + DrawBitmap.Free; + {$ENDIF} inherited; end; @@ -129,6 +150,13 @@ var {$ENDIF} begin case Self.TargetMode of + w_Window: + begin + {$IFDEF MSWINDOWS} + BitBlt(Self.DrawBitmap.Canvas.Handle,0,0, width, height, Self.TargetDC, xs,ys, SRCCOPY); + Result := Self.DrawBmpDataPtr; + {$ENDIF} + end; w_XWindow: begin {$IFDEF LINUX} @@ -190,6 +218,17 @@ begin hh := ye-ys; case Self.TargetMode Of + w_Window: + begin + {$IFDEF MSWINDOWS} + if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then + Writeln('pervet'); + Result := TBitmap.Create; + Result.SetSize(ww+1,hh+1); + BitBlt(result.canvas.handle,0,0,ww+1,hh+1, + self.TargetDC,xs,ys, SRCCOPY); + {$ENDIF} + end; w_XWindow: begin {$IFDEF LINUX} @@ -225,6 +264,30 @@ begin end; end; +procedure TMWindow.ActivateClient; +begin + {$IFDEF MSWINDOWS} + SetForegroundWindow(Self.TargetHandle); + {$ENDIF} + {$IFDEF LINUX} + XSetInputFocus(Self.XDisplay,Self.CurWindow,RevertToParent,CurrentTime); + {$ENDIF} +end; + + +{$IFDEF MSWINDOWS} //Probably need one for Linux as well +function TMWindow.UpdateDrawBitmap :boolean; +var + w,h : integer; + BmpInfo : Windows.TBitmap; +begin + GetDimensions(w,h); + DrawBitmap.SetSize(w,h); + GetObject(DrawBitmap.Handle, SizeOf(BmpInfo), @BmpInfo); + DrawBmpDataPtr := BmpInfo.bmBits; +end; +{$ENDIF} + procedure TMWindow.GetDimensions(var W, H: Integer); {$IFDEF LINUX} var @@ -233,10 +296,19 @@ var childwindow : x.TWindow; Old_Handler: TXErrorHandler; {$ENDIF} +{$IFDEF MSWINDOWS} +var + Rect : TRect; +{$ENDIF} begin case TargetMode of w_Window: begin + {$IFDEF MSWINDOWS} + GetWindowRect(Self.TargetHandle, Rect); + w:= Rect.Right - Rect.left + 1; + h:= Rect.Bottom - Rect.Top + 1; + {$ENDIF} end; w_XWindow: begin @@ -280,8 +352,19 @@ begin if NewType in [ w_XWindow, w_ArrayPtr ] then begin // throw exception + Exit; end; - + case NewType of + w_Window : + begin; + ReleaseDC(Self.TargetHandle,Self.TargetDC); + Self.TargetHandle := Window; + Self.TargetDC := GetWindowDC(Window); + end; + end; + {$IFDEF MSWINDOWS} + UpdateDrawBitmap; + {$ENDIF} end; function TMWindow.SetTarget(ArrPtr: PRGB32): integer; overload; diff --git a/project1.lpi b/project1.lpi index 2a8194c..aa3306d 100644 --- a/project1.lpi +++ b/project1.lpi @@ -1,404 +1,440 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/testunit.lfm b/testunit.lfm index 5855411..514c165 100644 --- a/testunit.lfm +++ b/testunit.lfm @@ -1,20 +1,20 @@ -object Form1: TForm1 - Left = 293 - Height = 516 - Top = 200 - Width = 779 - ActiveControl = Button1 - Caption = 'Form1' - ClientHeight = 516 - ClientWidth = 779 - LCLVersion = '0.9.29' - object Button1: TButton - Left = 69 - Height = 25 - Top = 32 - Width = 75 - Caption = 'Button1' - OnClick = Button1Click - TabOrder = 0 - end -end +object Form1: TForm1 + Left = 966 + Height = 527 + Top = 461 + Width = 779 + ActiveControl = Button1 + Caption = 'Form1' + ClientHeight = 527 + ClientWidth = 779 + LCLVersion = '0.9.29' + object Button1: TButton + Left = 69 + Height = 25 + Top = 32 + Width = 75 + Caption = 'Button1' + OnClick = Button1Click + TabOrder = 0 + end +end diff --git a/testunit.lrs b/testunit.lrs index 0a316cb..0a5c0a4 100644 --- a/testunit.lrs +++ b/testunit.lrs @@ -1,9 +1,9 @@ { This is an automatically generated lazarus resource file } - -LazarusResources.Add('TForm1','FORMDATA',[ - 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'%'#1#6'Height'#3#4#2#3'Top'#3#200#0#5'Wid' - +'th'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientHe' - +'ight'#3#4#2#11'ClientWidth'#3#11#3#10'LCLVersion'#6#6'0.9.29'#0#7'TButton'#7 - +'Button1'#4'Left'#2'E'#6'Height'#2#25#3'Top'#2' '#5'Width'#2'K'#7'Caption'#6 - +#7'Button1'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#0 -]); + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#198#3#6'Height'#3#15#2#3'Top'#3#205#1#5'W' + +'idth'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'Client' + +'Height'#3#15#2#11'ClientWidth'#3#11#3#10'LCLVersion'#6#6'0.9.29'#0#7'TButto' + +'n'#7'Button1'#4'Left'#2'E'#6'Height'#2#25#3'Top'#2' '#5'Width'#2'K'#7'Capti' + +'on'#6#7'Button1'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#0 +]); diff --git a/testunit.pas b/testunit.pas index be94af6..525f995 100644 --- a/testunit.pas +++ b/testunit.pas @@ -1,113 +1,119 @@ -unit TestUnit; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, - StdCtrls, Client, MufasaTypes; - -type - - { TForm1 } - - TForm1 = class(TForm) - Button1: TButton; - procedure Button1Click(Sender: TObject); - private - { private declarations } - public - { public declarations } - end; - -var - Form1: TForm1; - -implementation - -type - TMyThread = class(TThread) - private - protected - procedure Execute; override; - public - Constructor Create(CreateSuspended : boolean); - end; - - constructor TMyThread.Create(CreateSuspended : boolean); - begin - FreeOnTerminate := True; - inherited Create(CreateSuspended); - end; - -procedure TMyThread.Execute; -Var - Client: TClient; - w,h, x, y, xx, yy:integer; - bmp: TBitmap; - ptr: PRGB32; - -begin - while (not Terminated) do - begin - Client := TClient.Create; - Client.MWindow.GetDimensions(w, h); - writeln(inttostr(w) + ' , ' + inttostr(h)); - - //Client.MWindow.SetTarget(77736320); - - bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h); - bmp.SaveToFile('/tmp/test.bmp'); - bmp.Free; - - //Sleep(1000); - Client.MInput.GetMousePos(x, y); - writeln(inttostr(x) + ' , ' + inttostr(y)); - - Client.MInput.SetMousePos(50, 50); - Client.MInput.GetMousePos(x, y); - writeln(inttostr(x) + ' , ' + inttostr(y)); - - Client.MInput.ClickMouse(60, 60, mouse_Right); - - ptr := Client.MWindow.ReturnData(0, 0, w, h); - for yy := 0 to h - 1 do - for xx := 0 to w - 1 do - begin - { Do comparison here } - inc(ptr); - end; - Client.MWindow.FreeReturnData; - - Client.MInput.IsMouseButtonDown(mouse_Left); - Sleep(1000); - if Client.MInput.IsMouseButtonDown(mouse_Left) then - writeln('Left mouse is down!'); - if Client.MInput.IsMouseButtonDown(mouse_Right) then - writeln('Right mouse is down!'); - if Client.MInput.IsMouseButtonDown(mouse_Middle) then - writeln('Middle mouse is down!'); - Client.Destroy; - writeln('Test completed successfully'); - break; - end; -end; - - -{ TForm1 } - -procedure TForm1.Button1Click(Sender: TObject); -Var - MyThread: TMyThread; - -begin - MyThread := TMyThread.Create(True); - MyThread.Resume; -end; - -initialization - {$I testunit.lrs} - -end. - +unit TestUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Client, MufasaTypes; + +type + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + procedure Button1Click(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +type + TMyThread = class(TThread) + private + protected + procedure Execute; override; + public + Constructor Create(CreateSuspended : boolean); + end; + + constructor TMyThread.Create(CreateSuspended : boolean); + begin + FreeOnTerminate := True; + inherited Create(CreateSuspended); + end; + +procedure TMyThread.Execute; +Var + Client: TClient; + w,h, x, y, xx, yy:integer; + bmp: TBitmap; + ptr: PRGB32; + +begin + while (not Terminated) do + begin + + Writeln('Creating the client'); + Client := TClient.Create; + Writeln('Getting the dimensions'); + Client.MWindow.GetDimensions(w, h); + writeln(inttostr(w) + ' , ' + inttostr(h)); + Writeln('Setting target'); + Client.MWindow.SetTarget(132840,w_window); + Client.MWindow.ActivateClient; + Client.MWindow.GetDimensions(w, h); + Writeln('Copying BMP'); + bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h); + bmp.SaveToFile('c:\test.bmp'); + bmp.Free; + + //Sleep(1000); + Client.MInput.GetMousePos(x, y); + writeln(inttostr(x) + ' , ' + inttostr(y)); + + Client.MInput.SetMousePos(50, 50); + Client.MInput.GetMousePos(x, y); + writeln(inttostr(x) + ' , ' + inttostr(y)); + + Client.MInput.ClickMouse(60, 60, mouse_Right); + + ptr := Client.MWindow.ReturnData(0, 0, w, h); + for yy := 0 to h - 1 do + for xx := 0 to w - 1 do + begin + { Do comparison here } + inc(ptr); + end; + + Client.MWindow.FreeReturnData; + + Client.MInput.IsMouseButtonDown(mouse_Left); + Sleep(1000); + if Client.MInput.IsMouseButtonDown(mouse_Left) then + writeln('Left mouse is down!'); + if Client.MInput.IsMouseButtonDown(mouse_Right) then + writeln('Right mouse is down!'); + if Client.MInput.IsMouseButtonDown(mouse_Middle) then + writeln('Middle mouse is down!'); + Client.Destroy; + writeln('Test completed successfully'); + break; + end; +end; + + +{ TForm1 } + +procedure TForm1.Button1Click(Sender: TObject); +Var + MyThread: TMyThread; + +begin + MyThread := TMyThread.Create(True); + MyThread.Resume; +end; + +initialization + {$I testunit.lrs} + +end. +