diff --git a/Units/MMLCore/input.pas b/Units/MMLCore/input.pas
index 3138c29..305ca4b 100644
--- a/Units/MMLCore/input.pas
+++ b/Units/MMLCore/input.pas
@@ -1,253 +1,262 @@
-unit Input;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils,
- mufasatypes, // for common mufasa types
- windowutil // for mufasa window utils
- {$IFDEF LINUX}
- ,x, xlib // for X* stuff
- {$ENDIF};
-type
- TMInput = class(TObject)
- constructor Create(Client: TObject);
- destructor Destroy; override;
-
- 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;
-
- end;
-
-implementation
-
-uses
- Client{$IFDEF MSWINDOWS},windows{$ENDIF};
-
-{$IFDEF MSWINDOWS}
-type
- PMouseInput = ^TMouseInput;
- tagMOUSEINPUT = packed record
- dx: Longint;
- dy: Longint;
- mouseData: DWORD;
- dwFlags: DWORD;
- time: DWORD;
- dwExtraInfo: DWORD;
- end;
- TMouseInput = tagMOUSEINPUT;
-
- PKeybdInput = ^TKeybdInput;
- tagKEYBDINPUT = packed record
- wVk: WORD;
- wScan: WORD;
- dwFlags: DWORD;
- time: DWORD;
- dwExtraInfo: DWORD;
- end;
- TKeybdInput = tagKEYBDINPUT;
-
- PHardwareInput = ^THardwareInput;
- tagHARDWAREINPUT = packed record
- uMsg: DWORD;
- wParamL: WORD;
- wParamH: WORD;
- end;
- THardwareInput = tagHARDWAREINPUT;
- PInput = ^TInput;
- tagINPUT = packed record
- Itype: DWORD;
- case Integer of
- 0: (mi: TMouseInput);
- 1: (ki: TKeybdInput);
- 2: (hi: THardwareInput);
- end;
- TInput = tagINPUT;
-const
- INPUT_MOUSE = 0;
- INPUT_KEYBOARD = 1;
- INPUT_HARDWARE = 2;
-
-{Mouse}
-function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT; stdcall; external user32 name 'SendInput';
-{$ENDIF}
-
-constructor TMInput.Create(Client: TObject);
-begin
- inherited Create;
- Self.Client := Client;
-end;
-
-destructor TMInput.Destroy;
-begin
-
- inherited;
-end;
-
-procedure TMInput.GetMousePos(var X, Y: Integer);
-{$IFDEF LINUX}
-var
- b:integer;
- root, child: twindow;
- xmask: Cardinal;
- Old_Handler: TXErrorHandler;
-{$ENDIF}
-{$IFDEF MSWINDOWS}
-var
- MousePoint : TPoint;
- Rect : TRect;
-{$ENDIF}
-begin
- {$IFDEF MSWINDOWS}
- Windows.GetCursorPos(MousePoint);
- GetWindowRect(TClient(Client).MWindow.TargetHandle,Rect);
- x := MousePoint.x - Rect.Left;
- y := MousePoint.y - Rect.Top;
- {$ENDIF}
- {$IFDEF LINUX}
- Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
- XQueryPointer(TClient(Client).MWindow.XDisplay,TClient(Client).MWindow.CurWindow,@root,@child,@b,@b,@x,@y,@xmask);
- XSetErrorHandler(Old_Handler);
- {$ENDIF}
-end;
-
-procedure TMInput.SetMousePos(X, Y: Integer);
-{$IFDEF LINUX}
-var
- Old_Handler: TXErrorHandler;
-{$ENDIF}
-{$IFDEF MSWINDOWS}
-var
- rect : TRect;
-{$ENDIF}
-begin
- {$IFDEF MSWINDOWS}
- GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect);
- Windows.SetCursorPos(x + Rect.Left, y + Rect.Top);
-
- {$ENDIF}
-{$IFDEF LINUX}
- Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
- XWarpPointer(TClient(Client).MWindow.XDisplay, 0, TClient(Client).MWindow.CurWindow, 0, 0, 0, 0, X, Y);
- XFlush(TClient(Client).MWindow.XDisplay);
- XSetErrorHandler(Old_Handler);
-{$ENDIF}
-end;
-
-procedure TMInput.MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress);
-{$IFDEF LINUX}
-var
- event : TXEvent;
- Garbage : QWord;
- Old_Handler: TXErrorHandler;
-{$ENDIF}
-{$IFDEF MSWINDOWS}
-var
- Input : TInput;
- Rect : TRect;
-{$ENDIF}
-begin;
- {$IFDEF MSWINDOWS}
- GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect);
- Input.Itype:= INPUT_MOUSE;
- Input.mi.dx:= x + Rect.left;
- Input.mi.dy:= y + Rect.Top;
- if mPress = mouse_Down then
- begin;
- case mClick of
- Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN;
- Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEDOWN;
- Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN;
- end;
- end else
- case mClick of
- Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP;
- Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEUP;
- Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP;
- end;
- SendInput(1,Input, sizeof(Input));
- {$ENDIF}
- {$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.SetMousePos(x,y);
- 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 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);
- end;
- {$ENDIF}
- {$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.
-
+unit Input;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils,
+ mufasatypes, // for common mufasa types
+ windowutil // for mufasa window utils
+ {$IFDEF LINUX}
+ ,x, xlib // for X* stuff
+ {$ENDIF};
+type
+ TMInput = class(TObject)
+ constructor Create(Client: TObject);
+ destructor Destroy; override;
+
+ 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);
+
+ {
+ Possibly change to GetMouseButtonStates? Then people can get the
+ states bitwise. Like X and WinAPI.
+ }
+ function IsMouseButtonDown(mType: TClickType): Boolean;
+
+ public
+ Client: TObject;
+
+ end;
+
+implementation
+
+uses
+ Client{$IFDEF MSWINDOWS},windows{$ENDIF};
+
+{$IFDEF MSWINDOWS}
+type
+ PMouseInput = ^TMouseInput;
+ tagMOUSEINPUT = packed record
+ dx: Longint;
+ dy: Longint;
+ mouseData: DWORD;
+ dwFlags: DWORD;
+ time: DWORD;
+ dwExtraInfo: DWORD;
+ end;
+ TMouseInput = tagMOUSEINPUT;
+
+ PKeybdInput = ^TKeybdInput;
+ tagKEYBDINPUT = packed record
+ wVk: WORD;
+ wScan: WORD;
+ dwFlags: DWORD;
+ time: DWORD;
+ dwExtraInfo: DWORD;
+ end;
+ TKeybdInput = tagKEYBDINPUT;
+
+ PHardwareInput = ^THardwareInput;
+ tagHARDWAREINPUT = packed record
+ uMsg: DWORD;
+ wParamL: WORD;
+ wParamH: WORD;
+ end;
+ THardwareInput = tagHARDWAREINPUT;
+ PInput = ^TInput;
+ tagINPUT = packed record
+ Itype: DWORD;
+ case Integer of
+ 0: (mi: TMouseInput);
+ 1: (ki: TKeybdInput);
+ 2: (hi: THardwareInput);
+ end;
+ TInput = tagINPUT;
+const
+ INPUT_MOUSE = 0;
+ INPUT_KEYBOARD = 1;
+ INPUT_HARDWARE = 2;
+
+{Mouse}
+function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT; stdcall; external user32 name 'SendInput';
+{$ENDIF}
+
+constructor TMInput.Create(Client: TObject);
+begin
+ inherited Create;
+ Self.Client := Client;
+end;
+
+destructor TMInput.Destroy;
+begin
+
+ inherited;
+end;
+
+procedure TMInput.GetMousePos(var X, Y: Integer);
+{$IFDEF LINUX}
+var
+ b:integer;
+ root, child: twindow;
+ xmask: Cardinal;
+ Old_Handler: TXErrorHandler;
+{$ENDIF}
+{$IFDEF MSWINDOWS}
+var
+ MousePoint : TPoint;
+ Rect : TRect;
+{$ENDIF}
+begin
+ {$IFDEF MSWINDOWS}
+ Windows.GetCursorPos(MousePoint);
+ GetWindowRect(TClient(Client).MWindow.TargetHandle,Rect);
+ x := MousePoint.x - Rect.Left;
+ y := MousePoint.y - Rect.Top;
+ {$ENDIF}
+ {$IFDEF LINUX}
+ Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
+ XQueryPointer(TClient(Client).MWindow.XDisplay,TClient(Client).MWindow.CurWindow,@root,@child,@b,@b,@x,@y,@xmask);
+ XSetErrorHandler(Old_Handler);
+ {$ENDIF}
+end;
+
+procedure TMInput.SetMousePos(X, Y: Integer);
+{$IFDEF LINUX}
+var
+ Old_Handler: TXErrorHandler;
+{$ENDIF}
+{$IFDEF MSWINDOWS}
+var
+ rect : TRect;
+{$ENDIF}
+begin
+
+{$IFDEF MSWINDOWS}
+ GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect);
+ Windows.SetCursorPos(x + Rect.Left, y + Rect.Top);
+{$ENDIF}
+
+{$IFDEF LINUX}
+ Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
+ XWarpPointer(TClient(Client).MWindow.XDisplay, 0, TClient(Client).MWindow.CurWindow, 0, 0, 0, 0, X, Y);
+ XFlush(TClient(Client).MWindow.XDisplay);
+ XSetErrorHandler(Old_Handler);
+{$ENDIF}
+
+end;
+
+procedure TMInput.MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress);
+{$IFDEF LINUX}
+var
+ event : TXEvent;
+ Garbage : QWord;
+ Old_Handler: TXErrorHandler;
+{$ENDIF}
+{$IFDEF MSWINDOWS}
+var
+ Input : TInput;
+ Rect : TRect;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect);
+ Input.Itype:= INPUT_MOUSE;
+ Input.mi.dx:= x + Rect.left;
+ Input.mi.dy:= y + Rect.Top;
+ if mPress = mouse_Down then
+ begin
+ case mClick of
+ Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN;
+ Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEDOWN;
+ Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN;
+ end;
+ end else
+ case mClick of
+ Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP;
+ Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEUP;
+ Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP;
+ end;
+ SendInput(1,Input, sizeof(Input));
+{$ENDIF}
+
+{$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;
+
+procedure TMInput.ClickMouse(X, Y: Integer; mClick: TClickType);
+
+begin
+ Self.SetMousePos(x,y);
+ 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 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);
+ end;
+{$ENDIF}
+
+{$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/window.pas b/Units/MMLCore/window.pas
index 1c31aa9..ed63f0b 100644
--- a/Units/MMLCore/window.pas
+++ b/Units/MMLCore/window.pas
@@ -5,11 +5,11 @@ unit Window;
interface
uses
- Classes, SysUtils, mufasatypes
+ Classes, SysUtils, mufasatypes,
{$IFDEF MSWINDOWS}
,windows // For windows API
{$ENDIF}
- , graphics,
+ graphics,
LCLType,
LCLIntf // for ReleaseDC and such
@@ -33,7 +33,7 @@ type
function UpdateDrawBitmap:boolean;
{$ENDIF}
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload;
- function SetTarget(ArrPtr: PRGB32): integer; overload;
+ function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
constructor Create(Client: TObject);
destructor Destroy; override;
@@ -91,6 +91,9 @@ type
{$ENDIF}
+ ArrayPtr: PRGB32;
+ ArraySize: TPoint;
+
end;
@@ -107,6 +110,10 @@ constructor TMWindow.Create(Client: TObject);
begin
inherited Create;
Self.Client := Client;
+
+ Self.ArrayPtr := nil;
+ Self.ArraySize := Point(-1, -1);
+
{$IFDEF MSWINDOWS}
Self.DrawBitmap := TBitmap.Create;
Self.TargetMode:= w_Window;
@@ -114,6 +121,7 @@ begin
Self.TargetDC:= GetWindowDC(Self.TargetHandle);
Self.UpdateDrawBitmap;
{$ENDIF}
+
{$IFDEF LINUX}
Self.TargetMode := w_XWindow;
@@ -153,6 +161,8 @@ function TMWindow.ReturnData(xs, ys, width, height: Integer): PRGB32;
var
Old_Handler: TXErrorHandler;
{$ENDIF}
+ TmpData: PRGB32;
+
begin
case Self.TargetMode of
w_Window:
@@ -186,6 +196,12 @@ begin
WriteLn('Windows doesn''t support XImage');
{$ENDIF}
end;
+ w_ArrayPtr:
+ begin
+ TmpData := Self.ArrayPtr;
+ Inc(TmpData, ys * Height + xs);
+ Result := TmpData;
+ end;
end;
end;
@@ -221,13 +237,16 @@ begin
inttostr(ye));
ww := xe-xs;
hh := ye-ys;
+ if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then
+ begin
+ writeln('Faulty coordinates');
+ exit;
+ end;
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,
@@ -239,15 +258,7 @@ begin
{$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
- if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then
- begin
- writeln('Faulty coordinates');
- XSetErrorHandler(Old_Handler);
- exit;
- end;
-
Img := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, ww, hh, AllPlanes, ZPixmap);
- XImageToRawImage(Img, Raw);
Bmp := TBitmap.Create;
Bmp.LoadFromRawImage(Raw, False);
@@ -266,6 +277,15 @@ begin
writeln('Windows and tXWindow');
{$ENDIF}
end;
+ w_ArrayPtr:
+ begin
+
+ ArrDataToRawImage(Self.ArrayPtr, Self.ArraySize, Raw);
+
+ Bmp := TBitmap.Create;
+ Bmp.LoadFromRawImage(Raw, False);
+ Result := Bmp;
+ end;
end;
end;
@@ -336,6 +356,8 @@ begin
end;
w_ArrayPtr:
begin
+ W := Self.ArraySize.X;
+ H := Self.ArraySize.Y;
end;
end;
end;
@@ -375,10 +397,28 @@ begin
{$ENDIF}
end;
-function TMWindow.SetTarget(ArrPtr: PRGB32): integer; overload;
-begin
+{
+ This functionality is very BETA.
+ We have no way to send events to a window, so we should probably use the
+ desktop window?
+ eg: In mouse/keys: if Self.TargetMode not in [w_Window, w_XWindow], send it
+ to the desktop.
+}
+function TMWindow.SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload;
+begin
+ Self.ArrayPtr := ArrPtr;
+ Self.ArraySize := Size;
Self.TargetMode:= w_ArrayPtr;
+
+ {$IFDEF LINUX}
+ Self.CurWindow := Self.DesktopWindow;
+ {$ENDIF}
+
+ {$IFDEF WINDOWS}
+ Self.TargetHandle:= windows.GetDesktopWindow;
+ {$ENDIF}
+
end;
end.
diff --git a/Units/MMLCore/windowutil.pas b/Units/MMLCore/windowutil.pas
index 3ce165c..4833e40 100644
--- a/Units/MMLCore/windowutil.pas
+++ b/Units/MMLCore/windowutil.pas
@@ -6,19 +6,23 @@ interface
uses
Classes, SysUtils,
- ctypes // for cint, etc
- {$IFDEF LINUX},
+ ctypes, // for cint, etc
+ {$IFDEF LINUX}
x, xlib, // For X* stuff.
- GraphType // For TRawImage
- {$ENDIF};
+ GraphType, // For TRawImage
+ {$ENDIF}
+
+ mufasatypes;
{$IFDEF LINUX}
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
+ Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; Var RawImage: TRawImage);
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
{$ENDIF}
implementation
+
{$IFDEF LINUX}
// Too global.
@@ -81,5 +85,45 @@ Begin
End;
{$ENDIF}
+Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; Var RawImage: TRawImage);
+Begin
+ RawImage.Init; { Calls raw.Description.Init as well }
+
+ RawImage.Description.PaletteColorCount:=0;
+ RawImage.Description.MaskBitsPerPixel:=0;
+ RawImage.Description.Width := Size.X;
+ RawImage.Description.Height:= Size.Y;
+
+ RawImage.Description.Format := ricfRGBA;
+
+ RawImage.Description.ByteOrder := riboLSBFirst;
+
+ RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
+
+ RawImage.Description.Depth:=24;
+
+ RawImage.Description.BitsPerPixel:=32;
+
+ RawImage.Description.LineOrder:=riloTopToBottom;
+
+ RawImage.Description.LineEnd := rileDWordBoundary;
+
+ RawImage.Description.RedPrec := 8;
+ RawImage.Description.GreenPrec:= 8;
+ RawImage.Description.BluePrec:= 8;
+ RawImage.Description.AlphaPrec:=0;
+
+
+ RawImage.Description.RedShift:=16;
+ RawImage.Description.GreenShift:=8;
+ RawImage.Description.BlueShift:=0;
+
+ RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
+ * (RawImage.Description.bitsperpixel shr 3);
+
+ RawImage.Data := PByte(Ptr);
+
+End;
+
end.
diff --git a/project1.lpi b/project1.lpi
index 43c7635..90d188c 100644
--- a/project1.lpi
+++ b/project1.lpi
@@ -6,7 +6,7 @@
-
+
@@ -38,7 +38,7 @@
-
+
@@ -49,7 +49,7 @@
-
+
@@ -57,7 +57,7 @@
-
+
@@ -72,7 +72,7 @@
-
+
@@ -80,7 +80,7 @@
-
+
@@ -94,7 +94,7 @@
-
+
@@ -106,46 +106,48 @@
-
+
-
+
-
-
-
-
+
+
+
+
-
+
-
-
+
+
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+
@@ -180,10 +182,10 @@
-
-
+
+
-
+
@@ -282,103 +284,127 @@
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/testunit.lfm b/testunit.lfm
index 514c165..a9aeb74 100644
--- a/testunit.lfm
+++ b/testunit.lfm
@@ -1,20 +1,20 @@
-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
+object Form1: TForm1
+ Left = 1696
+ Height = 527
+ Top = 262
+ 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 0a5c0a4..f1a9cb8 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#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
-]);
+
+LazarusResources.Add('TForm1','FORMDATA',[
+ 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#160#6#6'Height'#3#15#2#3'Top'#3#6#1#5'Wid'
+ +'th'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientHe'
+ +'ight'#3#15#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
+]);
diff --git a/testunit.pas b/testunit.pas
index 525f995..0613894 100644
--- a/testunit.pas
+++ b/testunit.pas
@@ -1,119 +1,133 @@
-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.
-
+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, i:integer;
+ bmp: TBitmap;
+ ptr: PRGB32;
+ arr: Array Of Integer;
+
+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);
+
+ SetLength(Arr, 9);
+ for i := 0 to high(arr) do
+ arr[i] := $FFFFFF;
+
+ Client.MWIndow.SetTarget(PRGB32(@Arr[0]), Point(3, 3));
+
+ Client.MWindow.ActivateClient;
+ Client.MWindow.GetDimensions(w, h);
+ Writeln('Copying BMP');
+ bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h);
+
+ {$IFDEF WINDOWS}
+ bmp.SaveToFile('c:\test.bmp');
+ {$ENDIF}
+ {$IFDEF LINUX}
+ bmp.SaveToFile('/tmp/test.bmp');
+ {$ENDIF}
+ 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.
+