From 4cc31f469309118378448ef953fe983064800cb5 Mon Sep 17 00:00:00 2001 From: Wizzup? Date: Wed, 2 Sep 2009 05:16:29 +0000 Subject: [PATCH] Mouse should be done now. :) git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@8 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Units/MMLCore/input.pas | 79 ++++++++++++ Units/MMLCore/mufasatypes.pas | 3 + Units/MMLCore/window.pas | 11 +- project1.lpi | 225 ++++++++++++++++++---------------- testunit.lrs | 2 + testunit.pas | 29 +++-- 6 files changed, 235 insertions(+), 114 deletions(-) diff --git a/Units/MMLCore/input.pas b/Units/MMLCore/input.pas index cd5b7a2..b2f2b4e 100644 --- a/Units/MMLCore/input.pas +++ b/Units/MMLCore/input.pas @@ -18,6 +18,9 @@ type procedure GetMousePos(var X, Y: Integer); procedure SetMousePos(X, Y: Integer); + procedure MouseButtonAction(X, Y: Integer; mClick: TClickType; mPress: TMousePress); + procedure ClickMouse(X, Y: Integer; mClick: TClickType); + function IsMouseButtonDown(mType: TClickType): Boolean; public Client: TObject; @@ -71,5 +74,81 @@ begin {$ENDIF} end; +procedure TMInput.MouseButtonAction(X, Y: Integer; mClick: TClickType; mPress: TMousePress); +{$IFDEF LINUX} +var + event : TXEvent; + Garbage : QWord; + Old_Handler: TXErrorHandler; +{$ENDIF} + +begin + Self.SetMousePos(X, Y); +{$IFDEF LINUX} + Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + + FillChar(event,sizeof(TXevent),0); + + if mPress = mouse_Down then + Event._type:= ButtonPress + else + Event._type:= ButtonRelease; + + case mClick of + mouse_Left: Event.xbutton.button:= Button1; + mouse_Middle: Event.xbutton.button:= Button2; + mouse_Right: Event.xbutton.button:= Button3; + end; + + event.xbutton.send_event := 1; + event.xbutton.same_screen:= 1; + event.xbutton.subwindow:= 0; + event.xbutton.root := TClient(Client).MWindow.DesktopWindow; + event.xbutton.window := TClient(Client).MWindow.CurWindow; + event.xbutton.x_root:= x; + event.xbutton.y_root:= y; + event.xbutton.x := x; + event.xbutton.y := y; + event.xbutton.state:= 0; + if(XSendEvent(TClient(Client).MWindow.XDisplay, PointerWindow, True, $fff, @event) = 0) then + Writeln('Errorrrr :-('); + XFlush(TClient(Client).MWindow.XDisplay); + + XSetErrorHandler(Old_Handler); +{$ENDIF} +end; + +// ff omzetten naar MouseButtonDown(), en dan Click gewoon down en dan up. +// holdmouse releasemouse +procedure TMInput.ClickMouse(X, Y: Integer; mClick: TClickType); + +begin + Self.MouseButtonAction(X, Y, mClick, mouse_Down); + Self.MouseButtonAction(X, Y, mClick, mouse_Up); +end; + +function TMInput.IsMouseButtonDown(mType: TClickType): Boolean; +{$IFDEF LINUX} +var + rootx, rooty, x, y:integer; + root, child: twindow; + xmask: Cardinal; + Old_Handler: TXErrorHandler; +{$ENDIF} +begin + {$IFDEF LINUX} + Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + XQueryPointer(TClient(Client).MWindow.XDisplay,TClient(Client).MWindow.CurWindow,@root,@child,@rootx,@rooty,@x,@y,@xmask); + + case mType of + mouse_Left: Result := (xmask and Button1Mask) <> 0; + mouse_Middle: Result := (xmask and Button2Mask) <> 0; + mouse_Right: Result := (xmask and Button3Mask) <> 0; + end; + + XSetErrorHandler(Old_Handler); + {$ENDIF} +end; + end. diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 41ecc8e..9b241a1 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -15,6 +15,9 @@ type PRGB32 = ^TRGB32; TTargetWindowMode = (w_BMP, w_Window, w_HDC, w_ArrayPtr, w_XWindow); + TClickType = (mouse_Left, mouse_Right, mouse_Middle); + TMousePress = (mouse_Down, mouse_Up); + implementation diff --git a/Units/MMLCore/window.pas b/Units/MMLCore/window.pas index 5170443..5096b1f 100644 --- a/Units/MMLCore/window.pas +++ b/Units/MMLCore/window.pas @@ -17,7 +17,10 @@ type procedure GetDimensions(var W, H: Integer); function CopyClientToBitmap(xs, ys, xe, ye: integer): TBitmap; - function SetTarget(XWindow: QWord): integer; overload; + {$IFDEF LINUX} + function SetTarget(XWindow: x.TWindow): integer; overload; + {$ENDIF} + function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload; function SetTarget(ArrPtr: PRGB32): integer; overload; @@ -38,10 +41,10 @@ type XConnectionNumber: Integer; // X Window - CurWindow: QWord; + CurWindow: x.TWindow; // Desktop Window - DesktopWindow: QWord; + DesktopWindow: x.TWindow; // X Screen XScreen: PScreen; @@ -253,7 +256,7 @@ begin end; end; -function TMWindow.SetTarget(XWindow: QWord): integer; overload; +function TMWindow.SetTarget(XWindow: x.TWindow): integer; overload; {$IFDEF LINUX} var Old_Handler: TXErrorHandler; diff --git a/project1.lpi b/project1.lpi index fd1fd1b..02edcac 100644 --- a/project1.lpi +++ b/project1.lpi @@ -30,15 +30,15 @@ - + - - + + @@ -49,7 +49,7 @@ - + @@ -57,15 +57,15 @@ - + - - - - + + + + @@ -74,7 +74,7 @@ - + @@ -82,7 +82,7 @@ - + @@ -96,51 +96,51 @@ - + - - - - + + + + - - - - + + + + - - - - + + + + - + - - + + - - - - + + + + @@ -149,7 +149,7 @@ - + @@ -157,7 +157,7 @@ - + @@ -165,8 +165,8 @@ - - + + @@ -178,17 +178,22 @@ - - - + + + + + + + + - - - - + + + + @@ -196,20 +201,20 @@ - - + + - - + + - + @@ -227,127 +232,141 @@ + + + + + + + + + + + + + + - - + + - - + + - + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + diff --git a/testunit.lrs b/testunit.lrs index 245faa6..0a316cb 100644 --- a/testunit.lrs +++ b/testunit.lrs @@ -1,3 +1,5 @@ +{ 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' diff --git a/testunit.pas b/testunit.pas index 871e704..7f0c56f 100644 --- a/testunit.pas +++ b/testunit.pas @@ -41,26 +41,41 @@ begin Client.MWindow.GetDimensions(w, h); writeln(inttostr(w) + ' , ' + inttostr(h)); - bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h); + Client.MWindow.SetTarget(77736320); + Client.MWindow.GetDimensions(w, h); + writeln(inttostr(w) + ' , ' + inttostr(h)); + + {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)); + writeln(inttostr(x) + ' , ' + inttostr(y)); } - Client.MInput.SetMousePos(50, 50); - Client.MInput.GetMousePos(x, y); - writeln(inttostr(x) + ' , ' + inttostr(y)); + Client.MInput.ClickMouse(40, 20, mouse_Right); - ptr := Client.MWindow.ReturnData(0, 0, w, h); + { 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.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'); end;