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:
parent
50ce4db8b4
commit
f14b73983b
@ -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.
|
||||||
|
|
||||||
|
@ -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.
|
||||||
|
@ -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.
|
||||||
|
|
||||||
|
164
project1.lpi
164
project1.lpi
@ -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>
|
||||||
|
40
testunit.lfm
40
testunit.lfm
@ -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
|
||||||
|
16
testunit.lrs
16
testunit.lrs
@ -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
|
||||||
]);
|
]);
|
||||||
|
252
testunit.pas
252
testunit.pas
@ -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.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user