1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-01 13:22:16 -05:00

Added GetKeyCode to the manager.. Not sure if it needs a default implementation?

Added some functions needed for compiling SRL.

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@483 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2010-01-26 19:38:27 +00:00
parent 478ce1c71f
commit 7bece8ede2
13 changed files with 164 additions and 48 deletions

View File

@ -1730,7 +1730,7 @@ begin
Exit; Exit;
with TOpenDialog.Create(nil) do with TOpenDialog.Create(nil) do
try try
Filter:= 'Mufasa Files|*.cogat;*.mufa;*.txt|Any files|*.*'; Filter:= 'Simba Files|*.simb;*.cogat;*.mufa;*.txt|Any files|*.*';
if Execute then if Execute then
result := LoadScriptFile(filename); result := LoadScriptFile(filename);
finally finally
@ -1783,12 +1783,12 @@ begin
Result := false; Result := false;
with TSaveDialog.Create(nil) do with TSaveDialog.Create(nil) do
try try
Filter:= 'Mufasa files|*.cogat;*.mufa;*.pas;*.txt|Any Files|*.*'; Filter:= 'Simba files|*.simb;*.cogat;*.mufa;*.pas;*.txt|Any Files|*.*';
if Execute then if Execute then
begin; begin;
if ExtractFileExt(FileName) = '' then if ExtractFileExt(FileName) = '' then
begin; begin;
ScriptFile := FileName + '.mufa'; ScriptFile := FileName + '.simb';
end else end else
ScriptFile := FileName; ScriptFile := FileName;
SynEdit.Lines.SaveToFile(ScriptFile); SynEdit.Lines.SaveToFile(ScriptFile);

View File

@ -26,6 +26,11 @@ begin;
Result := CurrThread.Client.IOManager.GetColor(x,y); Result := CurrThread.Client.IOManager.GetColor(x,y);
end; end;
procedure GetColorsWrap(Coords : TPointArray; var Colors: TIntegerArray); ps_decl;
begin
Colors := CurrThread.Client.MFinder.GetColors(coords);
end;
function GetColors(Coords : TPointArray) : TIntegerArray; ps_decl; function GetColors(Coords : TPointArray) : TIntegerArray; ps_decl;
begin begin
result := CurrThread.Client.MFinder.GetColors(coords); result := CurrThread.Client.MFinder.GetColors(coords);

View File

@ -68,3 +68,11 @@ function ps_FilePointerPos(FileNum: Integer): Integer; ps_decl;
begin begin
Result := CurrThread.Client.MFiles.FilePointerPos(FileNum); Result := CurrThread.Client.MFiles.FilePointerPos(FileNum);
end; end;
function ps_FileExists ( const FileName : string ) : Boolean;
begin
result := FileExists(FileName);
end;
function ps_DirectoryExists ( const DirectoryName : string ) : Boolean; ps_decl;
begin
result := DirectoryExists(DirectoryName);
end;

View File

@ -45,3 +45,8 @@ function isKeyDown(key: Word): boolean; ps_decl;
begin begin
Result := CurrThread.Client.IOManager.isKeyDown(key); Result := CurrThread.Client.IOManager.isKeyDown(key);
end; end;
function GetKeyCode(c :char) : integer; ps_decl;
begin
result := CurrThread.Client.IOManager.GetKeyCode(c);
end;

View File

@ -21,6 +21,11 @@
Math.inc for the Mufasa Macro Library Math.inc for the Mufasa Macro Library
} }
function ps_iAbs(a : integer) : integer;ps_decl;
begin
result := abs(a);
end;
function ps_ceil(e : extended) : integer;ps_decl; function ps_ceil(e : extended) : integer;ps_decl;
begin begin
result := ceil(e); result := ceil(e);
@ -75,6 +80,11 @@ begin
Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom); Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom);
end; end;
function ps_ArcTan2(x,y : extended) : extended;
begin
result := ArcTan2(x,y);
end;
function Factorial(number: longword): Int64; ps_decl; function Factorial(number: longword): Int64; ps_decl;
var var
Loop : longword; Loop : longword;
@ -97,3 +107,30 @@ begin;
while Result > 360 do while Result > 360 do
Result := Result - 360; Result := Result - 360;
end; end;
function IntToBox(x1,y1,x2,y2 : integer) : TBox; ps_decl;
begin;
result.x1 := x1;
result.y1 := y1;
result.x2 := x2;
result.y2 := y2;
end;
function IntInBox(x, y: Integer; Box: TBox): Boolean; ps_decl;
begin;
result := (((x >= Box.x1) and(x <= Box.x2)) and ((y >= box.y1) and (y <= box.y2)));
end;
function PointToBox(PT1,PT2 : TPoint) : TBox; ps_decl;
begin;
result.x1 := PT1.x;
result.y1 := PT1.y;
result.x2 := PT2.x;
result.y2 := PT2.y;
end;
function PointInBox(PT : TPoint; Box: TBox): Boolean; ps_decl;
begin;
result := (((PT.x >= Box.x1) and(PT.x <= Box.x2)) and ((PT.y>= box.y1) and (PT.y <= box.y2)));
end;

View File

@ -17,9 +17,7 @@ begin
Result := CurrThread.Client.MOCR.TextToMask(text,font); Result := CurrThread.Client.MOCR.TextToMask(text,font);
end; end;
function TPAFromText(text, font: String): TPointArray; ps_decl; function TPAFromText(text, font: String;out w,h : integer): TPointArray; ps_decl;
var
w,h : integer;
begin begin
Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h); Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
end; end;

View File

@ -60,18 +60,7 @@ begin;
bmp.Free; bmp.Free;
end; end;
function IntToBox(x1,y1,x2,y2 : integer) : TBox; ps_decl;
begin;
result.x1 := x1;
result.y1 := y1;
result.x2 := x2;
result.y2 := y2;
end;
function IntInBox(x, y: Integer; Box: TBox): Boolean; ps_decl;
begin;
result := (((x >= Box.x1) and(x <= Box.x2)) and ((y >= box.y1) and (y <= box.y2)));
end;
procedure DisplayDebugImgWindow(w,h : integer); ps_decl; procedure DisplayDebugImgWindow(w,h : integer); ps_decl;
begin; begin;
@ -112,7 +101,22 @@ begin;
x := x mod (1000 * 60); x := x mod (1000 * 60);
s := x div (1000); s := x div (1000);
end; end;
procedure ps_DecodeDate ( const SourceDate : TDateTime; out Year, Month, Day : Word ); ps_decl;
begin
decodedate(sourcedate,year,month,day);
end;
procedure ps_DecodeTime(DateTime : TDateTime; var Hour,Min,Sec,MSec : word); ps_decl;
begin
decodetime(datetime,hour,min,sec,msec);
end;
function ps_Now : TDateTime; ps_decl;
begin
result := now;
end;
function ps_Date : TDateTime; ps_decl;
begin
result := date;
end;
procedure HakunaMatata; ps_decl; procedure HakunaMatata; ps_decl;
begin; begin;
OpenWebPage('http://www.youtube.com/v/ejEVczA8PLU&hl=en&fs=1&autoplay=1'); OpenWebPage('http://www.youtube.com/v/ejEVczA8PLU&hl=en&fs=1&autoplay=1');

View File

@ -1 +1 @@
function psFormat(const fmt : string;const args : array of const) : string; ps_decl; begin; Result := Format(fmt,Args); end; function Capitalize(str : string) : string; ps_decl; var i , l : integer; cap : boolean; begin; result := str; l := length(str); cap := true; for i := 1 to l do if cap and (str[i] in ['a'..'z'] + ['A'..'Z']) then begin; result[i] := UpperCase(str[i])[1]; cap := false; end else if not (str[i] in ['a'..'z'] + ['A'..'Z']) then cap := true; end; function psBoolToStr(bool : boolean) : string; ps_decl; begin; result := BoolToStr(bool,true); end; function psFormat(const fmt : string;const args : array of const) : string; ps_decl; ps_decl; begin; Result := Format(fmt,Args); end; function Capitalize(str : string) : string; ps_decl; var i , l : integer; cap : boolean; begin; result := str; l := length(str); cap := true; for i := 1 to l do if cap and (str[i] in ['a'..'z'] + ['A'..'Z']) then begin; result[i] := UpperCase(str[i])[1]; cap := false; end else if not (str[i] in ['a'..'z'] + ['A'..'Z']) then cap := true; end; function psBoolToStr(bool : boolean) : string; ps_decl; begin; result := BoolToStr(bool,true); end; function ps_Between(s1, s2, str: string): string; ps_decl; var I,J : integer; begin; Result := ''; I := pos(s1,str); if I > 0 then begin; i := i + length(s1); j := posex(s2,str,i); if j > 0 then Result := copy(str,i,j-i); end; end;

View File

@ -26,13 +26,14 @@ Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath)
Sender.Comp.AddConstantN('IncludePath','string').SetString(CurrThread.IncludePath); Sender.Comp.AddConstantN('IncludePath','string').SetString(CurrThread.IncludePath);
Sender.Comp.AddConstantN('PluginPath','string').SetString(CurrThread.PluginPath); Sender.Comp.AddConstantN('PluginPath','string').SetString(CurrThread.PluginPath);
Sender.Comp.AddConstantN('FontPath','string').SetString(CurrThread.FontPath); Sender.Comp.AddConstantN('FontPath','string').SetString(CurrThread.FontPath);
Sender.Comp.AddTypeS('TDateTime','Double');
Sender.Comp.AddTypeS('TIntegerArray', 'Array of LongInt'); Sender.Comp.AddTypeS('TIntegerArray', 'Array of LongInt');
Sender.Comp.AddTypeS('TExtendedArray','Array of extended'); Sender.Comp.AddTypeS('TExtendedArray','Array of extended');
Sender.Comp.AddTypeS('TBoolArray', 'Array of Boolean'); Sender.Comp.AddTypeS('TBoolArray', 'Array of Boolean');
Sender.Comp.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;'); Sender.Comp.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;');
Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.Comp.AddTypeS('T2DPointArray','Array of Array of TPoint'); Sender.Comp.AddTypeS('T2DPointArray','Array of TPointArray');
Sender.Comp.AddTypeS('TPointArrayArray','Array of Array of TPoint'); Sender.Comp.AddTypeS('TPointArrayArray','Array of TPointArray');
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)'); Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;'); Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
Sender.Comp.addtypeS('PPoint','record R,T : extended; end;'); Sender.Comp.addtypeS('PPoint','record R,T : extended; end;');
@ -43,6 +44,8 @@ Sender.Comp.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPoin
Sender.Comp.AddTypeS('pDTM','record l: Integer;p: TPointArray;c, t, asz, ash: TIntegerArray; bp: Array Of Boolean; n: String; end;'); Sender.Comp.AddTypeS('pDTM','record l: Integer;p: TPointArray;c, t, asz, ash: TIntegerArray; bp: Array Of Boolean; n: String; end;');
Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended;'); Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended;');
Sender.Comp.AddTypeS('T3DExtendedArray','array of array of array of extended;');
Sender.Comp.AddTypeS('T2DIntegerArray','array of array of integer;');
Sender.Comp.AddTypeS('TStringArray','Array of string;'); Sender.Comp.AddTypeS('TStringArray','Array of string;');
Sender.Comp.AddTypeS('TMousePress', '(mouse_Down, mouse_Up);'); Sender.Comp.AddTypeS('TMousePress', '(mouse_Down, mouse_Up);');
Sender.Comp.AddTypeS('Pointer', 'Integer'); Sender.Comp.AddTypeS('Pointer', 'Integer');

View File

@ -48,8 +48,13 @@ AddFunction(@ps_pow,'function pow(base,exponent : extended) : extended');
AddFunction(@ps_max,'function Max(a, b: Integer): Integer;'); AddFunction(@ps_max,'function Max(a, b: Integer): Integer;');
AddFunction(@ps_min,'function Min(a, b: Integer): Integer;'); AddFunction(@ps_min,'function Min(a, b: Integer): Integer;');
AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;'); AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;');
AddFunction(@ps_maxE,'function MaxE(a, b: extended): Extended;');
AddFunction(@ps_iAbs,'function iAbs(a : integer) : integer;');
AddFunction(@ps_ArcTan2,'function ArcTan2(x,y : extended) : extended;');
AddFunction(@IntToBox,'function IntToBox(x1,y1,x2,y2 : integer) : TBox;'); AddFunction(@IntToBox,'function IntToBox(x1,y1,x2,y2 : integer) : TBox;');
AddFunction(@IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;'); AddFunction(@IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;');
AddFunction(@PointToBox,'function PointToBox(PT1,PT2 : TPoint; Box: TBox): Boolean;');
AddFunction(@PointInBox,'function PointInBox(PT : TPoint; Box: TBox): Boolean;');
AddFunction(@ps_sqr,'function Sqr(e : extended) : extended;'); AddFunction(@ps_sqr,'function Sqr(e : extended) : extended;');
AddFunction(@ps_point,'function Point(x,y:integer) : TPoint;'); AddFunction(@ps_point,'function Point(x,y:integer) : TPoint;');
AddFunction(@ps_Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;'); AddFunction(@ps_Distance,'function Distance(x1,y1,x2,y2 : integer) : integer;');
@ -88,15 +93,21 @@ AddFunction(@ps_ReadFileString, 'function ReadFileString(FileNum: Integer; out s
AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;'); AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;');
AddFunction(@ps_SetFileCharPointer, 'Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;'); AddFunction(@ps_SetFileCharPointer, 'Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;');
AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;'); AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;');
AddFunction(@ps_DirectoryExists,'function DirectoryExists( const DirectoryName : string ) : Boolean;');
AddFunction(@ps_FileExists,'function FileExists ( const FileName : string ) : Boolean;');
{other} {other}
SetCurrSection('Other'); SetCurrSection('Other');
AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);'); AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);');
AddFunction(@psWait, 'procedure wait(t: integer);'); AddFunction(@psWait, 'procedure wait(t: integer);');
AddFunction(@psWait, 'procedure Sleep(t: integer);'); AddFunction(@psWait, 'procedure Sleep(t: integer);');
AddFunction(@ps_now,'function Now: TDateTime;');
AddFunction(@ps_date,'function Date : TDateTime;');
AddFunction(@GetTickCount, 'function GetSystemTime: LongWord;'); AddFunction(@GetTickCount, 'function GetSystemTime: LongWord;');
AddFunction(@GetTickCount, 'function GetTickCount: LongWord;'); AddFunction(@GetTickCount, 'function GetTickCount: LongWord;');
AddFunction(@GetTimeRunning,'function GetTimeRunning: LongWord;'); AddFunction(@GetTimeRunning,'function GetTimeRunning: LongWord;');
AddFunction(@ps_DecodeTime,'procedure DecodeTime(DateTime : TDateTime; var Hour,Min,Sec,MSec : word);');
AddFunction(@ps_DecodeDate,'procedure DecodeDate ( const SourceDate : TDateTime; out Year, Month, Day : Word );');
AddFunction(@ConvertTime,'procedure ConvertTime(Time: integer; var h, m, s: integer);'); AddFunction(@ConvertTime,'procedure ConvertTime(Time: integer; var h, m, s: integer);');
AddFunction(@HakunaMatata,'procedure HakunaMatata;'); AddFunction(@HakunaMatata,'procedure HakunaMatata;');
AddFunction(@TerminateScript,'procedure TerminateScript;'); AddFunction(@TerminateScript,'procedure TerminateScript;');
@ -113,6 +124,7 @@ SetCurrSection('String');
AddFunction(@Capitalize,'function Capitalize(str : string) : string;'); AddFunction(@Capitalize,'function Capitalize(str : string) : string;');
AddFunction(@psFormat,'function Format(const fmt : string;const args : array of const) : string;'); AddFunction(@psFormat,'function Format(const fmt : string;const args : array of const) : string;');
AddFunction(nil,'function ToStr(x) : string;'); AddFunction(nil,'function ToStr(x) : string;');
AddFunction(@ps_Between,'function Between(s1, s2, str: string): string;');
AddFunction(@IntToStr, 'function IntToStr(value: Integer): String;'); AddFunction(@IntToStr, 'function IntToStr(value: Integer): String;');
AddFunction(@FloatToStr, 'function FloatToStr(value: Extended): String;'); AddFunction(@FloatToStr, 'function FloatToStr(value: Extended): String;');
AddFunction(@psBoolToStr, 'function BoolToStr(value: Boolean): String;'); AddFunction(@psBoolToStr, 'function BoolToStr(value: Boolean): String;');
@ -150,6 +162,7 @@ AddFunction(@SetToleranceSpeed2Modifiers, 'procedure SetToleranceSpeed2Modifiers
AddFunction(@GetToleranceSpeed2Modifiers, 'procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);'); AddFunction(@GetToleranceSpeed2Modifiers, 'procedure GetToleranceSpeed2Modifiers(out hMod, sMod: Extended);');
AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;'); AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
AddFunction(@GetColors,'function GetColors(Coords : TPointArray) : TIntegerArray;'); AddFunction(@GetColors,'function GetColors(Coords : TPointArray) : TIntegerArray;');
AddFunction(@GetColorsWrap,'procedure GetColorsWrap(Coords : TPointArray; var Colors :TIntegerArray);');
AddFunction(@FindColor, 'function FindColor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); AddFunction(@FindColor, 'function FindColor(out x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;'); AddFunction(@findcolortoleranceOptimised, 'function FindColorToleranceOptimised(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
AddFunction(@FindColorTolerance, 'function FindColorTolerance(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;'); AddFunction(@FindColorTolerance, 'function FindColorTolerance(out x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
@ -180,12 +193,13 @@ AddFunction(@KeyUp, 'procedure KeyUp(key: Word);');
AddFunction(@PressKey, 'procedure PressKey(key: Word);'); AddFunction(@PressKey, 'procedure PressKey(key: Word);');
AddFunction(@SendKeys, 'procedure SendKeys(s: string);'); AddFunction(@SendKeys, 'procedure SendKeys(s: string);');
AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;'); AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;');
AddFunction(@GetKeyCode,'function GetKeyCode(c : char) : integer;');
{ OCR} { OCR}
SetCurrSection('OCR'); SetCurrSection('OCR');
AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;'); AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;');
AddFunction(@BitmapFromText, 'function BitmapFromText(text, font: String): integer;'); AddFunction(@BitmapFromText, 'function BitmapFromText(text, font: String): integer;');
AddFunction(@TPAFromText, 'function TPAFromText(text, font: String): TPointArray;'); AddFunction(@TPAFromText, 'function TPAFromText(text, font: String;out w,h : integer): TPointArray;');
AddFunction(@MaskFromText, 'function MaskFromText(text, font: String): TMask;'); AddFunction(@MaskFromText, 'function MaskFromText(text, font: String): TMask;');
{Bitmaps} {Bitmaps}

View File

@ -33,6 +33,9 @@ interface
{ This is the base class for the target functionality. If it provides a target, it extends this. { This is the base class for the target functionality. If it provides a target, it extends this.
| Some methods in heregratuitous provide default functionality as a convinence. Only override as nessessary } | Some methods in heregratuitous provide default functionality as a convinence. Only override as nessessary }
{ TTarget }
TTarget = class(TObject) TTarget = class(TObject)
public public
@ -59,6 +62,7 @@ interface
procedure HoldKey(key: integer); virtual; procedure HoldKey(key: integer); virtual;
procedure ReleaseKey(key: integer); virtual; procedure ReleaseKey(key: integer); virtual;
function IsKeyHeld(key: integer): boolean; virtual; function IsKeyHeld(key: integer): boolean; virtual;
function GetKeyCode(C : char) : integer; virtual;
end; end;
{ Implements a target that is a raw pixel array, e.g. stuff from a bitmap or a frozen state. { Implements a target that is a raw pixel array, e.g. stuff from a bitmap or a frozen state.
@ -79,6 +83,9 @@ interface
{ Implements a target that is a Window in the operating system. This class is abstract, i.e., { Implements a target that is a Window in the operating system. This class is abstract, i.e.,
| the actual os-specific Implementation of TWindow is in one of the os units. } | the actual os-specific Implementation of TWindow is in one of the os units. }
{ TWindow_Abstract }
TWindow_Abstract = class(TTarget) TWindow_Abstract = class(TTarget)
public public
procedure GetTargetDimensions(var w, h: integer); override; abstract; procedure GetTargetDimensions(var w, h: integer); override; abstract;
@ -95,6 +102,7 @@ interface
procedure HoldKey(key: integer); override; abstract; procedure HoldKey(key: integer); override; abstract;
procedure ReleaseKey(key: integer); override; abstract; procedure ReleaseKey(key: integer); override; abstract;
function IsKeyHeld(key: integer): boolean; override; abstract; function IsKeyHeld(key: integer): boolean; override; abstract;
function GetKeyCode(C : char) : integer; override; abstract;
end; end;
{ Contains the pointers to a non-internal target implementation using the EIOS specification. { Contains the pointers to a non-internal target implementation using the EIOS specification.
@ -119,6 +127,7 @@ interface
HoldKey: procedure(target: pointer; key: integer); stdcall; HoldKey: procedure(target: pointer; key: integer); stdcall;
ReleaseKey: procedure(target: pointer; key: integer); stdcall; ReleaseKey: procedure(target: pointer; key: integer); stdcall;
IsKeyHeld: function(target: pointer; key: integer): boolean; stdcall; IsKeyHeld: function(target: pointer; key: integer): boolean; stdcall;
GetKeyCode : function(target : pointer; C : char) : integer; stdcall;
end; end;
{ Implements a EIOS target. This is, for all intensive purposes, a TRawTarget with added { Implements a EIOS target. This is, for all intensive purposes, a TRawTarget with added
@ -127,6 +136,9 @@ interface
| UpdateImageBuffer call is just a call to an empty method, OR does not exist. In the case | UpdateImageBuffer call is just a call to an empty method, OR does not exist. In the case
| of an EIOS client not needing a method defined, it will not be exported and will be set | of an EIOS client not needing a method defined, it will not be exported and will be set
| to NIL here. I think. Will get back to that. } | to NIL here. I think. Will get back to that. }
{ TEIOS_Target }
TEIOS_Target = class(TTarget) TEIOS_Target = class(TTarget)
public public
constructor Create(client: TEIOS_Client; initval: pointer); constructor Create(client: TEIOS_Client; initval: pointer);
@ -144,6 +156,7 @@ interface
procedure HoldKey(key: integer); override; procedure HoldKey(key: integer); override;
procedure ReleaseKey(key: integer); override; procedure ReleaseKey(key: integer); override;
function IsKeyHeld(key: integer): boolean; override; function IsKeyHeld(key: integer): boolean; override;
function GetKeyCode(C : char) : integer; override;
private private
client: TEIOS_Client; client: TEIOS_Client;
@ -189,6 +202,9 @@ interface
| Name -> Function compatibility from the TWindow and TMInput classes (e.g. key, image, | Name -> Function compatibility from the TWindow and TMInput classes (e.g. key, image,
| and window functions). I decided to split targeting into input/output == image/keymouse, | and window functions). I decided to split targeting into input/output == image/keymouse,
| since they sometimes are treated as seperate entities. } | since they sometimes are treated as seperate entities. }
{ TIOManager_Abstract }
TIOManager_Abstract = class(TObject) TIOManager_Abstract = class(TObject)
public public
constructor Create; constructor Create;
@ -222,6 +238,7 @@ interface
procedure PressKey(key: Word); procedure PressKey(key: Word);
procedure SendText(text: string); procedure SendText(text: string);
function isKeyDown(key: Word): Boolean; function isKeyDown(key: Word): Boolean;
function GetKeyCode(c : char) : integer;
function GetImageTarget: TTarget; overload; function GetImageTarget: TTarget; overload;
function GetKeyMouseTarget: TTarget; overload; function GetKeyMouseTarget: TTarget; overload;
@ -509,29 +526,35 @@ begin
result:= keymouse.IsKeyHeld(key); result:= keymouse.IsKeyHeld(key);
end; end;
function TIOManager_Abstract.GetKeyCode(c: char): integer;
begin
result := keymouse.GetKeyCode(c);
end;
//***implementation*** TTarget //***implementation*** TTarget
procedure TTarget.GetTargetDimensions(var w, h: integer); begin raise Exception.Create('GetTargetDimensions not avaliable for this target'); end; procedure TTarget.GetTargetDimensions(var w, h: integer); begin raise Exception.Create('GetTargetDimensions not available for this target'); end;
function TTarget.GetColor(x,y : integer) : TColor; function TTarget.GetColor(x,y : integer) : TColor;
begin begin
with ReturnData(x,y,1,1) do with ReturnData(x,y,1,1) do
Result := RGBToColor(Ptr[0].r,Ptr[0].g,Ptr[0].b); Result := RGBToColor(Ptr[0].r,Ptr[0].g,Ptr[0].b);
FreeReturnData; FreeReturnData;
end; end;
function TTarget.ReturnData(xs, ys, width, height: Integer): TRetData; begin raise Exception.Create('ReturnData not avaliable for this target'); 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.FreeReturnData; begin {do nothing by default} end;
procedure TTarget.ActivateClient; begin raise Exception.Create('ActivateClient not avaliable for this target'); 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.TargetValid: boolean; begin result:= true; end;
procedure TTarget.GetMousePosition(var x,y: integer); begin raise Exception.Create('GetMousePosition not avaliable 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 avaliable for this target'); end; procedure TTarget.MoveMouse(x,y: integer); begin raise Exception.Create('MoveMouse not available for this target'); end;
procedure TTarget.HoldMouse(x,y: integer; button: TClickType); begin raise Exception.Create('HoldMouse not avaliable 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 avaliable 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.SendString(str: string); begin raise Exception.Create('SendString not avaliable 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 avaliable 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 avaliable 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 avaliable 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 //***implementation*** TEIOS_Target
@ -642,6 +665,14 @@ begin
result:= inherited IsKeyHeld(key); result:= inherited IsKeyHeld(key);
end; end;
function TEIOS_Target.GetKeyCode(C: char): integer;
begin
if Pointer(client.GetKeyCode) <> nil then
result:= client.GetKeyCode(target,C)
else
result:= inherited GetKeyCode(C);
end;
//***implementation*** TRawTarget //***implementation*** TRawTarget
constructor TRawTarget.Create(rgb: prgb32; w,h: integer; CopyData : boolean = false); constructor TRawTarget.Create(rgb: prgb32; w,h: integer; CopyData : boolean = false);

View File

@ -38,6 +38,8 @@ interface
procedure Up(Key: Word); procedure Up(Key: Word);
end; end;
{ TWindow }
TWindow = class(TWindow_Abstract) TWindow = class(TWindow_Abstract)
public public
constructor Create(display: PDisplay; screennum: integer; window: x.TWindow); constructor Create(display: PDisplay; screennum: integer; window: x.TWindow);
@ -57,6 +59,7 @@ interface
procedure HoldKey(key: integer); override; procedure HoldKey(key: integer); override;
procedure ReleaseKey(key: integer); override; procedure ReleaseKey(key: integer); override;
function IsKeyHeld(key: integer): boolean; override; function IsKeyHeld(key: integer): boolean; override;
function GetKeyCode(c : char) : integer;override;
function GetNativeWindow: TNativeWindow; function GetNativeWindow: TNativeWindow;
private private
@ -285,18 +288,6 @@ implementation
XSetErrorHandler(Old_Handler); XSetErrorHandler(Old_Handler);
end; end;
function GetSimpleKeyCode(c: char): word;
begin
case C of
'0'..'9' :Result := VK_0 + Ord(C) - Ord('0');
'a'..'z' :Result := VK_A + Ord(C) - Ord('a');
'A'..'Z' :Result := VK_A + Ord(C) - Ord('A');
' ' : result := VK_SPACE;
else
Raise Exception.CreateFMT('GetSimpleKeyCode - char (%s) is not in A..z',[c]);
end
end;
procedure TWindow.SendString(str: string); procedure TWindow.SendString(str: string);
var var
i: integer; i: integer;
@ -317,7 +308,7 @@ implementation
HoldShift:= false; HoldShift:= false;
ReleaseKey(VK_SHIFT); ReleaseKey(VK_SHIFT);
end; end;
key:= GetSimpleKeyCode(str[i]); key:= GetKeyCode(str[i]);
HoldKey(key); HoldKey(key);
//BenLand100: You should probably wait here... //BenLand100: You should probably wait here...
ReleaseKey(key); ReleaseKey(key);
@ -338,6 +329,18 @@ implementation
raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Linux', []); raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Linux', []);
end; end;
function TWindow.GetKeyCode(c: char): integer;
begin
case C of
'0'..'9' :Result := VK_0 + Ord(C) - Ord('0');
'a'..'z' :Result := VK_A + Ord(C) - Ord('a');
'A'..'Z' :Result := VK_A + Ord(C) - Ord('A');
' ' : result := VK_SPACE;
else
Raise Exception.CreateFMT('GetSimpleKeyCode - char (%s) is not in A..z',[c]);
end
end;
//***implementation*** IOManager //***implementation*** IOManager
constructor TIOManager.Create; constructor TIOManager.Create;

View File

@ -39,6 +39,8 @@ interface
procedure Up(Key: Word); procedure Up(Key: Word);
end; end;
{ TWindow }
TWindow = class(TWindow_Abstract) TWindow = class(TWindow_Abstract)
public public
constructor Create(target: Hwnd); constructor Create(target: Hwnd);
@ -58,6 +60,7 @@ interface
procedure HoldKey(key: integer); override; procedure HoldKey(key: integer); override;
procedure ReleaseKey(key: integer); override; procedure ReleaseKey(key: integer); override;
function IsKeyHeld(key: integer): boolean; override; function IsKeyHeld(key: integer): boolean; override;
function GetKeyCode(c : char) : integer;override;
function GetNativeWindow: TNativeWindow; function GetNativeWindow: TNativeWindow;
private private
@ -297,7 +300,7 @@ implementation
HoldShift:= false; HoldShift:= false;
ReleaseKey(VK_SHIFT); ReleaseKey(VK_SHIFT);
end; end;
key:= VkKeyScan(str[i]) and $FF; key:= GetKeyCode(str[i]);
HoldKey(key); HoldKey(key);
//BenLand100 note: probably should wait here //BenLand100 note: probably should wait here
ReleaseKey(key); ReleaseKey(key);
@ -318,6 +321,11 @@ implementation
raise Exception.CreateFmt('IsKeyHeld isn''t implemented yet on Windows', []); raise Exception.CreateFmt('IsKeyHeld isn''t implemented yet on Windows', []);
end; end;
function TWindow.GetKeyCode(c: char): integer;
begin
result := VkKeyScan(c) and $FF;
end;
//***implementation*** IOManager //***implementation*** IOManager