1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-22 01:02:17 -05:00

Added support for array pointers.

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@13 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-09-04 01:59:31 +00:00
parent 50ce4db8b4
commit f14b73983b
7 changed files with 621 additions and 488 deletions

View File

@ -1,253 +1,262 @@
unit Input; unit Input;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, Classes, SysUtils,
mufasatypes, // for common mufasa types mufasatypes, // for common mufasa types
windowutil // for mufasa window utils windowutil // for mufasa window utils
{$IFDEF LINUX} {$IFDEF LINUX}
,x, xlib // for X* stuff ,x, xlib // for X* stuff
{$ENDIF}; {$ENDIF};
type type
TMInput = class(TObject) TMInput = class(TObject)
constructor Create(Client: TObject); constructor Create(Client: TObject);
destructor Destroy; override; destructor Destroy; override;
procedure GetMousePos(var X, Y: Integer); procedure GetMousePos(var X, Y: Integer);
procedure SetMousePos(X, Y: Integer); procedure SetMousePos(X, Y: Integer);
procedure MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress); procedure MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress);
procedure ClickMouse(X, Y: Integer; mClick: TClickType); procedure ClickMouse(X, Y: Integer; mClick: TClickType);
function IsMouseButtonDown(mType: TClickType): Boolean;
{
public Possibly change to GetMouseButtonStates? Then people can get the
Client: TObject; states bitwise. Like X and WinAPI.
}
end; function IsMouseButtonDown(mType: TClickType): Boolean;
implementation public
Client: TObject;
uses
Client{$IFDEF MSWINDOWS},windows{$ENDIF}; end;
{$IFDEF MSWINDOWS} implementation
type
PMouseInput = ^TMouseInput; uses
tagMOUSEINPUT = packed record Client{$IFDEF MSWINDOWS},windows{$ENDIF};
dx: Longint;
dy: Longint; {$IFDEF MSWINDOWS}
mouseData: DWORD; type
dwFlags: DWORD; PMouseInput = ^TMouseInput;
time: DWORD; tagMOUSEINPUT = packed record
dwExtraInfo: DWORD; dx: Longint;
end; dy: Longint;
TMouseInput = tagMOUSEINPUT; mouseData: DWORD;
dwFlags: DWORD;
PKeybdInput = ^TKeybdInput; time: DWORD;
tagKEYBDINPUT = packed record dwExtraInfo: DWORD;
wVk: WORD; end;
wScan: WORD; TMouseInput = tagMOUSEINPUT;
dwFlags: DWORD;
time: DWORD; PKeybdInput = ^TKeybdInput;
dwExtraInfo: DWORD; tagKEYBDINPUT = packed record
end; wVk: WORD;
TKeybdInput = tagKEYBDINPUT; wScan: WORD;
dwFlags: DWORD;
PHardwareInput = ^THardwareInput; time: DWORD;
tagHARDWAREINPUT = packed record dwExtraInfo: DWORD;
uMsg: DWORD; end;
wParamL: WORD; TKeybdInput = tagKEYBDINPUT;
wParamH: WORD;
end; PHardwareInput = ^THardwareInput;
THardwareInput = tagHARDWAREINPUT; tagHARDWAREINPUT = packed record
PInput = ^TInput; uMsg: DWORD;
tagINPUT = packed record wParamL: WORD;
Itype: DWORD; wParamH: WORD;
case Integer of end;
0: (mi: TMouseInput); THardwareInput = tagHARDWAREINPUT;
1: (ki: TKeybdInput); PInput = ^TInput;
2: (hi: THardwareInput); tagINPUT = packed record
end; Itype: DWORD;
TInput = tagINPUT; case Integer of
const 0: (mi: TMouseInput);
INPUT_MOUSE = 0; 1: (ki: TKeybdInput);
INPUT_KEYBOARD = 1; 2: (hi: THardwareInput);
INPUT_HARDWARE = 2; end;
TInput = tagINPUT;
{Mouse} const
function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT; stdcall; external user32 name 'SendInput'; INPUT_MOUSE = 0;
{$ENDIF} INPUT_KEYBOARD = 1;
INPUT_HARDWARE = 2;
constructor TMInput.Create(Client: TObject);
begin {Mouse}
inherited Create; function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT; stdcall; external user32 name 'SendInput';
Self.Client := Client; {$ENDIF}
end;
constructor TMInput.Create(Client: TObject);
destructor TMInput.Destroy; begin
begin inherited Create;
Self.Client := Client;
inherited; end;
end;
destructor TMInput.Destroy;
procedure TMInput.GetMousePos(var X, Y: Integer); begin
{$IFDEF LINUX}
var inherited;
b:integer; end;
root, child: twindow;
xmask: Cardinal; procedure TMInput.GetMousePos(var X, Y: Integer);
Old_Handler: TXErrorHandler; {$IFDEF LINUX}
{$ENDIF} var
{$IFDEF MSWINDOWS} b:integer;
var root, child: twindow;
MousePoint : TPoint; xmask: Cardinal;
Rect : TRect; Old_Handler: TXErrorHandler;
{$ENDIF} {$ENDIF}
begin {$IFDEF MSWINDOWS}
{$IFDEF MSWINDOWS} var
Windows.GetCursorPos(MousePoint); MousePoint : TPoint;
GetWindowRect(TClient(Client).MWindow.TargetHandle,Rect); Rect : TRect;
x := MousePoint.x - Rect.Left; {$ENDIF}
y := MousePoint.y - Rect.Top; begin
{$ENDIF} {$IFDEF MSWINDOWS}
{$IFDEF LINUX} Windows.GetCursorPos(MousePoint);
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); GetWindowRect(TClient(Client).MWindow.TargetHandle,Rect);
XQueryPointer(TClient(Client).MWindow.XDisplay,TClient(Client).MWindow.CurWindow,@root,@child,@b,@b,@x,@y,@xmask); x := MousePoint.x - Rect.Left;
XSetErrorHandler(Old_Handler); y := MousePoint.y - Rect.Top;
{$ENDIF} {$ENDIF}
end; {$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
procedure TMInput.SetMousePos(X, Y: Integer); XQueryPointer(TClient(Client).MWindow.XDisplay,TClient(Client).MWindow.CurWindow,@root,@child,@b,@b,@x,@y,@xmask);
{$IFDEF LINUX} XSetErrorHandler(Old_Handler);
var {$ENDIF}
Old_Handler: TXErrorHandler; end;
{$ENDIF}
{$IFDEF MSWINDOWS} procedure TMInput.SetMousePos(X, Y: Integer);
var {$IFDEF LINUX}
rect : TRect; var
{$ENDIF} Old_Handler: TXErrorHandler;
begin {$ENDIF}
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect); var
Windows.SetCursorPos(x + Rect.Left, y + Rect.Top); rect : TRect;
{$ENDIF}
{$ENDIF} begin
{$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); {$IFDEF MSWINDOWS}
XWarpPointer(TClient(Client).MWindow.XDisplay, 0, TClient(Client).MWindow.CurWindow, 0, 0, 0, 0, X, Y); GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect);
XFlush(TClient(Client).MWindow.XDisplay); Windows.SetCursorPos(x + Rect.Left, y + Rect.Top);
XSetErrorHandler(Old_Handler); {$ENDIF}
{$ENDIF}
end; {$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
procedure TMInput.MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress); XWarpPointer(TClient(Client).MWindow.XDisplay, 0, TClient(Client).MWindow.CurWindow, 0, 0, 0, 0, X, Y);
{$IFDEF LINUX} XFlush(TClient(Client).MWindow.XDisplay);
var XSetErrorHandler(Old_Handler);
event : TXEvent; {$ENDIF}
Garbage : QWord;
Old_Handler: TXErrorHandler; end;
{$ENDIF}
{$IFDEF MSWINDOWS} procedure TMInput.MouseButtonAction(x,y : integer; mClick: TClickType; mPress: TMousePress);
var {$IFDEF LINUX}
Input : TInput; var
Rect : TRect; event : TXEvent;
{$ENDIF} Garbage : QWord;
begin; Old_Handler: TXErrorHandler;
{$IFDEF MSWINDOWS} {$ENDIF}
GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect); {$IFDEF MSWINDOWS}
Input.Itype:= INPUT_MOUSE; var
Input.mi.dx:= x + Rect.left; Input : TInput;
Input.mi.dy:= y + Rect.Top; Rect : TRect;
if mPress = mouse_Down then {$ENDIF}
begin; begin
case mClick of {$IFDEF MSWINDOWS}
Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN; GetWindowRect(TClient(Client).MWindow.TargetHandle, Rect);
Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEDOWN; Input.Itype:= INPUT_MOUSE;
Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN; Input.mi.dx:= x + Rect.left;
end; Input.mi.dy:= y + Rect.Top;
end else if mPress = mouse_Down then
case mClick of begin
Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP; case mClick of
Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEUP; Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN;
Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP; Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEDOWN;
end; Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN;
SendInput(1,Input, sizeof(Input)); end;
{$ENDIF} end else
{$IFDEF LINUX} case mClick of
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); Mouse_Left: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP;
Mouse_Middle: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MIDDLEUP;
FillChar(event,sizeof(TXevent),0); Mouse_Right: Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP;
end;
if mPress = mouse_Down then SendInput(1,Input, sizeof(Input));
Event._type:= ButtonPress {$ENDIF}
else
Event._type:= ButtonRelease; {$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
case mClick of
mouse_Left: Event.xbutton.button:= Button1; FillChar(event,sizeof(TXevent),0);
mouse_Middle: Event.xbutton.button:= Button2;
mouse_Right: Event.xbutton.button:= Button3; if mPress = mouse_Down then
end; Event._type:= ButtonPress
else
event.xbutton.send_event := 1; Event._type:= ButtonRelease;
event.xbutton.same_screen:= 1;
event.xbutton.subwindow:= 0; case mClick of
event.xbutton.root := TClient(Client).MWindow.DesktopWindow; mouse_Left: Event.xbutton.button:= Button1;
event.xbutton.window := TClient(Client).MWindow.CurWindow; mouse_Middle: Event.xbutton.button:= Button2;
event.xbutton.x_root:= x; mouse_Right: Event.xbutton.button:= Button3;
event.xbutton.y_root:= y; end;
event.xbutton.x := x;
event.xbutton.y := y; event.xbutton.send_event := 1;
event.xbutton.state:= 0; event.xbutton.same_screen:= 1;
if(XSendEvent(TClient(Client).MWindow.XDisplay, PointerWindow, True, $fff, @event) = 0) then event.xbutton.subwindow:= 0;
Writeln('Errorrrr :-('); event.xbutton.root := TClient(Client).MWindow.DesktopWindow;
XFlush(TClient(Client).MWindow.XDisplay); event.xbutton.window := TClient(Client).MWindow.CurWindow;
event.xbutton.x_root:= x;
XSetErrorHandler(Old_Handler); event.xbutton.y_root:= y;
{$ENDIF} event.xbutton.x := x;
end; event.xbutton.y := y;
event.xbutton.state:= 0;
// ff omzetten naar MouseButtonDown(), en dan Click gewoon down en dan up. if(XSendEvent(TClient(Client).MWindow.XDisplay, PointerWindow, True, $fff, @event) = 0) then
// holdmouse releasemouse Writeln('Errorrrr :-(');
procedure TMInput.ClickMouse(X, Y: Integer; mClick: TClickType); XFlush(TClient(Client).MWindow.XDisplay);
begin XSetErrorHandler(Old_Handler);
Self.SetMousePos(x,y); {$ENDIF}
Self.MouseButtonAction(X, Y, mClick, mouse_Down); end;
Self.MouseButtonAction(X, Y, mClick, mouse_Up);
end; procedure TMInput.ClickMouse(X, Y: Integer; mClick: TClickType);
function TMInput.IsMouseButtonDown(mType: TClickType): Boolean; begin
{$IFDEF LINUX} Self.SetMousePos(x,y);
var Self.MouseButtonAction(X, Y, mClick, mouse_Down);
rootx, rooty, x, y:integer; Self.MouseButtonAction(X, Y, mClick, mouse_Up);
root, child: twindow; end;
xmask: Cardinal;
Old_Handler: TXErrorHandler; function TMInput.IsMouseButtonDown(mType: TClickType): Boolean;
{$ENDIF} {$IFDEF LINUX}
begin var
{$IFDEF MSWINDOWS} rootx, rooty, x, y:integer;
case mType of root, child: twindow;
Mouse_Left: Result := (GetAsyncKeyState(VK_LBUTTON) <> 0); xmask: Cardinal;
Mouse_Middle: Result := (GetAsyncKeyState(VK_MBUTTON) <> 0); Old_Handler: TXErrorHandler;
mouse_Right: Result := (GetAsyncKeyState(VK_RBUTTON) <> 0); {$ENDIF}
end; begin
{$ENDIF}
{$IFDEF LINUX} {$IFDEF MSWINDOWS}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); case mType of
XQueryPointer(TClient(Client).MWindow.XDisplay,TClient(Client).MWindow.CurWindow,@root,@child,@rootx,@rooty,@x,@y,@xmask); Mouse_Left: Result := (GetAsyncKeyState(VK_LBUTTON) <> 0);
Mouse_Middle: Result := (GetAsyncKeyState(VK_MBUTTON) <> 0);
case mType of mouse_Right: Result := (GetAsyncKeyState(VK_RBUTTON) <> 0);
mouse_Left: Result := (xmask and Button1Mask) <> 0; end;
mouse_Middle: Result := (xmask and Button2Mask) <> 0; {$ENDIF}
mouse_Right: Result := (xmask and Button3Mask) <> 0;
end; {$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler);
XSetErrorHandler(Old_Handler); XQueryPointer(TClient(Client).MWindow.XDisplay,TClient(Client).MWindow.CurWindow,@root,@child,@rootx,@rooty,@x,@y,@xmask);
{$ENDIF}
end; case mType of
mouse_Left: Result := (xmask and Button1Mask) <> 0;
end. mouse_Middle: Result := (xmask and Button2Mask) <> 0;
mouse_Right: Result := (xmask and Button3Mask) <> 0;
end;
XSetErrorHandler(Old_Handler);
{$ENDIF}
end;
end.

View File

@ -5,11 +5,11 @@ unit Window;
interface interface
uses uses
Classes, SysUtils, mufasatypes Classes, SysUtils, mufasatypes,
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
,windows // For windows API ,windows // For windows API
{$ENDIF} {$ENDIF}
, graphics, graphics,
LCLType, LCLType,
LCLIntf // for ReleaseDC and such LCLIntf // for ReleaseDC and such
@ -33,7 +33,7 @@ type
function UpdateDrawBitmap:boolean; function UpdateDrawBitmap:boolean;
{$ENDIF} {$ENDIF}
function SetTarget(Window: THandle; NewType: TTargetWindowMode): integer; overload; 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); constructor Create(Client: TObject);
destructor Destroy; override; destructor Destroy; override;
@ -91,6 +91,9 @@ type
{$ENDIF} {$ENDIF}
ArrayPtr: PRGB32;
ArraySize: TPoint;
end; end;
@ -107,6 +110,10 @@ constructor TMWindow.Create(Client: TObject);
begin begin
inherited Create; inherited Create;
Self.Client := Client; Self.Client := Client;
Self.ArrayPtr := nil;
Self.ArraySize := Point(-1, -1);
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
Self.DrawBitmap := TBitmap.Create; Self.DrawBitmap := TBitmap.Create;
Self.TargetMode:= w_Window; Self.TargetMode:= w_Window;
@ -114,6 +121,7 @@ begin
Self.TargetDC:= GetWindowDC(Self.TargetHandle); Self.TargetDC:= GetWindowDC(Self.TargetHandle);
Self.UpdateDrawBitmap; Self.UpdateDrawBitmap;
{$ENDIF} {$ENDIF}
{$IFDEF LINUX} {$IFDEF LINUX}
Self.TargetMode := w_XWindow; Self.TargetMode := w_XWindow;
@ -153,6 +161,8 @@ function TMWindow.ReturnData(xs, ys, width, height: Integer): PRGB32;
var var
Old_Handler: TXErrorHandler; Old_Handler: TXErrorHandler;
{$ENDIF} {$ENDIF}
TmpData: PRGB32;
begin begin
case Self.TargetMode of case Self.TargetMode of
w_Window: w_Window:
@ -186,6 +196,12 @@ begin
WriteLn('Windows doesn''t support XImage'); WriteLn('Windows doesn''t support XImage');
{$ENDIF} {$ENDIF}
end; end;
w_ArrayPtr:
begin
TmpData := Self.ArrayPtr;
Inc(TmpData, ys * Height + xs);
Result := TmpData;
end;
end; end;
end; end;
@ -221,13 +237,16 @@ begin
inttostr(ye)); inttostr(ye));
ww := xe-xs; ww := xe-xs;
hh := ye-ys; 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 case Self.TargetMode Of
w_Window: w_Window:
begin begin
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
if(xs < 0) or (ys < 0) or (xe > W) or (ye > H) then
Writeln('pervet');
Result := TBitmap.Create; Result := TBitmap.Create;
Result.SetSize(ww+1,hh+1); Result.SetSize(ww+1,hh+1);
BitBlt(result.canvas.handle,0,0,ww+1,hh+1, BitBlt(result.canvas.handle,0,0,ww+1,hh+1,
@ -239,15 +258,7 @@ begin
{$IFDEF LINUX} {$IFDEF LINUX}
Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); 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); Img := XGetImage(Self.XDisplay, Self.curWindow, xs, ys, ww, hh, AllPlanes, ZPixmap);
XImageToRawImage(Img, Raw);
Bmp := TBitmap.Create; Bmp := TBitmap.Create;
Bmp.LoadFromRawImage(Raw, False); Bmp.LoadFromRawImage(Raw, False);
@ -266,6 +277,15 @@ begin
writeln('Windows and tXWindow'); writeln('Windows and tXWindow');
{$ENDIF} {$ENDIF}
end; end;
w_ArrayPtr:
begin
ArrDataToRawImage(Self.ArrayPtr, Self.ArraySize, Raw);
Bmp := TBitmap.Create;
Bmp.LoadFromRawImage(Raw, False);
Result := Bmp;
end;
end; end;
end; end;
@ -336,6 +356,8 @@ begin
end; end;
w_ArrayPtr: w_ArrayPtr:
begin begin
W := Self.ArraySize.X;
H := Self.ArraySize.Y;
end; end;
end; end;
end; end;
@ -375,10 +397,28 @@ begin
{$ENDIF} {$ENDIF}
end; 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; Self.TargetMode:= w_ArrayPtr;
{$IFDEF LINUX}
Self.CurWindow := Self.DesktopWindow;
{$ENDIF}
{$IFDEF WINDOWS}
Self.TargetHandle:= windows.GetDesktopWindow;
{$ENDIF}
end; end;
end. end.

View File

@ -6,19 +6,23 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
ctypes // for cint, etc ctypes, // for cint, etc
{$IFDEF LINUX}, {$IFDEF LINUX}
x, xlib, // For X* stuff. x, xlib, // For X* stuff.
GraphType // For TRawImage GraphType, // For TRawImage
{$ENDIF}; {$ENDIF}
mufasatypes;
{$IFDEF LINUX} {$IFDEF LINUX}
Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage); Procedure XImageToRawImage(XImg: PXImage; Var RawImage: TRawImage);
Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; Var RawImage: TRawImage);
function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl; function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl;
{$ENDIF} {$ENDIF}
implementation implementation
{$IFDEF LINUX} {$IFDEF LINUX}
// Too global. // Too global.
@ -81,5 +85,45 @@ Begin
End; End;
{$ENDIF} {$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. end.

View File

@ -6,7 +6,7 @@
<MainUnit Value="0"/> <MainUnit Value="0"/>
<TargetFileExt Value=""/> <TargetFileExt Value=""/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<ActiveEditorIndexAtStart Value="3"/> <ActiveEditorIndexAtStart Value="2"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
@ -38,7 +38,7 @@
<CursorPos X="1" Y="19"/> <CursorPos X="1" Y="19"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="48"/> <UsageCount Value="51"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -49,7 +49,7 @@
<UnitName Value="TestUnit"/> <UnitName Value="TestUnit"/>
<CursorPos X="33" Y="57"/> <CursorPos X="33" Y="57"/>
<TopLine Value="32"/> <TopLine Value="32"/>
<UsageCount Value="48"/> <UsageCount Value="51"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="client.pas"/> <Filename Value="client.pas"/>
@ -57,7 +57,7 @@
<UnitName Value="Client"/> <UnitName Value="Client"/>
<CursorPos X="18" Y="34"/> <CursorPos X="18" Y="34"/>
<TopLine Value="10"/> <TopLine Value="10"/>
<UsageCount Value="48"/> <UsageCount Value="51"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/> <Filename Value="../cogat/Units/CogatUnits/comptypes.pas"/>
@ -72,7 +72,7 @@
<UnitName Value="MufasaTypes"/> <UnitName Value="MufasaTypes"/>
<CursorPos X="52" Y="20"/> <CursorPos X="52" Y="20"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="48"/> <UsageCount Value="51"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="window.pas"/> <Filename Value="window.pas"/>
@ -80,7 +80,7 @@
<UnitName Value="Window"/> <UnitName Value="Window"/>
<CursorPos X="4" Y="100"/> <CursorPos X="4" Y="100"/>
<TopLine Value="85"/> <TopLine Value="85"/>
<UsageCount Value="48"/> <UsageCount Value="51"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="../Documents/fpc/rtl/inc/systemh.inc"/> <Filename Value="../Documents/fpc/rtl/inc/systemh.inc"/>
@ -94,7 +94,7 @@
<UnitName Value="Input"/> <UnitName Value="Input"/>
<CursorPos X="5" Y="20"/> <CursorPos X="5" Y="20"/>
<TopLine Value="15"/> <TopLine Value="15"/>
<UsageCount Value="47"/> <UsageCount Value="50"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="../cogat/Units/CogatUnits/compinput.pas"/> <Filename Value="../cogat/Units/CogatUnits/compinput.pas"/>
@ -106,46 +106,48 @@
<Unit9> <Unit9>
<Filename Value="Units/MMLCore/client.pas"/> <Filename Value="Units/MMLCore/client.pas"/>
<UnitName Value="Client"/> <UnitName Value="Client"/>
<CursorPos X="27" Y="16"/> <CursorPos X="46" Y="8"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="5"/> <EditorIndex Value="5"/>
<UsageCount Value="20"/> <UsageCount Value="22"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit9> </Unit9>
<Unit10> <Unit10>
<Filename Value="Units/MMLCore/input.pas"/> <Filename Value="Units/MMLCore/input.pas"/>
<UnitName Value="Input"/> <UnitName Value="Input"/>
<CursorPos X="52" Y="241"/> <CursorPos X="1" Y="1"/>
<TopLine Value="222"/> <TopLine Value="1"/>
<EditorIndex Value="1"/> <EditorIndex Value="6"/>
<UsageCount Value="20"/> <UsageCount Value="22"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit10> </Unit10>
<Unit11> <Unit11>
<Filename Value="Units/MMLCore/mufasatypes.pas"/> <Filename Value="Units/MMLCore/mufasatypes.pas"/>
<UnitName Value="MufasaTypes"/> <UnitName Value="MufasaTypes"/>
<CursorPos X="20" Y="3"/> <CursorPos X="1" Y="18"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="2"/> <EditorIndex Value="1"/>
<UsageCount Value="20"/> <UsageCount Value="22"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit11> </Unit11>
<Unit12> <Unit12>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<UnitName Value="Window"/> <UnitName Value="Window"/>
<CursorPos X="9" Y="370"/> <CursorPos X="10" Y="416"/>
<TopLine Value="353"/> <TopLine Value="396"/>
<EditorIndex Value="3"/> <EditorIndex Value="2"/>
<UsageCount Value="20"/> <UsageCount Value="22"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit12> </Unit12>
<Unit13> <Unit13>
<Filename Value="Units/MMLCore/windowutil.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="windowutil"/> <UnitName Value="windowutil"/>
<CursorPos X="45" Y="13"/> <CursorPos X="53" Y="122"/>
<TopLine Value="1"/> <TopLine Value="100"/>
<UsageCount Value="40"/> <EditorIndex Value="3"/>
<UsageCount Value="43"/>
<Loaded Value="True"/>
</Unit13> </Unit13>
<Unit14> <Unit14>
<Filename Value="../Documents/lazarus/lcl/graphics.pp"/> <Filename Value="../Documents/lazarus/lcl/graphics.pp"/>
@ -180,10 +182,10 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="TestUnit"/> <UnitName Value="TestUnit"/>
<CursorPos X="44" Y="67"/> <CursorPos X="41" Y="71"/>
<TopLine Value="50"/> <TopLine Value="54"/>
<EditorIndex Value="4"/> <EditorIndex Value="4"/>
<UsageCount Value="17"/> <UsageCount Value="19"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit18> </Unit18>
<Unit19> <Unit19>
@ -282,103 +284,127 @@
<UsageCount Value="10"/> <UsageCount Value="10"/>
</Unit32> </Unit32>
</Units> </Units>
<JumpHistory Count="24" HistoryIndex="23"> <JumpHistory Count="30" HistoryIndex="29">
<Position1> <Position1>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="18" Column="30" TopLine="1"/> <Caret Line="215" Column="10" TopLine="205"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="156" Column="10" TopLine="146"/> <Caret Line="225" Column="19" TopLine="215"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="testunit.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="58" Column="34" TopLine="43"/> <Caret Line="239" Column="19" TopLine="229"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="testunit.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="28" Column="59" TopLine="1"/> <Caret Line="261" Column="17" TopLine="251"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="project1.lpr"/> <Filename Value="testunit.pas"/>
<Caret Line="16" Column="60" TopLine="1"/> <Caret Line="68" Column="20" TopLine="53"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="project1.lpr"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="19" Column="1" TopLine="1"/> <Caret Line="329" Column="14" TopLine="298"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="testunit.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="50" Column="42" TopLine="35"/> <Caret Line="10" Column="10" TopLine="1"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="testunit.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="62" Column="32" TopLine="59"/> <Caret Line="367" Column="46" TopLine="353"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="testunit.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="57" Column="22" TopLine="41"/> <Caret Line="115" Column="36" TopLine="106"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="18" Column="27" TopLine="14"/> <Caret Line="114" Column="24" TopLine="99"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="169" Column="16" TopLine="159"/> <Caret Line="94" Column="26" TopLine="79"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="170" Column="16" TopLine="159"/> <Caret Line="58" Column="78" TopLine="45"/>
</Position12> </Position12>
<Position13> <Position13>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="176" Column="14" TopLine="159"/> <Caret Line="63" Column="37" TopLine="48"/>
</Position13> </Position13>
<Position14> <Position14>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="180" Column="17" TopLine="171"/> <Caret Line="69" Column="41" TopLine="68"/>
</Position14> </Position14>
<Position15> <Position15>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="181" Column="16" TopLine="171"/> <Caret Line="73" Column="37" TopLine="64"/>
</Position15> </Position15>
<Position16> <Position16>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="210" Column="16" TopLine="205"/> <Caret Line="26" Column="40" TopLine="11"/>
</Position16> </Position16>
<Position17> <Position17>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="215" Column="10" TopLine="205"/> <Caret Line="276" Column="28" TopLine="250"/>
</Position17> </Position17>
<Position18> <Position18>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="225" Column="19" TopLine="215"/> <Caret Line="22" Column="5" TopLine="12"/>
</Position18> </Position18>
<Position19> <Position19>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="239" Column="19" TopLine="229"/> <Caret Line="48" Column="39" TopLine="32"/>
</Position19> </Position19>
<Position20> <Position20>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="261" Column="17" TopLine="251"/> <Caret Line="52" Column="50" TopLine="39"/>
</Position20> </Position20>
<Position21> <Position21>
<Filename Value="testunit.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="68" Column="20" TopLine="53"/> <Caret Line="9" Column="10" TopLine="1"/>
</Position21> </Position21>
<Position22> <Position22>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="329" Column="14" TopLine="298"/> <Caret Line="10" Column="17" TopLine="1"/>
</Position22> </Position22>
<Position23> <Position23>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="10" Column="10" TopLine="1"/> <Caret Line="11" Column="3" TopLine="1"/>
</Position23> </Position23>
<Position24> <Position24>
<Filename Value="Units/MMLCore/window.pas"/> <Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="367" Column="46" TopLine="353"/> <Caret Line="12" Column="13" TopLine="1"/>
</Position24> </Position24>
<Position25>
<Filename Value="Units/MMLCore/windowutil.pas"/>
<Caret Line="88" Column="1" TopLine="1"/>
</Position25>
<Position26>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="275" Column="60" TopLine="251"/>
</Position26>
<Position27>
<Filename Value="Units/MMLCore/client.pas"/>
<Caret Line="8" Column="46" TopLine="1"/>
</Position27>
<Position28>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="419" Column="3" TopLine="390"/>
</Position28>
<Position29>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="382" Column="66" TopLine="369"/>
</Position29>
<Position30>
<Filename Value="Units/MMLCore/window.pas"/>
<Caret Line="202" Column="11" TopLine="187"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -1,20 +1,20 @@
object Form1: TForm1 object Form1: TForm1
Left = 966 Left = 1696
Height = 527 Height = 527
Top = 461 Top = 262
Width = 779 Width = 779
ActiveControl = Button1 ActiveControl = Button1
Caption = 'Form1' Caption = 'Form1'
ClientHeight = 527 ClientHeight = 527
ClientWidth = 779 ClientWidth = 779
LCLVersion = '0.9.29' LCLVersion = '0.9.29'
object Button1: TButton object Button1: TButton
Left = 69 Left = 69
Height = 25 Height = 25
Top = 32 Top = 32
Width = 75 Width = 75
Caption = 'Button1' Caption = 'Button1'
OnClick = Button1Click OnClick = Button1Click
TabOrder = 0 TabOrder = 0
end end
end end

View File

@ -1,9 +1,9 @@
{ This is an automatically generated lazarus resource file } { This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[ 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' 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#160#6#6'Height'#3#15#2#3'Top'#3#6#1#5'Wid'
+'idth'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'Client' +'th'#3#11#3#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientHe'
+'Height'#3#15#2#11'ClientWidth'#3#11#3#10'LCLVersion'#6#6'0.9.29'#0#7'TButto' +'ight'#3#15#2#11'ClientWidth'#3#11#3#10'LCLVersion'#6#6'0.9.29'#0#7'TButton'
+'n'#7'Button1'#4'Left'#2'E'#6'Height'#2#25#3'Top'#2' '#5'Width'#2'K'#7'Capti' +#7'Button1'#4'Left'#2'E'#6'Height'#2#25#3'Top'#2' '#5'Width'#2'K'#7'Caption'
+'on'#6#7'Button1'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#0 +#6#7'Button1'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#0
]); ]);

View File

@ -1,119 +1,133 @@
unit TestUnit; unit TestUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Client, MufasaTypes; StdCtrls, Client, MufasaTypes;
type type
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
Button1: TButton; Button1: TButton;
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
private private
{ private declarations } { private declarations }
public public
{ public declarations } { public declarations }
end; end;
var var
Form1: TForm1; Form1: TForm1;
implementation implementation
type type
TMyThread = class(TThread) TMyThread = class(TThread)
private private
protected protected
procedure Execute; override; procedure Execute; override;
public public
Constructor Create(CreateSuspended : boolean); Constructor Create(CreateSuspended : boolean);
end; end;
constructor TMyThread.Create(CreateSuspended : boolean); constructor TMyThread.Create(CreateSuspended : boolean);
begin begin
FreeOnTerminate := True; FreeOnTerminate := True;
inherited Create(CreateSuspended); inherited Create(CreateSuspended);
end; end;
procedure TMyThread.Execute; procedure TMyThread.Execute;
Var Var
Client: TClient; Client: TClient;
w,h, x, y, xx, yy:integer; w,h, x, y, xx, yy, i:integer;
bmp: TBitmap; bmp: TBitmap;
ptr: PRGB32; ptr: PRGB32;
arr: Array Of Integer;
begin
while (not Terminated) do begin
begin while (not Terminated) do
begin
Writeln('Creating the client');
Client := TClient.Create; Writeln('Creating the client');
Writeln('Getting the dimensions'); Client := TClient.Create;
Client.MWindow.GetDimensions(w, h); Writeln('Getting the dimensions');
writeln(inttostr(w) + ' , ' + inttostr(h)); Client.MWindow.GetDimensions(w, h);
Writeln('Setting target'); writeln(inttostr(w) + ' , ' + inttostr(h));
Client.MWindow.SetTarget(132840,w_window); Writeln('Setting target');
Client.MWindow.ActivateClient; //Client.MWindow.SetTarget(132840,w_window);
Client.MWindow.GetDimensions(w, h);
Writeln('Copying BMP'); SetLength(Arr, 9);
bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h); for i := 0 to high(arr) do
bmp.SaveToFile('c:\test.bmp'); arr[i] := $FFFFFF;
bmp.Free;
Client.MWIndow.SetTarget(PRGB32(@Arr[0]), Point(3, 3));
//Sleep(1000);
Client.MInput.GetMousePos(x, y); Client.MWindow.ActivateClient;
writeln(inttostr(x) + ' , ' + inttostr(y)); Client.MWindow.GetDimensions(w, h);
Writeln('Copying BMP');
Client.MInput.SetMousePos(50, 50); bmp := Client.MWindow.CopyClientToBitmap(0, 0, w, h);
Client.MInput.GetMousePos(x, y);
writeln(inttostr(x) + ' , ' + inttostr(y)); {$IFDEF WINDOWS}
bmp.SaveToFile('c:\test.bmp');
Client.MInput.ClickMouse(60, 60, mouse_Right); {$ENDIF}
{$IFDEF LINUX}
ptr := Client.MWindow.ReturnData(0, 0, w, h); bmp.SaveToFile('/tmp/test.bmp');
for yy := 0 to h - 1 do {$ENDIF}
for xx := 0 to w - 1 do bmp.Free;
begin
{ Do comparison here } //Sleep(1000);
inc(ptr); Client.MInput.GetMousePos(x, y);
end; writeln(inttostr(x) + ' , ' + inttostr(y));
Client.MWindow.FreeReturnData; Client.MInput.SetMousePos(50, 50);
Client.MInput.GetMousePos(x, y);
Client.MInput.IsMouseButtonDown(mouse_Left); writeln(inttostr(x) + ' , ' + inttostr(y));
Sleep(1000);
if Client.MInput.IsMouseButtonDown(mouse_Left) then Client.MInput.ClickMouse(60, 60, mouse_Right);
writeln('Left mouse is down!');
if Client.MInput.IsMouseButtonDown(mouse_Right) then ptr := Client.MWindow.ReturnData(0, 0, w, h);
writeln('Right mouse is down!'); for yy := 0 to h - 1 do
if Client.MInput.IsMouseButtonDown(mouse_Middle) then for xx := 0 to w - 1 do
writeln('Middle mouse is down!'); begin
Client.Destroy; { Do comparison here }
writeln('Test completed successfully'); inc(ptr);
break; end;
end;
end; Client.MWindow.FreeReturnData;
Client.MInput.IsMouseButtonDown(mouse_Left);
{ TForm1 } Sleep(1000);
if Client.MInput.IsMouseButtonDown(mouse_Left) then
procedure TForm1.Button1Click(Sender: TObject); writeln('Left mouse is down!');
Var if Client.MInput.IsMouseButtonDown(mouse_Right) then
MyThread: TMyThread; writeln('Right mouse is down!');
if Client.MInput.IsMouseButtonDown(mouse_Middle) then
begin writeln('Middle mouse is down!');
MyThread := TMyThread.Create(True); Client.Destroy;
MyThread.Resume; writeln('Test completed successfully');
end; break;
end;
initialization end;
{$I testunit.lrs}
end. { TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
Var
MyThread: TMyThread;
begin
MyThread := TMyThread.Create(True);
MyThread.Resume;
end;
initialization
{$I testunit.lrs}
end.