Target freeze/unfreeze image

Source/script/imports/simba.import_target.pas

@@ -299,6 +299,21 @@ procedure _LapeTarget_ToString(const Params: PParamArray; const Result: Pointer)
   PString(Result)^ := PSimbaTarget(Params^[0])^.ToString();
 end;
 
+procedure _LapeTarget_FreezeImage(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+  PSimbaTarget(Params^[0])^.FreezeImage(PBox(Params^[1])^);
+end;
+
+procedure _LapeTarget_UnFreezeImage(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+  PSimbaTarget(Params^[0])^.UnFreezeImage();
+end;
+
+procedure _LapeTarget_IsImageFrozen(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PBoolean(Result)^ := PSimbaTarget(Params^[0])^.IsImageFrozen();
+end;
+
 procedure ImportTarget(Compiler: TSimbaScript_Compiler);
 begin
   with Compiler do
@@ -308,9 +323,10 @@ procedure ImportTarget(Compiler: TSimbaScript_Compiler);
     addGlobalType([
       'packed record',
       '  {%CODETOOLS OFF}',
-      '  InternalData: array[1..' + IntToStr(SizeOf(TSimbaTarget) - LapeTypeSize[ltDynArray])  + '] of Byte;',
+      '  InternalData: array[1..' + IntToStr(SizeOf(TSimbaTarget) - (LapeTypeSize[ltDynArray]*2)) + '] of Byte;',
       '  {%CODETOOLS ON}',
       '  InvalidTargetEvents: array of TMethod;',
+      '  FrozenData: array of TColorBGRA;',
       'end;'],
       'TTarget'
     );
@@ -360,6 +376,10 @@ procedure ImportTarget(Compiler: TSimbaScript_Compiler);
 
     addGlobalFunc('function TTarget.IsDefault: Boolean', @_LapeTarget_IsDefault);
 
+    addGlobalFunc('procedure TTarget.FreezeImage(ABounds: TBox);', @_LapeTarget_FreezeImage);
+    addGlobalFunc('procedure TTarget.UnFreezeImage;', @_LapeTarget_UnFreezeImage);
+    addGlobalFunc('function TTarget.IsImageFrozen: Boolean;', @_LapeTarget_IsImageFrozen);
+
     addGlobalFunc('function ToString(constref Target: TTarget): String; override;', @_LapeTarget_ToString);
 
     ImportingSection := 'Image';

Source/simba.target.pas

@@ -51,6 +51,7 @@   TTargetMethods = record
   public
   type
     TInvalidTargetEvent = procedure(var Target: TSimbaTarget) of object;
+    TInvalidTargetEventArray = array of TInvalidTargetEvent;
   private
     FTargetType: ETargetType;
     FTarget: Pointer;
@@ -61,7 +62,10 @@   TTargetMethods = record
     FMethods: TTargetMethods; // Targets need to provide these. They are filled in SetWindow,SetEIOS etc.
     FCustomClientArea: TBox;
     FAutoSetFocus: Boolean;
-    FInvalidTargetEvents: array of TInvalidTargetEvent;
+    FFrozenDataWidth: Integer;
+    FFrozenBounds: TBox;
+    FInvalidTargetEvents: TInvalidTargetEventArray;
+    FFrozenData: TColorBGRAArray;
 
     procedure ChangeTarget(TargetType: ETargetType);
     function HasMethod(Method: Pointer; Name: String): Boolean;
@@ -118,6 +122,10 @@   TTargetMethods = record
     function GetImageData(var ABounds: TBox; var Data: PColorBGRA; var DataWidth: Integer): Boolean;
     procedure FreeImageData(var Data: PColorBGRA);
 
+    function IsImageFrozen: Boolean; inline;
+    procedure FreezeImage(ABounds: TBox);
+    procedure UnFreezeImage;
+
     function AddOnInvalidTargetEvent(Event: TInvalidTargetEvent): TInvalidTargetEvent;
     procedure RemoveOnInvalidTargetEvent(Event: TInvalidTargetEvent);
 
@@ -555,17 +563,55 @@ function TSimbaTarget.ValidateBounds(var ABounds: TBox): Boolean;
 
 function TSimbaTarget.GetImageData(var ABounds: TBox; var Data: PColorBGRA; var DataWidth: Integer): Boolean;
 begin
+  if IsImageFrozen() then
+  begin
+    Data := @FFrozenData[0];
+    DataWidth := FFrozenDataWidth;
+    ABounds := FFrozenBounds;
+
+    Exit(True);
+  end;
+
   Data := nil;
   if HasMethod(FMethods.GetImageData, 'GetImageData') then
     Result := ValidateBounds(ABounds) and FMethods.GetImageData(FTarget, ABounds.X1, ABounds.Y1, ABounds.Width, ABounds.Height, Data, DataWidth);
 end;
 
 procedure TSimbaTarget.FreeImageData(var Data: PColorBGRA);
 begin
+  if IsImageFrozen() and (Data = @FFrozenData[0]) then
+    Exit;
   if (FTargetType in [ETargetType.WINDOW]) then
     FreeMem(Data);
 end;
 
+function TSimbaTarget.IsImageFrozen: Boolean;
+begin
+  Result := Length(FFrozenData) > 0;
+end;
+
+procedure TSimbaTarget.FreezeImage(ABounds: TBox);
+var
+  Data: PColorBGRA;
+  DataWidth: Integer;
+begin
+  if GetImageData(ABounds, Data, DataWidth) then
+  try
+    FFrozenBounds := ABounds;
+    FFrozenDataWidth := DataWidth;
+
+    SetLength(FFrozenData, DataWidth * ABounds.Height);
+    Move(Data^, FFrozenData[0], Length(FFrozenData) * SizeOf(TColorBGRA));
+  finally
+    FreeImageData(Data);
+  end;
+end;
+
+procedure TSimbaTarget.UnFreezeImage;
+begin
+  FFrozenData := nil;
+end;
+
 function TSimbaTarget.AddOnInvalidTargetEvent(Event: TInvalidTargetEvent): TInvalidTargetEvent;
 begin
   Result := Event;

Tests/targetimagefreeze.simba

@@ -0,0 +1,21 @@
+{$assertions on}
+var
+  img: TImage := TImage.Create(50, 50);
+begin
+  img.Fill(Colors.RED);
+
+  Target.SetImage(img);
+  Target.FreezeImage([5,5,25,25]);
+
+  img.Fill(Colors.GREEN); // draw green, but frozen image is still red
+  Assert(Target.IsImageFrozen());
+  Assert(Finder.CountColor(Colors.GREEN, 0) = 0);
+  Assert(Finder.FindColor(Colors.RED, 0).Bounds.Area = 21*21);
+
+  Target.UnFreezeImage();
+  Assert(not Target.IsImageFrozen());
+  Assert(Finder.CountColor(Colors.GREEN, 0) = (50*50));
+  Assert(Finder.CountColor(Colors.RED, 0) = 0);
+
+  img.Free();
+end.