mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-11 11:55:02 -05:00
Added ScrollMouse, BiDiMode and added CopyClientToBitmap to the TMufasaBitmap
This commit is contained in:
parent
65f37d861e
commit
780190e2c7
@ -175,6 +175,11 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMufasaBitmapCopyClientToBitmap(self : TMufasaBitmap; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);
|
||||||
|
begin
|
||||||
|
self.CopyClientToBitmap(SimbaForm.Manager,resize,x,y,xs,ys,xe,ye);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||||
begin
|
begin
|
||||||
SIRegister_Std(x);
|
SIRegister_Std(x);
|
||||||
@ -199,6 +204,8 @@ begin
|
|||||||
RIRegister_ExtCtrls(x);
|
RIRegister_ExtCtrls(x);
|
||||||
RIRegister_Menus(x);
|
RIRegister_Menus(x);
|
||||||
RIRegister_MML(x);
|
RIRegister_MML(x);
|
||||||
|
with x.FindClass('TMufasaBitmap') do
|
||||||
|
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TSimbaPSExtension.Destroy;
|
destructor TSimbaPSExtension.Destroy;
|
||||||
|
@ -27,7 +27,12 @@ const
|
|||||||
ps_mouse_middle = 2;
|
ps_mouse_middle = 2;
|
||||||
procedure ps_MoveMouse(x, y: integer); extdecl;
|
procedure ps_MoveMouse(x, y: integer); extdecl;
|
||||||
begin
|
begin
|
||||||
CurrThread.Client.IOManager.SetMousePos(X, Y);
|
CurrThread.Client.IOManager.MoveMouse(X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ps_ScrollMouse(x,y : integer; Clicks : integer); extdecl;
|
||||||
|
begin
|
||||||
|
CurrThread.Client.IOManager.ScrollMouse(x,y,Clicks);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure ps_GetMousePos(var x, y: integer); extdecl;
|
procedure ps_GetMousePos(var x, y: integer); extdecl;
|
||||||
|
@ -44,7 +44,7 @@ x.AddTypeS('TPointArrayArray','Array of TPointArray');
|
|||||||
x.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
x.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
||||||
x.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
|
x.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
|
||||||
x.addtypeS('PPoint','record R,T : extended; end;');
|
x.addtypeS('PPoint','record R,T : extended; end;');
|
||||||
x.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15:integer; end;');
|
x.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15,int16:integer; end;');
|
||||||
|
|
||||||
x.AddTypes('TSDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
|
x.AddTypes('TSDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
|
||||||
x.AddTypes('TSDTMPointDefArray', 'Array Of TSDTMPointDef;');
|
x.AddTypes('TSDTMPointDefArray', 'Array Of TSDTMPointDef;');
|
||||||
|
@ -238,6 +238,7 @@ AddFunction(@ps_FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var
|
|||||||
{Mouse etc.}
|
{Mouse etc.}
|
||||||
SetCurrSection('Mouse');
|
SetCurrSection('Mouse');
|
||||||
AddFunction(@ps_MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
AddFunction(@ps_MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
||||||
|
AddFunction(@ps_ScrollMouse,'procedure Scrollmouse(x,y : integer; Clicks : integer);');
|
||||||
AddFunction(@ps_GetMousePos, 'procedure GetMousePos(var x, y: integer);');
|
AddFunction(@ps_GetMousePos, 'procedure GetMousePos(var x, y: integer);');
|
||||||
AddFunction(@ps_HoldMouse, 'procedure HoldMouse(x, y: integer; clickType: integer);');
|
AddFunction(@ps_HoldMouse, 'procedure HoldMouse(x, y: integer; clickType: integer);');
|
||||||
AddFunction(@ps_ReleaseMouse, 'procedure ReleaseMouse(x, y: integer; clickType: integer);');
|
AddFunction(@ps_ReleaseMouse, 'procedure ReleaseMouse(x, y: integer; clickType: integer);');
|
||||||
|
@ -6,12 +6,10 @@ uses
|
|||||||
procedure SIRegister_MML(cl: TPSPascalCompiler);
|
procedure SIRegister_MML(cl: TPSPascalCompiler);
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
procedure SIRegister_MML(cl: TPSPascalCompiler);
|
|
||||||
var
|
procedure SIRegister_TMufasaBitmap(cl : TPSPascalCompiler);
|
||||||
PSClass : TPSCompileTimeClass;
|
|
||||||
begin
|
begin
|
||||||
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap');
|
with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
|
||||||
with PSClass do
|
|
||||||
begin;
|
begin;
|
||||||
RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
|
RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
|
||||||
RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
|
RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
|
||||||
@ -20,6 +18,7 @@ begin
|
|||||||
RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
|
RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
|
||||||
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
|
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
|
||||||
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
|
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
|
||||||
|
RegisterMethod('procedure CopyClientToBitmap(Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);');
|
||||||
RegisterMethod('procedure Rectangle(const Box : TBox; FillCol : TColor);');
|
RegisterMethod('procedure Rectangle(const Box : TBox; FillCol : TColor);');
|
||||||
RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);');
|
RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);');
|
||||||
// function FastGetPixels(TPA : TPointArray) : TIntegerArray;
|
// function FastGetPixels(TPA : TPointArray) : TIntegerArray;
|
||||||
@ -49,13 +48,16 @@ begin
|
|||||||
RegisterProperty('Index','Integer',iptR);
|
RegisterProperty('Index','Integer',iptR);
|
||||||
RegisterProperty('Name','String',iptRW);
|
RegisterProperty('Name','String',iptRW);
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_TRegExp(cl : TPSPascalCompiler);
|
||||||
|
begin
|
||||||
with CL.AddClassN(CL.FindClass('Exception'),'ERegExpr') do
|
with CL.AddClassN(CL.FindClass('Exception'),'ERegExpr') do
|
||||||
begin
|
begin
|
||||||
RegisterProperty('ErrorCode', 'integer', iptrw);
|
RegisterProperty('ErrorCode', 'integer', iptrw);
|
||||||
RegisterProperty('CompilerErrorPos', 'integer', iptrw);
|
RegisterProperty('CompilerErrorPos', 'integer', iptrw);
|
||||||
end;
|
end;
|
||||||
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TRegExp');
|
with cl.AddClassN(cl.FindClass('TObject'),'TRegExp') do
|
||||||
with PSClass do
|
|
||||||
begin
|
begin
|
||||||
RegisterMethod('Constructor Create');
|
RegisterMethod('Constructor Create');
|
||||||
RegisterMethod('Function VersionMajor : integer');
|
RegisterMethod('Function VersionMajor : integer');
|
||||||
@ -91,8 +93,11 @@ begin
|
|||||||
RegisterMethod('Procedure Compile');
|
RegisterMethod('Procedure Compile');
|
||||||
RegisterMethod('Function Dump : String');
|
RegisterMethod('Function Dump : String');
|
||||||
end;
|
end;
|
||||||
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMDTM');
|
end;
|
||||||
with PSClass do
|
|
||||||
|
procedure SIRegister_TMDTM(cl : TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
with cl.AddClassN(cl.FindClass('TObject'),'TMDTM') do
|
||||||
begin
|
begin
|
||||||
RegisterMethod('constructor create;');
|
RegisterMethod('constructor create;');
|
||||||
RegisterMethod('procedure free;');
|
RegisterMethod('procedure free;');
|
||||||
@ -106,6 +111,10 @@ begin
|
|||||||
RegisterProperty('Count','Integer',iptrw);
|
RegisterProperty('Count','Integer',iptrw);
|
||||||
RegisterProperty('Points','TMDTMPointArray',iptr);
|
RegisterProperty('Points','TMDTMPointArray',iptr);
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_TMMLSettingsSandbox(CL : TPSPascalCompiler);
|
||||||
|
begin
|
||||||
with cl.AddClassN(nil,'TMMLSettingsSandbox') do
|
with cl.AddClassN(nil,'TMMLSettingsSandbox') do
|
||||||
begin;
|
begin;
|
||||||
RegisterMethod('function IsKey(const KeyName: String): Boolean;');
|
RegisterMethod('function IsKey(const KeyName: String): Boolean;');
|
||||||
@ -120,4 +129,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure SIRegister_MML(cl: TPSPascalCompiler);
|
||||||
|
begin
|
||||||
|
SIRegister_TMufasaBitmap(cl);
|
||||||
|
SIRegister_TRegExp(cl);
|
||||||
|
SIRegister_TMDTM(cL);
|
||||||
|
SIRegister_TMMLSettingsSandbox(cl);
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -63,12 +63,10 @@ procedure TMDTMCount_R(Self: TMDTM; var T: Integer);begin T := Self.Count; end;
|
|||||||
procedure TMDTMPoints_R(Self : TMDTM; var T : TMDTMPointArray); begin t := self.Points; end;
|
procedure TMDTMPoints_R(Self : TMDTM; var T : TMDTMPointArray); begin t := self.Points; end;
|
||||||
procedure SettingsPrefix(self : TMMLSettingsSandbox; var Prefix : String);begin; Prefix := self.Prefix; end;
|
procedure SettingsPrefix(self : TMMLSettingsSandbox; var Prefix : String);begin; Prefix := self.Prefix; end;
|
||||||
|
|
||||||
procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
|
|
||||||
var
|
procedure RIRegister_TMufasaBitmap(cl : TPSRuntimeClassImporter);
|
||||||
PSClass : TPSRuntimeClass;
|
begin
|
||||||
begin;
|
with cl.Add(TMufasaBitmap) do
|
||||||
PSClass :=cl.Add(TMufasaBitmap);
|
|
||||||
with PSClass do
|
|
||||||
begin
|
begin
|
||||||
RegisterMethod(@TMufasaBitmap.ToTBitmap,'ToTBitmap');
|
RegisterMethod(@TMufasaBitmap.ToTBitmap,'ToTBitmap');
|
||||||
RegisterMethod(@TMufasaBitmap.SetSize,'SETSIZE');
|
RegisterMethod(@TMufasaBitmap.SetSize,'SETSIZE');
|
||||||
@ -105,6 +103,10 @@ begin;
|
|||||||
RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
|
RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
|
||||||
RegisterMethod(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
|
RegisterMethod(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RIRegister_TRegExp(cl : TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
with CL.Add(ERegExpr) do
|
with CL.Add(ERegExpr) do
|
||||||
begin
|
begin
|
||||||
RegisterPropertyHelper(@ERegExprErrorCode_R,@ERegExprErrorCode_W,'ErrorCode');
|
RegisterPropertyHelper(@ERegExprErrorCode_R,@ERegExprErrorCode_W,'ErrorCode');
|
||||||
@ -146,6 +148,9 @@ begin;
|
|||||||
RegisterMethod(@TRegExp.Compile, 'Compile');
|
RegisterMethod(@TRegExp.Compile, 'Compile');
|
||||||
RegisterMethod(@TRegExp.Dump, 'Dump');
|
RegisterMethod(@TRegExp.Dump, 'Dump');
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
|
procedure RIRegister_TMDTM(cl : TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
with CL.Add(TMDTM) do
|
with CL.Add(TMDTM) do
|
||||||
begin
|
begin
|
||||||
RegisterConstructor(@TMDTM.Create,'Create');
|
RegisterConstructor(@TMDTM.Create,'Create');
|
||||||
@ -159,6 +164,9 @@ begin;
|
|||||||
RegisterPropertyHelper(@TMDTMCount_R,@TMDTMCount_W,'Count');
|
RegisterPropertyHelper(@TMDTMCount_R,@TMDTMCount_W,'Count');
|
||||||
RegisterPropertyHelper(@TMDTMPoints_R,nil,'Points');
|
RegisterPropertyHelper(@TMDTMPoints_R,nil,'Points');
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
|
procedure RIRegister_TMMLSettingsSandbox(cl : TPSRuntimeClassImporter);
|
||||||
|
begin
|
||||||
with cl.Add(TMMLSettingsSandbox) do
|
with cl.Add(TMMLSettingsSandbox) do
|
||||||
begin
|
begin
|
||||||
RegisterMethod(@TMMLSettingsSandbox.IsKey,'ISKEY');
|
RegisterMethod(@TMMLSettingsSandbox.IsKey,'ISKEY');
|
||||||
@ -173,4 +181,12 @@ begin;
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
|
||||||
|
begin;
|
||||||
|
RIRegister_TMufasaBitmap(cl);
|
||||||
|
RIRegister_TRegExp(cl);
|
||||||
|
RIRegister_TMDTM(cl);
|
||||||
|
RIRegister_TMMLSettingsSandbox(cl);
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -204,14 +204,14 @@ uses
|
|||||||
colour_conv,dtmutil,
|
colour_conv,dtmutil,
|
||||||
{$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds
|
{$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds
|
||||||
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus,
|
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus,
|
||||||
uPSC_extctrls, //Compile-libs
|
uPSC_extctrls, uPSC_mml, //Compile-libs
|
||||||
uPSUtils,
|
uPSUtils,
|
||||||
fontloader,
|
fontloader,
|
||||||
IOmanager,//TTarget_Exported
|
IOmanager,//TTarget_Exported
|
||||||
IniFiles,//Silly INI files
|
IniFiles,//Silly INI files
|
||||||
stringutil, //String st00f
|
stringutil, //String st00f
|
||||||
|
|
||||||
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
|
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml,
|
||||||
uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs,
|
uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs,
|
||||||
files,
|
files,
|
||||||
dialogs,
|
dialogs,
|
||||||
@ -666,8 +666,6 @@ begin
|
|||||||
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
|
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$I PSInc/pscmml.inc}
|
|
||||||
|
|
||||||
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
|
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
|
||||||
begin
|
begin
|
||||||
SIRegister_MML(cl);
|
SIRegister_MML(cl);
|
||||||
@ -714,7 +712,6 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$I PSInc/psrmml.inc}
|
|
||||||
function TMufasaBitmapCreate : TMufasaBitmap;
|
function TMufasaBitmapCreate : TMufasaBitmap;
|
||||||
begin;
|
begin;
|
||||||
result := TMufasaBitmap.Create;
|
result := TMufasaBitmap.Create;
|
||||||
@ -726,6 +723,10 @@ begin
|
|||||||
result := Self.Copy(xs,ys,xe,ye);
|
result := Self.Copy(xs,ys,xe,ye);
|
||||||
CurrThread.Client.MBitmaps.AddBMP(result);
|
CurrThread.Client.MBitmaps.AddBMP(result);
|
||||||
end;
|
end;
|
||||||
|
procedure TMufasaBitmapCopyClientToBitmap(self : TMufasaBitmap; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);
|
||||||
|
begin
|
||||||
|
self.CopyClientToBitmap(CurrThread.Client.IOManager,resize,x,y,xs,ys,xe,ye);
|
||||||
|
end;
|
||||||
function TMDTMCreate : TMDTM;
|
function TMDTMCreate : TMDTM;
|
||||||
begin
|
begin
|
||||||
result := TMDTM.Create;
|
result := TMDTM.Create;
|
||||||
@ -745,6 +746,7 @@ begin
|
|||||||
RegisterConstructor(@TMufasaBitmapCreate,'Create');
|
RegisterConstructor(@TMufasaBitmapCreate,'Create');
|
||||||
RegisterMethod(@TMufasaBitmapFree,'Free');
|
RegisterMethod(@TMufasaBitmapFree,'Free');
|
||||||
RegisterMethod(@TMufasaBitmapCopy,'Copy');
|
RegisterMethod(@TMufasaBitmapCopy,'Copy');
|
||||||
|
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap');
|
||||||
end;
|
end;
|
||||||
With cl.FindClass('TMDTM') do
|
With cl.FindClass('TMDTM') do
|
||||||
begin
|
begin
|
||||||
|
@ -966,12 +966,11 @@ var
|
|||||||
begin
|
begin
|
||||||
if Resize then
|
if Resize then
|
||||||
Self.SetSize(xe-xs+1 + x,ye-ys+1 + y);
|
Self.SetSize(xe-xs+1 + x,ye-ys+1 + y);
|
||||||
|
ValidatePoint(x,y);
|
||||||
wi := Min(xe-xs + 1 + x,Self.w);
|
wi := Min(xe-xs + 1 + x,Self.w)-x;
|
||||||
hi := Min(ye-ys + 1 + y,Self.h);
|
hi := Min(ye-ys + 1 + y,Self.h)-y;
|
||||||
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi - x,hi - y);
|
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi,hi);
|
||||||
|
for yy := 0 to (hi-1) do
|
||||||
for yy := 0 to (hi-1 - y) do
|
|
||||||
Move(PtrRet.Ptr[yy * (PtrRet.RowLen)], FData[(yy + y) * self.w + x],wi * SizeOf(TRGB32));
|
Move(PtrRet.Ptr[yy * (PtrRet.RowLen)], FData[(yy + y) * self.w + x],wi * SizeOf(TRGB32));
|
||||||
TIOManager_Abstract(MWindow).FreeReturnData;
|
TIOManager_Abstract(MWindow).FreeReturnData;
|
||||||
end;
|
end;
|
||||||
|
@ -58,6 +58,7 @@ interface
|
|||||||
| raise exceptions }
|
| raise exceptions }
|
||||||
procedure GetMousePosition(var x,y: integer); virtual;
|
procedure GetMousePosition(var x,y: integer); virtual;
|
||||||
procedure MoveMouse(x,y: integer); virtual;
|
procedure MoveMouse(x,y: integer); virtual;
|
||||||
|
procedure ScrollMouse(x,y : integer; Lines : integer); virtual;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); virtual;
|
procedure HoldMouse(x,y: integer; button: TClickType); virtual;
|
||||||
procedure ReleaseMouse(x,y: integer; button: TClickType); virtual;
|
procedure ReleaseMouse(x,y: integer; button: TClickType); virtual;
|
||||||
function IsMouseButtonHeld( button : TClickType) : boolean ; virtual;
|
function IsMouseButtonHeld( button : TClickType) : boolean ; virtual;
|
||||||
@ -114,6 +115,7 @@ interface
|
|||||||
procedure ActivateClient; override; abstract;
|
procedure ActivateClient; override; abstract;
|
||||||
procedure GetMousePosition(var x,y: integer); override; abstract;
|
procedure GetMousePosition(var x,y: integer); override; abstract;
|
||||||
procedure MoveMouse(x,y: integer); override; abstract;
|
procedure MoveMouse(x,y: integer); override; abstract;
|
||||||
|
procedure ScrollMouse(x,y : integer; Lines : integer); override; abstract;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
|
procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
|
||||||
procedure ReleaseMouse(x,y: integer; button: TClickType); override; abstract;
|
procedure ReleaseMouse(x,y: integer; button: TClickType); override; abstract;
|
||||||
function IsMouseButtonHeld( button : TClickType) : boolean;override; abstract;
|
function IsMouseButtonHeld( button : TClickType) : boolean;override; abstract;
|
||||||
@ -140,6 +142,7 @@ interface
|
|||||||
|
|
||||||
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
|
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
|
||||||
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
|
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
|
||||||
|
ScrollMouse: procedure(target : pointer; x,y : integer; lines : integer); stdcall;
|
||||||
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
||||||
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
||||||
IsMouseButtonHeld : function (target : pointer; left : Boolean) : boolean; stdcall;
|
IsMouseButtonHeld : function (target : pointer; left : Boolean) : boolean; stdcall;
|
||||||
@ -170,6 +173,7 @@ interface
|
|||||||
|
|
||||||
procedure GetMousePosition(var x,y: integer); override;
|
procedure GetMousePosition(var x,y: integer); override;
|
||||||
procedure MoveMouse(x,y: integer); override;
|
procedure MoveMouse(x,y: integer); override;
|
||||||
|
procedure ScrollMouse(x,y : integer; Lines : integer); override;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
||||||
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
|
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
|
||||||
function IsMouseButtonHeld( button : TClickType) : boolean;override;
|
function IsMouseButtonHeld( button : TClickType) : boolean;override;
|
||||||
@ -229,6 +233,7 @@ interface
|
|||||||
|
|
||||||
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
|
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
|
||||||
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
|
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
|
||||||
|
ScrollMouse: procedure(target: pointer; x,y : integer; Lines : integer); stdcall;
|
||||||
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
||||||
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
|
||||||
IsMouseButtonHeld : function (target : pointer; left : boolean) : boolean;stdcall;
|
IsMouseButtonHeld : function (target : pointer; left : boolean) : boolean;stdcall;
|
||||||
@ -279,7 +284,8 @@ interface
|
|||||||
procedure SetFrozen(makefrozen: boolean);
|
procedure SetFrozen(makefrozen: boolean);
|
||||||
|
|
||||||
procedure GetMousePos(var X, Y: Integer);
|
procedure GetMousePos(var X, Y: Integer);
|
||||||
procedure SetMousePos(X, Y: Integer);
|
procedure MoveMouse(X, Y: Integer);
|
||||||
|
procedure ScrollMouse(x,y : integer; Lines : integer);
|
||||||
procedure HoldMouse(x,y : integer; button: TClickType);
|
procedure HoldMouse(x,y : integer; button: TClickType);
|
||||||
procedure ReleaseMouse(x,y : integer; button: TClickType);
|
procedure ReleaseMouse(x,y : integer; button: TClickType);
|
||||||
procedure ClickMouse(X, Y: Integer; button: TClickType);
|
procedure ClickMouse(X, Y: Integer; button: TClickType);
|
||||||
@ -334,6 +340,7 @@ interface
|
|||||||
|
|
||||||
procedure TTarget_Exported_GetMousePosition(target: pointer; var x,y: integer); stdcall;
|
procedure TTarget_Exported_GetMousePosition(target: pointer; var x,y: integer); stdcall;
|
||||||
procedure TTarget_Exported_MoveMouse(target: pointer; x,y: integer); stdcall;
|
procedure TTarget_Exported_MoveMouse(target: pointer; x,y: integer); stdcall;
|
||||||
|
procedure TTarget_Exported_ScrollMouse(target: pointer; x,y : integer; Lines : integer); stdcall;
|
||||||
procedure TTarget_Exported_HoldMouse(target: pointer; x,y: integer; left: boolean); stdcall;
|
procedure TTarget_Exported_HoldMouse(target: pointer; x,y: integer; left: boolean); stdcall;
|
||||||
procedure TTarget_Exported_ReleaseMouse(target: pointer; x,y: integer; left: boolean); stdcall;
|
procedure TTarget_Exported_ReleaseMouse(target: pointer; x,y: integer; left: boolean); stdcall;
|
||||||
function TTarget_Exported_IsMouseButtonHeld(target: pointer; left : boolean) : boolean;stdcall;
|
function TTarget_Exported_IsMouseButtonHeld(target: pointer; left : boolean) : boolean;stdcall;
|
||||||
@ -473,6 +480,7 @@ begin
|
|||||||
Target:= KeyMouse;
|
Target:= KeyMouse;
|
||||||
GetMousePosition := @TTarget_Exported_GetMousePosition;
|
GetMousePosition := @TTarget_Exported_GetMousePosition;
|
||||||
MoveMouse := @TTarget_Exported_MoveMouse;
|
MoveMouse := @TTarget_Exported_MoveMouse;
|
||||||
|
ScrollMouse:= @TTarget_Exported_ScrollMouse;
|
||||||
HoldMouse := @TTarget_Exported_HoldMouse;
|
HoldMouse := @TTarget_Exported_HoldMouse;
|
||||||
ReleaseMouse := @TTarget_Exported_ReleaseMouse;
|
ReleaseMouse := @TTarget_Exported_ReleaseMouse;
|
||||||
|
|
||||||
@ -602,10 +610,17 @@ procedure TIOManager_Abstract.GetMousePos(var X, Y: Integer);
|
|||||||
begin
|
begin
|
||||||
keymouse.GetMousePosition(x,y)
|
keymouse.GetMousePosition(x,y)
|
||||||
end;
|
end;
|
||||||
procedure TIOManager_Abstract.SetMousePos(X, Y: Integer);
|
|
||||||
|
procedure TIOManager_Abstract.MoveMouse(X, Y: Integer);
|
||||||
begin
|
begin
|
||||||
keymouse.MoveMouse(x,y);
|
keymouse.MoveMouse(x,y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TIOManager_Abstract.ScrollMouse(x, y: integer; Lines: integer);
|
||||||
|
begin
|
||||||
|
keymouse.ScrollMouse(x,y,lines);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TIOManager_Abstract.HoldMouse(x,y : integer; button: TClickType);
|
procedure TIOManager_Abstract.HoldMouse(x,y : integer; button: TClickType);
|
||||||
begin
|
begin
|
||||||
keymouse.HoldMouse(x,y,button);
|
keymouse.HoldMouse(x,y,button);
|
||||||
@ -698,6 +713,7 @@ 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.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.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.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;
|
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;
|
function TTarget.IsMouseButtonHeld(button: TClickType): boolean; begin raise Exception.Create('IsMouseButtonHeld not available for this target'); end;
|
||||||
@ -763,6 +779,14 @@ begin
|
|||||||
else
|
else
|
||||||
inherited MoveMouse(x,y);
|
inherited MoveMouse(x,y);
|
||||||
end;
|
end;
|
||||||
|
procedure TEIOS_Target.ScrollMouse(x,y : integer; Lines : integer);
|
||||||
|
begin
|
||||||
|
if Pointer(Client.ScrollMouse) <> nil then
|
||||||
|
client.ScrollMouse(target,x,y,lines)
|
||||||
|
else
|
||||||
|
inherited Scrollmouse(x,y,lines);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TEIOS_Target.HoldMouse(x,y: integer; button: TClickType);
|
procedure TEIOS_Target.HoldMouse(x,y: integer; button: TClickType);
|
||||||
begin
|
begin
|
||||||
if Pointer(client.HoldMouse) <> nil then
|
if Pointer(client.HoldMouse) <> nil then
|
||||||
@ -942,6 +966,7 @@ begin
|
|||||||
|
|
||||||
Pointer(GetMousePosition):= GetProcAddress(plugin, PChar('EIOS_GetMousePosition'));
|
Pointer(GetMousePosition):= GetProcAddress(plugin, PChar('EIOS_GetMousePosition'));
|
||||||
Pointer(MoveMouse):= GetProcAddress(plugin, PChar('EIOS_MoveMouse'));
|
Pointer(MoveMouse):= GetProcAddress(plugin, PChar('EIOS_MoveMouse'));
|
||||||
|
Pointer(ScrollMouse) := GetProcAddress(plugin,PChar('EIOS_ScrollMouse'));
|
||||||
Pointer(HoldMouse):= GetProcAddress(plugin, PChar('EIOS_HoldMouse'));
|
Pointer(HoldMouse):= GetProcAddress(plugin, PChar('EIOS_HoldMouse'));
|
||||||
Pointer(ReleaseMouse):= GetProcAddress(plugin, PChar('EIOS_ReleaseMouse'));
|
Pointer(ReleaseMouse):= GetProcAddress(plugin, PChar('EIOS_ReleaseMouse'));
|
||||||
|
|
||||||
@ -1011,6 +1036,11 @@ procedure TTarget_Exported_MoveMouse(target: pointer; x, y: integer); stdcall;
|
|||||||
begin
|
begin
|
||||||
TTarget(Target).MoveMouse(x,y);
|
TTarget(Target).MoveMouse(x,y);
|
||||||
end;
|
end;
|
||||||
|
procedure TTarget_Exported_ScrollMouse(target: pointer; x, y: integer;
|
||||||
|
Lines: integer); stdcall;
|
||||||
|
begin
|
||||||
|
TTarget(Target).ScrollMouse(x,y,lines);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTarget_Exported_HoldMouse(target: pointer; x, y: integer;
|
procedure TTarget_Exported_HoldMouse(target: pointer; x, y: integer;
|
||||||
left: boolean); stdcall;
|
left: boolean); stdcall;
|
||||||
|
@ -58,6 +58,7 @@ interface
|
|||||||
procedure ActivateClient; override;
|
procedure ActivateClient; override;
|
||||||
procedure GetMousePosition(var x,y: integer); override;
|
procedure GetMousePosition(var x,y: integer); override;
|
||||||
procedure MoveMouse(x,y: integer); override;
|
procedure MoveMouse(x,y: integer); override;
|
||||||
|
procedure ScrollMouse(x,y, lines : integer); override;
|
||||||
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
procedure HoldMouse(x,y: integer; button: TClickType); override;
|
||||||
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
|
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
|
||||||
function IsMouseButtonHeld( button : TClickType) : boolean;override;
|
function IsMouseButtonHeld( button : TClickType) : boolean;override;
|
||||||
@ -290,6 +291,24 @@ implementation
|
|||||||
y := y + rect.top;
|
y := y + rect.top;
|
||||||
Windows.SetCursorPos(x, y);
|
Windows.SetCursorPos(x, y);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
MOUSEEVENTF_WHEEL = $800;
|
||||||
|
procedure TWindow.ScrollMouse(x, y, lines: integer);
|
||||||
|
var
|
||||||
|
Input : TInput;
|
||||||
|
Rect : TRect;
|
||||||
|
begin
|
||||||
|
WindowRect(rect);
|
||||||
|
Input.Itype:= INPUT_MOUSE;
|
||||||
|
FillChar(Input,Sizeof(Input),0);
|
||||||
|
Input.mi.dx:= x + Rect.left;
|
||||||
|
Input.mi.dy:= y + Rect.Top;
|
||||||
|
Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_WHEEL;
|
||||||
|
Input.mi.mouseData:= lines * WHEEL_DELTA;
|
||||||
|
SendInput(1,Input, sizeof(Input));
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
|
procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
|
||||||
var
|
var
|
||||||
Input : TInput;
|
Input : TInput;
|
||||||
|
@ -53,6 +53,7 @@ begin
|
|||||||
RegisterProperty('Visible', 'Boolean', iptRW);
|
RegisterProperty('Visible', 'Boolean', iptRW);
|
||||||
RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
|
RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
|
||||||
RegisterProperty('CURSOR', 'TCURSOR', iptrw);
|
RegisterProperty('CURSOR', 'TCURSOR', iptrw);
|
||||||
|
RegisterProperty('BiDiMode','TBiDiMode',iptrw);
|
||||||
|
|
||||||
{$IFNDEF PS_MINIVCL}
|
{$IFNDEF PS_MINIVCL}
|
||||||
RegisterMethod('function Dragging: Boolean;');
|
RegisterMethod('function Dragging: Boolean;');
|
||||||
@ -133,6 +134,7 @@ begin
|
|||||||
Cl.addTypeS('TEShiftState','(ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble,' +
|
Cl.addTypeS('TEShiftState','(ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble,' +
|
||||||
'ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum,ssScroll,ssTriple,ssQuad)');
|
'ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum,ssScroll,ssTriple,ssQuad)');
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
cl.AddTypeS('TBiDiMode','(bdLeftToRight,bdRightToLeft,bdRightToLeftNoAlign,bdRightToLeftReadingOnly)');
|
||||||
Cl.addTypeS('TShiftState','set of TEShiftState');
|
Cl.addTypeS('TShiftState','set of TEShiftState');
|
||||||
cl.AddTypeS('TMouseButton', '(mbLeft, mbRight, mbMiddle)');
|
cl.AddTypeS('TMouseButton', '(mbLeft, mbRight, mbMiddle)');
|
||||||
cl.AddTypeS('TDragMode', '(dmManual, dmAutomatic)');
|
cl.AddTypeS('TDragMode', '(dmManual, dmAutomatic)');
|
||||||
|
@ -51,6 +51,8 @@ procedure TCONTROLENABLED_W(Self: TCONTROL; T: BOOLEAN); begin Self.ENABLED := T
|
|||||||
procedure TCONTROLENABLED_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.ENABLED; end;
|
procedure TCONTROLENABLED_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.ENABLED; end;
|
||||||
procedure TControlCaption_W(Self: TCONTROL; T: String); begin Self.Caption := T; end;
|
procedure TControlCaption_W(Self: TCONTROL; T: String); begin Self.Caption := T; end;
|
||||||
procedure TControlCaption_R(Self: TCONTROL; var T: String); begin T := Self.Caption; end;
|
procedure TControlCaption_R(Self: TCONTROL; var T: String); begin T := Self.Caption; end;
|
||||||
|
procedure TControlBiDiMode_W(Self: TCONTROL; T: TBiDiMode); begin Self.BiDiMode := T; end;
|
||||||
|
procedure TControlBiDiMode_R(Self: TCONTROL; var T: TBiDiMode); begin T := Self.BiDiMode; end;
|
||||||
procedure TControlBeginDrag(Self : TControl;Immediate : boolean); begin self.BeginDrag(Immediate); end;
|
procedure TControlBeginDrag(Self : TControl;Immediate : boolean); begin self.BeginDrag(Immediate); end;
|
||||||
|
|
||||||
procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter);
|
procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter);
|
||||||
@ -75,6 +77,7 @@ begin
|
|||||||
RegisterPropertyHelper(@TControlVisibleR, @TControlVisibleW, 'VISIBLE');
|
RegisterPropertyHelper(@TControlVisibleR, @TControlVisibleW, 'VISIBLE');
|
||||||
RegisterPropertyHelper(@TCONTROLENABLED_R, @TCONTROLENABLED_W, 'ENABLED');
|
RegisterPropertyHelper(@TCONTROLENABLED_R, @TCONTROLENABLED_W, 'ENABLED');
|
||||||
RegisterPropertyHelper(@TControlCaption_R,@TControlCaption_W,'CAPTION');
|
RegisterPropertyHelper(@TControlCaption_R,@TControlCaption_W,'CAPTION');
|
||||||
|
RegisterPropertyHelper(@TControlBiDiMode_R,@TControlBiDiMode_W,'BiDiMode');
|
||||||
RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
|
RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
|
||||||
|
|
||||||
{$IFNDEF PS_MINIVCL}
|
{$IFNDEF PS_MINIVCL}
|
||||||
|
Loading…
Reference in New Issue
Block a user