diff --git a/trunk/Projects/SAMufasaGUI/testunit.pas b/trunk/Projects/SAMufasaGUI/testunit.pas index 9883219..39bb49f 100644 --- a/trunk/Projects/SAMufasaGUI/testunit.pas +++ b/trunk/Projects/SAMufasaGUI/testunit.pas @@ -1730,7 +1730,7 @@ begin Exit; with TOpenDialog.Create(nil) do try - Filter:= 'Mufasa Files|*.cogat;*.mufa;*.txt|Any files|*.*'; + Filter:= 'Simba Files|*.simb;*.cogat;*.mufa;*.txt|Any files|*.*'; if Execute then result := LoadScriptFile(filename); finally @@ -1783,12 +1783,12 @@ begin Result := false; with TSaveDialog.Create(nil) do try - Filter:= 'Mufasa files|*.cogat;*.mufa;*.pas;*.txt|Any Files|*.*'; + Filter:= 'Simba files|*.simb;*.cogat;*.mufa;*.pas;*.txt|Any Files|*.*'; if Execute then begin; if ExtractFileExt(FileName) = '' then begin; - ScriptFile := FileName + '.mufa'; + ScriptFile := FileName + '.simb'; end else ScriptFile := FileName; SynEdit.Lines.SaveToFile(ScriptFile); diff --git a/trunk/Units/MMLAddon/PSInc/Wrappers/colour.inc b/trunk/Units/MMLAddon/PSInc/Wrappers/colour.inc index c0da192..88f1150 100644 --- a/trunk/Units/MMLAddon/PSInc/Wrappers/colour.inc +++ b/trunk/Units/MMLAddon/PSInc/Wrappers/colour.inc @@ -26,6 +26,11 @@ begin; Result := CurrThread.Client.IOManager.GetColor(x,y); 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; begin result := CurrThread.Client.MFinder.GetColors(coords); diff --git a/trunk/Units/MMLAddon/PSInc/Wrappers/file.inc b/trunk/Units/MMLAddon/PSInc/Wrappers/file.inc index bedd783..2c3e237 100644 --- a/trunk/Units/MMLAddon/PSInc/Wrappers/file.inc +++ b/trunk/Units/MMLAddon/PSInc/Wrappers/file.inc @@ -68,3 +68,11 @@ function ps_FilePointerPos(FileNum: Integer): Integer; ps_decl; begin Result := CurrThread.Client.MFiles.FilePointerPos(FileNum); 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; diff --git a/trunk/Units/MMLAddon/PSInc/Wrappers/keyboard.inc b/trunk/Units/MMLAddon/PSInc/Wrappers/keyboard.inc index 954c352..da6ba9f 100644 --- a/trunk/Units/MMLAddon/PSInc/Wrappers/keyboard.inc +++ b/trunk/Units/MMLAddon/PSInc/Wrappers/keyboard.inc @@ -45,3 +45,8 @@ function isKeyDown(key: Word): boolean; ps_decl; begin Result := CurrThread.Client.IOManager.isKeyDown(key); end; + +function GetKeyCode(c :char) : integer; ps_decl; +begin + result := CurrThread.Client.IOManager.GetKeyCode(c); +end; diff --git a/trunk/Units/MMLAddon/PSInc/Wrappers/math.inc b/trunk/Units/MMLAddon/PSInc/Wrappers/math.inc index 03f2a0a..1b8b087 100644 --- a/trunk/Units/MMLAddon/PSInc/Wrappers/math.inc +++ b/trunk/Units/MMLAddon/PSInc/Wrappers/math.inc @@ -21,6 +21,11 @@ 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; begin result := ceil(e); @@ -75,6 +80,11 @@ begin Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom); end; +function ps_ArcTan2(x,y : extended) : extended; +begin + result := ArcTan2(x,y); +end; + function Factorial(number: longword): Int64; ps_decl; var Loop : longword; @@ -97,3 +107,30 @@ begin; while Result > 360 do Result := Result - 360; 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; + diff --git a/trunk/Units/MMLAddon/PSInc/Wrappers/ocr.inc b/trunk/Units/MMLAddon/PSInc/Wrappers/ocr.inc index 225710c..00ae912 100644 --- a/trunk/Units/MMLAddon/PSInc/Wrappers/ocr.inc +++ b/trunk/Units/MMLAddon/PSInc/Wrappers/ocr.inc @@ -17,9 +17,7 @@ begin Result := CurrThread.Client.MOCR.TextToMask(text,font); end; -function TPAFromText(text, font: String): TPointArray; ps_decl; -var - w,h : integer; +function TPAFromText(text, font: String;out w,h : integer): TPointArray; ps_decl; begin Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h); end; diff --git a/trunk/Units/MMLAddon/PSInc/Wrappers/other.inc b/trunk/Units/MMLAddon/PSInc/Wrappers/other.inc index 62302ed..851d9e1 100644 --- a/trunk/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/trunk/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -60,18 +60,7 @@ begin; bmp.Free; 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; begin; @@ -112,7 +101,22 @@ begin; x := x mod (1000 * 60); s := x div (1000); 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; begin; OpenWebPage('http://www.youtube.com/v/ejEVczA8PLU&hl=en&fs=1&autoplay=1'); diff --git a/trunk/Units/MMLAddon/PSInc/Wrappers/strings.inc b/trunk/Units/MMLAddon/PSInc/Wrappers/strings.inc index b3dcfa0..6f0860c 100644 --- a/trunk/Units/MMLAddon/PSInc/Wrappers/strings.inc +++ b/trunk/Units/MMLAddon/PSInc/Wrappers/strings.inc @@ -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; \ No newline at end of file +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; \ No newline at end of file diff --git a/trunk/Units/MMLAddon/PSInc/pscompile.inc b/trunk/Units/MMLAddon/PSInc/pscompile.inc index 00fffa8..f89b4d3 100644 --- a/trunk/Units/MMLAddon/PSInc/pscompile.inc +++ b/trunk/Units/MMLAddon/PSInc/pscompile.inc @@ -26,13 +26,14 @@ Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath) Sender.Comp.AddConstantN('IncludePath','string').SetString(CurrThread.IncludePath); Sender.Comp.AddConstantN('PluginPath','string').SetString(CurrThread.PluginPath); Sender.Comp.AddConstantN('FontPath','string').SetString(CurrThread.FontPath); +Sender.Comp.AddTypeS('TDateTime','Double'); Sender.Comp.AddTypeS('TIntegerArray', 'Array of LongInt'); Sender.Comp.AddTypeS('TExtendedArray','Array of extended'); Sender.Comp.AddTypeS('TBoolArray', 'Array of Boolean'); Sender.Comp.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;'); Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); -Sender.Comp.AddTypeS('T2DPointArray','Array of Array of TPoint'); -Sender.Comp.AddTypeS('TPointArrayArray','Array of Array of TPoint'); +Sender.Comp.AddTypeS('T2DPointArray','Array of TPointArray'); +Sender.Comp.AddTypeS('TPointArrayArray','Array of TPointArray'); 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('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('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('TMousePress', '(mouse_Down, mouse_Up);'); Sender.Comp.AddTypeS('Pointer', 'Integer'); diff --git a/trunk/Units/MMLAddon/PSInc/psexportedmethods.inc b/trunk/Units/MMLAddon/PSInc/psexportedmethods.inc index fa72fcc..11211a5 100644 --- a/trunk/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/trunk/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -48,8 +48,13 @@ AddFunction(@ps_pow,'function pow(base,exponent : extended) : extended'); AddFunction(@ps_max,'function Max(a, b: Integer): Integer;'); AddFunction(@ps_min,'function Min(a, b: Integer): Integer;'); 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(@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_point,'function Point(x,y:integer) : TPoint;'); 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_SetFileCharPointer, 'Function SetFileCharPointer(FileNum, cChars, Origin: 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} SetCurrSection('Other'); AddFunction(@SaveScreenshot,'procedure SaveScreenshot(FileName: string);'); AddFunction(@psWait, 'procedure wait(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 GetTickCount: 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(@HakunaMatata,'procedure HakunaMatata;'); AddFunction(@TerminateScript,'procedure TerminateScript;'); @@ -113,6 +124,7 @@ SetCurrSection('String'); AddFunction(@Capitalize,'function Capitalize(str : string) : string;'); AddFunction(@psFormat,'function Format(const fmt : string;const args : array of const) : 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(@FloatToStr, 'function FloatToStr(value: Extended): 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(@GetColor,'function GetColor(x, y: Integer): Integer;'); 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(@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;'); @@ -180,12 +193,13 @@ AddFunction(@KeyUp, 'procedure KeyUp(key: Word);'); AddFunction(@PressKey, 'procedure PressKey(key: Word);'); AddFunction(@SendKeys, 'procedure SendKeys(s: string);'); AddFunction(@isKeyDown, 'function IsKeyDown(key: Word): Boolean;'); +AddFunction(@GetKeyCode,'function GetKeyCode(c : char) : integer;'); { OCR} SetCurrSection('OCR'); AddFunction(@rs_GetUpText, 'function rs_GetUpText: string;'); 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;'); {Bitmaps} diff --git a/trunk/Units/MMLCore/iomanager.pas b/trunk/Units/MMLCore/iomanager.pas index 9580c58..eb968ea 100644 --- a/trunk/Units/MMLCore/iomanager.pas +++ b/trunk/Units/MMLCore/iomanager.pas @@ -33,6 +33,9 @@ interface { 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 } + + { TTarget } + TTarget = class(TObject) public @@ -58,7 +61,8 @@ interface procedure SendString(str: string); virtual; procedure HoldKey(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; { 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., | the actual os-specific Implementation of TWindow is in one of the os units. } + + { TWindow_Abstract } + TWindow_Abstract = class(TTarget) public procedure GetTargetDimensions(var w, h: integer); override; abstract; @@ -95,6 +102,7 @@ interface procedure HoldKey(key: integer); override; abstract; procedure ReleaseKey(key: integer); override; abstract; function IsKeyHeld(key: integer): boolean; override; abstract; + function GetKeyCode(C : char) : integer; override; abstract; end; { 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; ReleaseKey: procedure(target: pointer; key: integer); stdcall; IsKeyHeld: function(target: pointer; key: integer): boolean; stdcall; + GetKeyCode : function(target : pointer; C : char) : integer; stdcall; end; { 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 | 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. } + + { TEIOS_Target } + TEIOS_Target = class(TTarget) public constructor Create(client: TEIOS_Client; initval: pointer); @@ -144,6 +156,7 @@ interface procedure HoldKey(key: integer); override; procedure ReleaseKey(key: integer); override; function IsKeyHeld(key: integer): boolean; override; + function GetKeyCode(C : char) : integer; override; private client: TEIOS_Client; @@ -189,6 +202,9 @@ interface | 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, | since they sometimes are treated as seperate entities. } + + { TIOManager_Abstract } + TIOManager_Abstract = class(TObject) public constructor Create; @@ -222,6 +238,7 @@ interface procedure PressKey(key: Word); procedure SendText(text: string); function isKeyDown(key: Word): Boolean; + function GetKeyCode(c : char) : integer; function GetImageTarget: TTarget; overload; function GetKeyMouseTarget: TTarget; overload; @@ -509,29 +526,35 @@ begin result:= keymouse.IsKeyHeld(key); end; +function TIOManager_Abstract.GetKeyCode(c: char): integer; +begin + result := keymouse.GetKeyCode(c); +end; + //***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; 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 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.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; -procedure TTarget.GetMousePosition(var x,y: integer); begin raise Exception.Create('GetMousePosition not avaliable for this target'); end; -procedure TTarget.MoveMouse(x,y: integer); begin raise Exception.Create('MoveMouse not avaliable 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.ReleaseMouse(x,y: integer; button: TClickType); begin raise Exception.Create('ReleaseMouse 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 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.SendString(str: string); begin raise Exception.Create('SendString not avaliable for this target'); end; -procedure TTarget.HoldKey(key: integer); begin raise Exception.Create('HoldKey not avaliable for this target'); end; -procedure TTarget.ReleaseKey(key: integer); begin raise Exception.Create('ReleaseKey not avaliable for this target'); end; -function TTarget.IsKeyHeld(key: integer): boolean; begin raise Exception.Create('IsKeyHeld 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 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 @@ -642,6 +665,14 @@ begin result:= inherited IsKeyHeld(key); 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 constructor TRawTarget.Create(rgb: prgb32; w,h: integer; CopyData : boolean = false); diff --git a/trunk/Units/MMLCore/os_linux.pas b/trunk/Units/MMLCore/os_linux.pas index c1e1d05..8a7a2b9 100644 --- a/trunk/Units/MMLCore/os_linux.pas +++ b/trunk/Units/MMLCore/os_linux.pas @@ -38,6 +38,8 @@ interface procedure Up(Key: Word); end; + { TWindow } + TWindow = class(TWindow_Abstract) public constructor Create(display: PDisplay; screennum: integer; window: x.TWindow); @@ -57,6 +59,7 @@ interface procedure HoldKey(key: integer); override; procedure ReleaseKey(key: integer); override; function IsKeyHeld(key: integer): boolean; override; + function GetKeyCode(c : char) : integer;override; function GetNativeWindow: TNativeWindow; private @@ -285,18 +288,6 @@ implementation XSetErrorHandler(Old_Handler); 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); var i: integer; @@ -317,7 +308,7 @@ implementation HoldShift:= false; ReleaseKey(VK_SHIFT); end; - key:= GetSimpleKeyCode(str[i]); + key:= GetKeyCode(str[i]); HoldKey(key); //BenLand100: You should probably wait here... ReleaseKey(key); @@ -337,6 +328,18 @@ implementation begin raise Exception.CreateFmt('IsKeyDown isn''t implemented yet on Linux', []); 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 diff --git a/trunk/Units/MMLCore/os_windows.pas b/trunk/Units/MMLCore/os_windows.pas index f3587d5..6499bad 100644 --- a/trunk/Units/MMLCore/os_windows.pas +++ b/trunk/Units/MMLCore/os_windows.pas @@ -39,6 +39,8 @@ interface procedure Up(Key: Word); end; + { TWindow } + TWindow = class(TWindow_Abstract) public constructor Create(target: Hwnd); @@ -58,6 +60,7 @@ interface procedure HoldKey(key: integer); override; procedure ReleaseKey(key: integer); override; function IsKeyHeld(key: integer): boolean; override; + function GetKeyCode(c : char) : integer;override; function GetNativeWindow: TNativeWindow; private @@ -297,7 +300,7 @@ implementation HoldShift:= false; ReleaseKey(VK_SHIFT); end; - key:= VkKeyScan(str[i]) and $FF; + key:= GetKeyCode(str[i]); HoldKey(key); //BenLand100 note: probably should wait here ReleaseKey(key); @@ -317,6 +320,11 @@ implementation begin raise Exception.CreateFmt('IsKeyHeld isn''t implemented yet on Windows', []); end; + + function TWindow.GetKeyCode(c: char): integer; + begin + result := VkKeyScan(c) and $FF; + end; //***implementation*** IOManager