mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-23 15:58:51 -05:00
MML: Add GetClientPosition.
Fully implemented in the IOManager and EIOS structure. Updated documentation to reflect change.
This commit is contained in:
parent
bc243c0dc8
commit
3a8a967e17
@ -49,6 +49,17 @@ GetClientDimensions
|
||||
procedure GetClientDimensions(var w, h:integer);
|
||||
|
||||
Return the size of the client in *w* and *h*.
|
||||
If it fails, it returns -1 for both h and w.
|
||||
|
||||
GetClientDimensions
|
||||
-------------------
|
||||
|
||||
.. code-block:: pascal
|
||||
|
||||
procedure GetClientPosition(var left, top:integer);
|
||||
|
||||
Return the position of the client in *left* and *top*.
|
||||
May return negative values.
|
||||
|
||||
|
||||
SetTargetBitmap
|
||||
|
@ -81,6 +81,11 @@ begin
|
||||
CurrThread.Client.IOManager.GetDimensions(w, h);
|
||||
end;
|
||||
|
||||
procedure ps_GetClientPosition(var left, top: integer); extdecl;
|
||||
begin
|
||||
CurrThread.Client.IOManager.GetPosition(left, top);
|
||||
end;
|
||||
|
||||
function ps_Freeze: boolean; extdecl;
|
||||
begin
|
||||
CurrThread.Client.IOManager.SetFrozen(true);
|
||||
|
@ -112,6 +112,7 @@ SetCurrSection('Window');
|
||||
AddFunction(@ps_Freeze, 'function Freeze: boolean;');
|
||||
AddFunction(@ps_Unfreeze, 'function Unfreeze: boolean;');
|
||||
AddFunction(@ps_GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
|
||||
AddFunction(@ps_GetClientPosition, 'procedure GetClientPosition(var left, top:integer);');
|
||||
AddFunction(@ps_SetTargetBitmap,'function SetTargetBitmap(Bitmap : integer): integer;');
|
||||
AddFunction(@ps_SetTargetArray, 'function SetTargetArray(P: Integer; w, h: integer): integer;');
|
||||
AddFunction(@ps_SetEIOSTarget, 'function SetEIOSTarget(name: string; initargs: Variant): integer;');
|
||||
|
@ -43,6 +43,7 @@ interface
|
||||
| to raise exceptions. GetColor provides default functionality using ReturData of width 1.
|
||||
| FreeReturnData provides default of doing nothing. }
|
||||
procedure GetTargetDimensions(var w, h: integer); virtual;
|
||||
procedure GetTargetPosition(var left, top: integer); virtual;
|
||||
function GetColor(x,y : integer) : TColor; virtual;
|
||||
function ReturnData(xs, ys, width, height: Integer): TRetData; virtual;
|
||||
procedure FreeReturnData; virtual;
|
||||
@ -80,6 +81,7 @@ interface
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure GetTargetDimensions(var w, h: integer); override;
|
||||
procedure GetTargetPosition(var left, top: integer); override;
|
||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||
|
||||
protected
|
||||
@ -108,6 +110,7 @@ interface
|
||||
TWindow_Abstract = class(TTarget)
|
||||
public
|
||||
procedure GetTargetDimensions(var w, h: integer); override; abstract;
|
||||
procedure GetTargetPosition(var left, top: integer); override; abstract;
|
||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override; abstract;
|
||||
|
||||
function TargetValid: boolean; override; abstract;
|
||||
@ -136,6 +139,7 @@ interface
|
||||
ReleaseTarget: procedure(target: pointer); stdcall;
|
||||
|
||||
GetTargetDimensions: procedure(target: pointer; var w, h: integer); stdcall;
|
||||
GetTargetPosition: procedure(var left, top: integer); stdcall;
|
||||
GetImageBuffer: function(target: pointer): prgb32; stdcall;
|
||||
UpdateImageBuffer: procedure(target: pointer); stdcall;
|
||||
UpdateImageBufferBounds: procedure(target: pointer; sx,sy,ex,ey: integer); stdcall;
|
||||
@ -169,6 +173,7 @@ interface
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure GetTargetDimensions(var w, h: integer); override;
|
||||
procedure GetTargetPosition(var left, top: integer); override;
|
||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||
|
||||
procedure GetMousePosition(var x,y: integer); override;
|
||||
@ -227,6 +232,7 @@ interface
|
||||
Target : Pointer;
|
||||
|
||||
GetTargetDimensions: procedure(target: pointer; var w, h: integer); stdcall;
|
||||
GetTargetPosition: procedure(target: pointer; var top, left: integer); stdcall;
|
||||
GetColor : function(target: pointer;x,y : integer) : integer; stdcall;
|
||||
ReturnData : function(target: pointer;xs, ys, width, height: Integer): TRetData; stdcall;
|
||||
FreeReturnData : procedure(target: pointer); stdcall;
|
||||
@ -278,6 +284,7 @@ interface
|
||||
procedure FreeReturnData;
|
||||
|
||||
procedure GetDimensions(var W, H: Integer);
|
||||
procedure GetPosition(var Left, Top: Integer);
|
||||
procedure ActivateClient;
|
||||
|
||||
function IsFrozen: boolean;
|
||||
@ -334,6 +341,7 @@ interface
|
||||
|
||||
{These wrappers are for an exported TTarget_Exported. This is done so a plugin can acces the current target and use its methodes}
|
||||
procedure TTarget_Exported_GetTargetDimensions(target: pointer; var w, h: integer); stdcall;
|
||||
procedure TTarget_Exported_GetTargetPosition(target: pointer; var left, top: integer); stdcall;
|
||||
function TTarget_Exported_GetColor (target: pointer;x,y : integer) : integer; stdcall;
|
||||
function TTarget_Exported_ReturnData (target: pointer;xs, ys, width, height: Integer): TRetData; stdcall;
|
||||
procedure TTarget_Exported_FreeReturnData(target: pointer); stdcall;
|
||||
@ -466,6 +474,7 @@ begin
|
||||
begin
|
||||
Target:= image;
|
||||
GetTargetDimensions:= @TTarget_Exported_GetTargetDimensions;
|
||||
GetTargetPosition := @TTarget_Exported_GetTargetPosition;
|
||||
GetColor:= @TTarget_Exported_GetColor;
|
||||
ReturnData := @TTarget_Exported_ReturnData;
|
||||
FreeReturnData:= @TTarget_Exported_FreeReturnData;
|
||||
@ -532,10 +541,12 @@ function TIOManager_Abstract.GetColor(x,y : integer) : TColor;
|
||||
begin
|
||||
result:= image.GetColor(x,y);
|
||||
end;
|
||||
|
||||
function TIOManager_Abstract.ReturnData(xs,ys,width,height: integer): TRetData;
|
||||
begin
|
||||
result:= image.ReturnData(xs,ys,width,height);
|
||||
end;
|
||||
|
||||
procedure TIOManager_Abstract.FreeReturnData;
|
||||
begin
|
||||
image.freeReturnData();
|
||||
@ -599,7 +610,16 @@ begin
|
||||
result := (keymouse.TargetValid and image.TargetValid);
|
||||
end;
|
||||
|
||||
procedure TIOManager_Abstract.GetDimensions(var W, H: Integer); begin image.GetTargetDimensions(w,h) end;
|
||||
procedure TIOManager_Abstract.GetDimensions(var W, H: Integer);
|
||||
begin
|
||||
image.GetTargetDimensions(w,h)
|
||||
end;
|
||||
|
||||
procedure TIOManager_Abstract.GetPosition(var Left, Top: Integer);
|
||||
begin
|
||||
image.GetTargetPosition(Left, Top);
|
||||
end;
|
||||
|
||||
procedure TIOManager_Abstract.ActivateClient;
|
||||
begin
|
||||
keymouse.ActivateClient();
|
||||
@ -699,30 +719,88 @@ end;
|
||||
|
||||
//***implementation*** TTarget
|
||||
|
||||
procedure TTarget.GetTargetDimensions(var w, h: integer); begin raise Exception.Create('GetTargetDimensions not available for this target'); end;
|
||||
procedure TTarget.GetTargetDimensions(var w, h: integer);
|
||||
begin
|
||||
raise Exception.Create('GetTargetDimensions not available for this target');
|
||||
end;
|
||||
|
||||
procedure TTarget.GetTargetPosition(var left, top: integer);
|
||||
begin
|
||||
raise Exception.Create('GetTargetDimensions not available for this target');
|
||||
end;
|
||||
|
||||
function TTarget.GetColor(x,y : integer) : TColor;
|
||||
begin
|
||||
with ReturnData(x,y,1,1) do
|
||||
Result := RGBToColor(Ptr[0].r,Ptr[0].g,Ptr[0].b);
|
||||
FreeReturnData;
|
||||
end;
|
||||
function TTarget.ReturnData(xs, ys, width, height: Integer): TRetData; begin raise Exception.Create('ReturnData not available for this target'); end;
|
||||
procedure TTarget.FreeReturnData; begin {do nothing by default} end;
|
||||
procedure TTarget.ActivateClient; begin raise Exception.Create('ActivateClient not available for this target'); end;
|
||||
function TTarget.TargetValid: boolean; begin result:= true; end;
|
||||
function TTarget.ReturnData(xs, ys, width, height: Integer): TRetData;
|
||||
begin
|
||||
raise Exception.Create('ReturnData not available for this target');
|
||||
end;
|
||||
procedure TTarget.FreeReturnData;
|
||||
begin
|
||||
{do nothing by default}
|
||||
end;
|
||||
procedure TTarget.ActivateClient;
|
||||
begin
|
||||
raise Exception.Create('ActivateClient not available for this target');
|
||||
end;
|
||||
function TTarget.TargetValid: boolean;
|
||||
begin
|
||||
result:= true;
|
||||
end;
|
||||
|
||||
procedure TTarget.GetMousePosition(var x,y: integer); begin raise Exception.Create('GetMousePosition not available for this target'); end;
|
||||
procedure TTarget.MoveMouse(x,y: integer); begin raise Exception.Create('MoveMouse not available for this target'); end;
|
||||
procedure TTarget.ScrollMouse(x,y : integer; lines : integer); begin raise Exception.Create('ScrollMouse is not available for this target'); end;
|
||||
procedure TTarget.HoldMouse(x,y: integer; button: TClickType); begin raise Exception.Create('HoldMouse not available for this target'); end;
|
||||
procedure TTarget.ReleaseMouse(x,y: integer; button: TClickType); begin raise Exception.Create('ReleaseMouse not available for this target'); end;
|
||||
function TTarget.IsMouseButtonHeld(button: TClickType): boolean; begin raise Exception.Create('IsMouseButtonHeld not available for this target'); end;
|
||||
procedure TTarget.GetMousePosition(var x,y: integer);
|
||||
begin
|
||||
raise Exception.Create('GetMousePosition not available for this target');
|
||||
end;
|
||||
procedure TTarget.MoveMouse(x,y: integer);
|
||||
begin
|
||||
raise Exception.Create('MoveMouse not available for this target');
|
||||
end;
|
||||
procedure TTarget.ScrollMouse(x,y : integer; lines : integer);
|
||||
begin
|
||||
raise Exception.Create('ScrollMouse is not available for this target');
|
||||
end;
|
||||
procedure TTarget.HoldMouse(x,y: integer; button: TClickType);
|
||||
begin
|
||||
raise Exception.Create('HoldMouse not available for this target');
|
||||
end;
|
||||
procedure TTarget.ReleaseMouse(x,y: integer; button: TClickType);
|
||||
begin
|
||||
raise Exception.Create('ReleaseMouse not available for this target');
|
||||
end;
|
||||
function TTarget.IsMouseButtonHeld(button: TClickType): boolean;
|
||||
begin
|
||||
raise Exception.Create('IsMouseButtonHeld not available for this target');
|
||||
end;
|
||||
|
||||
procedure TTarget.SendString(str: string); begin raise Exception.Create('SendString not available for this target'); end;
|
||||
procedure TTarget.HoldKey(key: integer); begin raise Exception.Create('HoldKey not available for this target'); end;
|
||||
procedure TTarget.ReleaseKey(key: integer); begin raise Exception.Create('ReleaseKey not available for this target'); end;
|
||||
function TTarget.IsKeyHeld(key: integer): boolean; begin raise Exception.Create('IsKeyHeld not available for this target'); end;
|
||||
function TTarget.GetKeyCode(C: char): integer;begin Exception.CreateFMT('GetKeyCode - char (%s) to key is not available for this target.',[c]); end;
|
||||
procedure TTarget.SendString(str: string);
|
||||
begin
|
||||
raise Exception.Create('SendString not available for this target');
|
||||
end;
|
||||
|
||||
procedure TTarget.HoldKey(key: integer);
|
||||
begin
|
||||
raise Exception.Create('HoldKey not available for this target');
|
||||
end;
|
||||
|
||||
procedure TTarget.ReleaseKey(key: integer);
|
||||
begin
|
||||
raise Exception.Create('ReleaseKey not available for this target');
|
||||
end;
|
||||
|
||||
function TTarget.IsKeyHeld(key: integer): boolean;
|
||||
begin
|
||||
raise Exception.Create('IsKeyHeld not available for this target');
|
||||
end;
|
||||
|
||||
function TTarget.GetKeyCode(C: char): integer;
|
||||
begin
|
||||
Exception.CreateFMT('GetKeyCode - char (%s) to key is not available for this target.',[c]);
|
||||
end;
|
||||
|
||||
//***implementation*** TEIOS_Target
|
||||
|
||||
@ -750,6 +828,15 @@ begin
|
||||
else
|
||||
inherited GetTargetDimensions(w,h);
|
||||
end;
|
||||
|
||||
procedure TEIOS_Target.GetTargetPosition(var left, top: integer);
|
||||
begin
|
||||
if Pointer(client.GetTargetDimensions) <> nil then
|
||||
client.GetTargetDimensions(target,left,top)
|
||||
else
|
||||
inherited GetTargetDimensions(left,top);
|
||||
end;
|
||||
|
||||
function TEIOS_Target.ReturnData(xs, ys, width, height: Integer): TRetData;
|
||||
begin
|
||||
if Pointer(client.UpdateImageBufferBounds) <> nil then
|
||||
@ -891,6 +978,13 @@ begin
|
||||
h:= self.h;
|
||||
end;
|
||||
|
||||
procedure TRawTarget.GetTargetPosition(var left, top: integer);
|
||||
begin
|
||||
{ The RawTarget has no position on the screen }
|
||||
left := 0;
|
||||
top := 0;
|
||||
end;
|
||||
|
||||
function TRawTarget.ReturnData(xs, ys, width, height: Integer): TRetData;
|
||||
begin
|
||||
result.Ptr := rgb;
|
||||
@ -1009,6 +1103,12 @@ begin
|
||||
TTarget(Target).GetTargetDimensions(w,h);
|
||||
end;
|
||||
|
||||
procedure TTarget_Exported_GetTargetPosition(target: pointer; var left,
|
||||
top: integer); stdcall;
|
||||
begin
|
||||
TTarget(Target).GetTargetPosition(left,top);
|
||||
end;
|
||||
|
||||
function TTarget_Exported_GetColor(target: pointer;x, y: integer): integer; stdcall;
|
||||
begin
|
||||
result := TTarget(Target).GetColor(x,y);
|
||||
|
@ -46,6 +46,7 @@ interface
|
||||
constructor Create(display: PDisplay; screennum: integer; window: x.TWindow);
|
||||
destructor Destroy; override;
|
||||
procedure GetTargetDimensions(var w, h: integer); override;
|
||||
procedure GetTargetPosition(var left, top: integer); override;
|
||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||
procedure FreeReturnData; override;
|
||||
|
||||
@ -269,6 +270,25 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWindow.GetTargetPosition(var left, top: integer);
|
||||
var
|
||||
Attrib: TXWindowAttributes;
|
||||
newx, newy: integer;
|
||||
childwindow: x.TWindow;
|
||||
begin
|
||||
if XGetWindowAttributes(display, window, @Attrib) <> 0 Then
|
||||
begin
|
||||
left := Attrib.x;
|
||||
top := attrib.y;
|
||||
end else
|
||||
begin
|
||||
// XXX: this is tricky; what do we return when it doesn't exist?
|
||||
// The window can very well be at -1, -1. We'll return 0 for now.
|
||||
left := 0;
|
||||
top := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWindow.TargetValid: boolean;
|
||||
var
|
||||
Attrib: TXWindowAttributes;
|
||||
|
@ -47,6 +47,7 @@ interface
|
||||
constructor Create(target: Hwnd);
|
||||
destructor Destroy; override;
|
||||
procedure GetTargetDimensions(var w, h: integer); override;
|
||||
procedure GetTargetPosition(var left, top: integer); override;
|
||||
function ReturnData(xs, ys, width, height: Integer): TRetData; override;
|
||||
function GetColor(x,y : integer) : TColor; override;
|
||||
|
||||
@ -230,6 +231,15 @@ implementation
|
||||
w:= Rect.Right - Rect.Left;
|
||||
h:= Rect.Bottom - Rect.Top;
|
||||
end;
|
||||
|
||||
procedure TWindow.GetTargetPosition(var left, top: integer);
|
||||
var
|
||||
Rect : TRect;
|
||||
begin
|
||||
WindowRect(rect);
|
||||
left := Rect.Left;
|
||||
top := Rect.Top;
|
||||
end;
|
||||
|
||||
function TWindow.GetColor(x,y : integer) : TColor;
|
||||
begin
|
||||
|
Loading…
Reference in New Issue
Block a user