Added DrawBitmap (which draws on a Canvas) and IsMouseButtonDown.

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@554 3f818213-9676-44b0-a9b4-5e4c4e03d09d

trunk/Projects/SAMufasaGUI/testunit.pas

@@ -43,7 +43,7 @@ uses
   ColorBox              , about, framefunctionlist, ocr, updateform, simbasettings;
 
 const
-    SimbaVersion = 545;
+    SimbaVersion = 554;
 
 type
 

trunk/Units/MMLAddon/PSInc/Wrappers/bitmap.inc

@@ -134,6 +134,11 @@ begin;
   CurrThread.Client.MBitmaps[bmp].FastDrawClear(Color);
 end;
 
+procedure DrawBitmap(Bmp: Integer; Dest: TCanvas; x, y: Integer);extdecl;
+begin
+  CurrThread.Client.MBitmaps[bmp].DrawToCanvas(x,y,dest);
+end;
+
 procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer); extdecl;
 begin;
   CurrThread.Client.MBitmaps[SourceBitmap].FastDrawTransparent(x,y,CurrThread.Client.MBitmaps[TargetBitmap]);

trunk/Units/MMLAddon/PSInc/Wrappers/mouse.inc

@@ -59,3 +59,8 @@ procedure ClickMouse(x, y: integer; clickType: integer); extdecl;
 begin
    CurrThread.Client.IOManager.ClickMouse(x, y, ConvIntClickType(clickType));
 end;
+
+function  IsMouseButtonDown( button : integer) : boolean; extdecl;
+begin
+  result := CurrThread.Client.IOManager.IsMouseButtonDown(ConvIntClickType(button));
+end;

trunk/Units/MMLAddon/PSInc/Wrappers/strings.inc

@@ -1 +1 @@
-function psFormat(const fmt : string;const args : array of const) : string; extdecl;
 extdecl;
begin;
  Result := Format(fmt,Args);
end;

function Capitalize(str : string) : string;
 extdecl;
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;
begin;
) then
      cap := true;
end;

type
  StrExtr =(Numbers, Letters, Others);
function ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl;
var
  Range : set of char;
  i : integer;
begin;
  case Extract of
    Numbers : Range := ['0'..'9'];
    Letters : Range := ['A'..'Z'] + ['a'..'z'];
    Others  : Range := [#0..#255] - ['0'..'9'] - ['A'..'Z'] - ['a'..'z'];
  end;
  for i := length(str) downto 1 do
    if str[i] in Range then
      result := str[i] + result;
end;

function ps_BoolToStr(bool : boolean) : string; extdecl;
begin;
  result := BoolToStr(bool,true);
end;

function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl;
begin;
  result := StringReplace(Text,FindStr,ReplaceStr,Flags);
end;

function ps_IntToStr(int : integer) : string; extdecl;
begin
  result := inttostr(int);
end;

function ps_FloatToStr(flt : extended) : string; extdecl;
begin
  result := floattostr(flt);
end;

function ps_StrToInt(value: String): Integer; extdecl;
begin
  result := StrToInt(value);
end;

function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl;
begin
  result := StrToIntDef(value,default);
end;

function ps_StrToFloat(value: String): Extended; extdecl;
begin
  result := StrToFloat(value);
end;

function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl;
begin
  result := StrToFloatDef(value,default);
end;

function ps_StrToBool(value: String): Boolean;extdecl;
begin
  result := StrToBool(value);
end;

function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl;
begin
  result := StrToBoolDef(value,default);
end;

function ps_Between(s1, s2, str: string): string; extdecl;
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;
+function psFormat(const fmt : string;const args : array of const) : string; extdecl;
 extdecl;
begin;
  Result := Format(fmt,Args);
end;

function Capitalize(str : string) : string;
 extdecl;
var
  i , l : integer;
  cap : boolean;
  Range : set of char;
begin;
  result := str;
  l := length(str);
  cap := true;
  Range :=  ['a'..'z'] + ['A'..'Z'];
  for i := 1 to l do
    if cap and (str[i] in Range) then
    begin;
      result[i] := UpperCase(str[i])[1];
      cap := false;
begin;
  cap := true;
) then
      cap := true;
end;

type
  StrExtr =(Numbers, Letters, Others);
function ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl;
var
  Range : set of char;
  i : integer;
begin;
  case Extract of
    Numbers : Range := ['0'..'9'];
    Letters : Range := ['A'..'Z'] + ['a'..'z'];
    Others  : Range := [#0..#255] - ['0'..'9'] - ['A'..'Z'] - ['a'..'z'];
  end;
  for i := length(str) downto 1 do
    if str[i] in Range then
      result := str[i] + result;
end;

function ps_BoolToStr(bool : boolean) : string; extdecl;
begin;
  result := BoolToStr(bool,true);
end;

function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl;
begin;
  result := StringReplace(Text,FindStr,ReplaceStr,Flags);
end;

function ps_IntToStr(int : integer) : string; extdecl;
begin
  result := inttostr(int);
end;

function ps_FloatToStr(flt : extended) : string; extdecl;
begin
  result := floattostr(flt);
end;

function ps_StrToInt(value: String): Integer; extdecl;
begin
  result := StrToInt(value);
end;

function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl;
begin
  result := StrToIntDef(value,default);
end;

function ps_StrToFloat(value: String): Extended; extdecl;
begin
  result := StrToFloat(value);
end;

function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl;
begin
  result := StrToFloatDef(value,default);
end;

function ps_StrToBool(value: String): Boolean;extdecl;
begin
  result := StrToBool(value);
end;

function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl;
begin
  result := StrToBoolDef(value,default);
end;

function ps_Between(s1, s2, str: string): string; extdecl;
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;

trunk/Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -207,7 +207,7 @@ AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
 AddFunction(@HoldMouse, 'procedure HoldMouse(x, y: integer; clickType: integer);');
 AddFunction(@ReleaseMouse, 'procedure ReleaseMouse(x, y: integer; clickType: integer);');
 AddFunction(@ClickMouse, 'procedure ClickMouse(x, y: integer; clickType: integer);');
-
+AddFunction(@IsMouseButtonDown,'function IsMouseButtonDown( button : integer) : boolean;');
 
 {Keyboard}
 SetCurrSection('Keyboard');
@@ -275,6 +275,7 @@ AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapTolerance
 AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap: integer; TPA: TPointArray; Color: integer);');
 AddFunction(@DrawATPABitmap,'procedure DrawATPABitmap(bitmap: integer; ATPA: T2DPointArray);');
 AddFunction(@DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap: integer; ATPA: T2DPointArray; Colors: TIntegerArray);');
+AddFunction(@DrawBitmap,'procedure DrawBitmap(Bmp: Integer; Dest: TCanvas; x, y: Integer);');
 
 {tpa}
 SetCurrSection('TPA');

trunk/Units/MMLCore/bitmaps.pas

@@ -56,6 +56,7 @@ type
     procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);overload;
     procedure DrawATPA(ATPA : T2DPointArray);overload;
     procedure DrawTPA(TPA : TPointArray; Color : TColor);
+    procedure DrawToCanvas(x,y : integer; Canvas : TCanvas);
     function CreateTPA(SearchCol : TColor) : TPointArray;
     function FastGetPixel(x,y : integer) : TColor;
     function FastGetPixels(TPA : TPointArray) : TIntegerArray;
@@ -638,6 +639,15 @@ begin
   DrawATPA(ConvArr([TPA]),ConvArr([Color]));
 end;
 
+procedure TMufasaBitmap.DrawToCanvas(x,y : integer; Canvas: TCanvas);
+var
+  Bitmap : Graphics.TBitmap;
+begin
+  Bitmap := Self.ToTBitmap;
+  Canvas.Draw(x,y,Bitmap);
+  Bitmap.free;
+end;
+
 function TMufasaBitmap.CreateTPA(SearchCol: TColor): TPointArray;
 var
   x,y,L,I : Integer;

trunk/Units/MMLCore/iomanager.pas

@@ -60,6 +60,7 @@ interface
         procedure MoveMouse(x,y: integer); virtual;
         procedure HoldMouse(x,y: integer; button: TClickType); virtual;
         procedure ReleaseMouse(x,y: integer; button: TClickType); virtual;
+        function  IsMouseButtonHeld( button : TClickType) : boolean ; virtual;
 
         { ONLY override the following methods if the target provides key functions, defaults to 
         | raise exceptions }
@@ -115,6 +116,7 @@ interface
         procedure MoveMouse(x,y: integer); override; abstract;
         procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
         procedure ReleaseMouse(x,y: integer; button: TClickType); override; abstract;
+        function  IsMouseButtonHeld( button : TClickType) : boolean;override; abstract;
 
         procedure SendString(str: string); override; abstract;
         procedure HoldKey(key: integer); override; abstract;
@@ -140,6 +142,7 @@ interface
       MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
       HoldMouse: 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;
 
       SendString: procedure(target: pointer; str: PChar); stdcall;
       HoldKey: procedure(target: pointer; key: integer); stdcall;
@@ -169,6 +172,7 @@ interface
         procedure MoveMouse(x,y: integer); override;
         procedure HoldMouse(x,y: integer; button: TClickType); override;
         procedure ReleaseMouse(x,y: integer; button: TClickType); override;
+        function  IsMouseButtonHeld( button : TClickType) : boolean;override;
 
         procedure SendString(str: string); override;
         procedure HoldKey(key: integer); override;
@@ -227,6 +231,7 @@ interface
       MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
       HoldMouse: 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;
 
       SendString: procedure(target: pointer; str: PChar); stdcall;
       HoldKey: procedure(target: pointer; key: integer); stdcall;
@@ -278,6 +283,7 @@ interface
         procedure HoldMouse(x,y : integer; button: TClickType);
         procedure ReleaseMouse(x,y : integer; button: TClickType);
         procedure ClickMouse(X, Y: Integer; button: TClickType);
+        function  IsMouseButtonDown( button : TClickType) : boolean;
 
         procedure KeyUp(key: Word);
         procedure KeyDown(key: Word);
@@ -330,6 +336,7 @@ interface
     procedure TTarget_Exported_MoveMouse(target: pointer; x,y: integer); 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;
+    function TTarget_Exported_IsMouseButtonHeld(target: pointer; left : boolean) : boolean;stdcall;
 
     procedure TTarget_Exported_SendString(target: pointer; str: PChar); stdcall;
     procedure TTarget_Exported_HoldKey(target: pointer; key: integer); stdcall;
@@ -614,6 +621,11 @@ begin
   ReleaseMouse(x,y,button);
 end;
 
+function TIOManager_Abstract.IsMouseButtonDown(button: TClickType): boolean;
+begin
+  result := keymouse.IsMouseButtonHeld(button);
+end;
+
 procedure TIOManager_Abstract.KeyUp(key: Word);
 begin
   keymouse.ReleaseKey(key)
@@ -687,6 +699,7 @@ procedure TTarget.GetMousePosition(var x,y: integer); begin raise Exception.Crea
 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;
+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;
@@ -774,6 +787,19 @@ begin
     inherited ReleaseMouse(x,y,button);
 end;
 
+function TEIOS_Target.IsMouseButtonHeld(button: TClickType): boolean;
+begin
+  if Pointer(client.IsMouseButtonHeld) <> nil then
+  begin
+    case button of
+      mouse_Left:  result := client.IsMouseButtonHeld(target,true);
+      mouse_Middle: raise Exception.Create('EIOS does not implement the middle mouse button.');
+      mouse_Right: result := client.IsMouseButtonHeld(target,false);
+    end;
+  end else
+    result := inherited IsMouseButtonHeld(button);
+end;
+
 procedure TEIOS_Target.SendString(str: string);
 begin
   if Pointer(client.SendString) <> nil then
@@ -1003,6 +1029,15 @@ begin
     TTarget(Target).ReleaseMouse(x,y,mouse_right);
 end;
 
+function TTarget_Exported_IsMouseButtonHeld(target: pointer; left: boolean
+  ): boolean; stdcall;
+begin
+  if left then
+    result := TTarget(Target).IsMouseButtonHeld(mouse_left)
+  else
+    result := TTarget(Target).IsMouseButtonHeld(mouse_right);
+end;
+
 procedure TTarget_Exported_SendString(target: pointer; str: PChar); stdcall;
 begin
   TTarget(Target).SendString(str);

trunk/Units/MMLCore/os_linux.pas

@@ -59,6 +59,7 @@ interface
         procedure MoveMouse(x,y: integer); override;
         procedure HoldMouse(x,y: integer; button: TClickType); override;
         procedure ReleaseMouse(x,y: integer; button: TClickType); override;
+        function  IsMouseButtonHeld( button : TClickType) : boolean;override;
 
         procedure SendString(str: string); override;
         procedure HoldKey(key: integer); override;
@@ -380,6 +381,11 @@ implementation
     //XSetErrorHandler(Old_Handler);
   end;
 
+function TWindow.IsMouseButtonHeld(button: TClickType): boolean;
+begin
+  raise exception.create('IsMouseButtonHeld is not yet implemented on Linux');
+end;
+
   procedure TWindow.SendString(str: string);
   var
     i: integer;

trunk/Units/MMLCore/os_windows.pas

@@ -59,6 +59,7 @@ interface
         procedure MoveMouse(x,y: integer); override;
         procedure HoldMouse(x,y: integer; button: TClickType); override;
         procedure ReleaseMouse(x,y: integer; button: TClickType); override;
+        function  IsMouseButtonHeld( button : TClickType) : boolean;override;
 
         procedure SendString(str: string); override;
         procedure HoldKey(key: integer); override;
@@ -299,6 +300,15 @@ implementation
     SendInput(1,Input, sizeof(Input));
   end;
 
+function TWindow.IsMouseButtonHeld(button: TClickType): boolean;
+begin
+  case button of
+     mouse_Left : Result := (GetAsyncKeyState(VK_LBUTTON) <> 0);
+     mouse_Middle : Result := (GetAsyncKeyState(VK_MBUTTON) <> 0);
+     mouse_Right : Result := (GetAsyncKeyState(VK_RBUTTON) <> 0);
+  end;
+end;
+
   procedure TWindow.SendString(str: string);
   var
     i: integer;