Update to themed imagebox

Villavu · Feb 14, 2024 · 4d7810b · 4d7810b
1 parent 5b23418
commit 4d7810b
Show file tree

Hide file tree

Showing 30 changed files with 1,845 additions and 2,162 deletions.
diff --git a/Examples/form_imagebox.simba b/Examples/form_imagebox.simba
@@ -0,0 +1,42 @@
+// Simple form example doing random things.
+
+procedure ImgBoxPaint(Sender: TImageBox; Canvas: TImageBoxCanvas; R: TLazRect);
+begin
+  Canvas.DrawCircleFilled(Sender.MousePoint, 5, Colors.YELLOW);
+
+  // if 300,300 is visible in the paint rect
+  if (300 >= R.Left) and (300 >= R.Top) and (300 <= R.Right) and (300 <= R.Bottom) then
+    Canvas.DrawBoxFilled([300,300,350,350], Colors.LIME);
+end;
+
+procedure ImgBoxMouseMove(Sender: TImageBox; Shift: TLazShiftState; X, Y: Integer);
+begin
+  Sender.Repaint();
+end;
+
+var
+  Form: TLazForm;
+
+procedure ShowMyForm;
+var
+  ImgBox: TImageBox;
+begin
+  Form := TLazForm.Create();
+  Form.SetCaption('ImageBox example');
+  Form.SetWidth(700);
+  Form.SetHeight(500);
+  Form.SetPosition(poScreenCenter);
+
+  ImgBox := TImageBox.Create(Form);
+  ImgBox.SetParent(Form);
+  ImgBox.SetAlign(alClient);
+  ImgBox.SetBackgroundFromTarget(Target);
+  ImgBox.SetOnImgPaint(@ImgBoxPaint);
+  ImgBox.SetOnImgMouseMove(@ImgBoxMouseMove);
+
+  Form.ShowModal();
+end;
+
+begin
+  RunInMainThread(@ShowMyForm);
+end.
diff --git a/Source/Simba.lpi b/Source/Simba.lpi
@@ -17,7 +17,7 @@
         <TextDesc Value=""/>
       </XPManifest>
       <Icon Value="0"/>
-      <Resources Count="12">
+      <Resources Count="13">
         <Resource_0 FileName="..\Examples\array.simba" Type="RCDATA" ResourceName="EXAMPLE_ARRAY"/>
         <Resource_1 FileName="..\Examples\function.simba" Type="RCDATA" ResourceName="EXAMPLE_FUNCTION"/>
         <Resource_2 FileName="..\Examples\loop.simba" Type="RCDATA" ResourceName="EXAMPLE_LOOP"/>
@@ -30,14 +30,15 @@
         <Resource_9 FileName="..\Examples\form.simba" Type="RCDATA" ResourceName="EXAMPLE_FORM"/>
         <Resource_10 FileName="..\Examples\irc.simba" Type="RCDATA" ResourceName="EXAMPLE_IRC"/>
         <Resource_11 FileName="..\Examples\image_drawtext.simba" Type="RCDATA" ResourceName="EXAMPLE_DRAWTEXT"/>
+        <Resource_12 FileName="..\Examples\form_imagebox.simba" Type="RCDATA" ResourceName="EXAMPLE_IMAGEBOX"/>
       </Resources>
     </General>
     <VersionInfo>
       <UseVersionInfo Value="True"/>
       <MajorVersionNr Value="2"/>
       <Language Value="0809"/>
       <CharSet Value="04B0"/>
-      <StringTable CompanyName="villavu.com" FileDescription="Simba: http://wizzup.org/simba/" OriginalFilename="Simba.exe" ProductName="Simba" ProductVersion="2.0"/>
+      <StringTable FileDescription="https://github.com/Villavu/Simba" OriginalFilename="Simba.exe" ProductName="Simba" ProductVersion="2.0"/>
     </VersionInfo>
     <BuildModes Count="7">
       <Item1 Name="DEBUG" Default="True"/>
@@ -378,7 +379,7 @@
         <PackageName Value="LCL"/>
       </Item5>
     </RequiredPackages>
-    <Units Count="121">
+    <Units Count="123">
       <Unit0>
         <Filename Value="Simba.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -899,7 +900,7 @@
         <IsPartOfProject Value="True"/>
       </Unit107>
       <Unit108>
-        <Filename Value="imagebox/simba.imagebox_new.pas"/>
+        <Filename Value="imagebox/simba.imagebox.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit108>
       <Unit109>
@@ -950,6 +951,14 @@
         <Filename Value="image/simba.image_stringconv.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit120>
+      <Unit121>
+        <Filename Value="imagebox/simba.imagebox_canvas.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit121>
+      <Unit122>
+        <Filename Value="imagebox/simba.imagebox_drawers.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit122>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

diff --git a/Source/Simba.res b/Source/Simba.res
diff --git a/Source/components/simba.component_statusbar.pas b/Source/components/simba.component_statusbar.pas
@@ -44,6 +44,7 @@   TSimbaStatusBar = class(TCustomControl)
     procedure SetPanelCount(Value: Integer);
   public
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
 
     procedure EraseBackground(DC: HDC); override;
 
@@ -108,6 +109,13 @@ constructor TSimbaStatusBar.Create(AOwner: TComponent);
   CalculateSizes();
 end;
 
+destructor TSimbaStatusBar.Destroy;
+begin
+  Application.RemoveAsyncCalls(Self);
+
+  inherited Destroy();
+end;
+
 procedure TSimbaStatusBar.WMPaint(var Message: TLMPaint);
 begin
   if Assigned(Message.PaintStruct) then

diff --git a/Source/forms/simba.aca.lfm b/Source/forms/simba.aca.lfm
@@ -1,11 +1,11 @@
 object SimbaACAForm: TSimbaACAForm
-  Left = 3178
+  Left = 3110
   Height = 886
-  Top = 375
+  Top = 360
   Width = 1076
   Caption = 'Auto Color Aid'
-  ClientHeight = 886
-  ClientWidth = 1076
+  ClientHeight = 0
+  ClientWidth = 0
   Constraints.MinHeight = 400
   Constraints.MinWidth = 500
   DesignTimePPI = 120
@@ -16,7 +16,7 @@ object SimbaACAForm: TSimbaACAForm
   Position = poScreenCenter
   ShowHint = True
   ShowInTaskBar = stAlways
-  LCLVersion = '3.0.0.2'
+  LCLVersion = '3.0.0.3'
   object PanelMain: TPanel
     Left = 0
     Height = 886

diff --git a/Source/forms/simba.aca.pas b/Source/forms/simba.aca.pas
@@ -12,7 +12,7 @@ interface
 uses
   Classes, SysUtils, Forms, Controls, Dialogs, DividerBevel, Graphics,
   ExtCtrls, ComCtrls, StdCtrls, Menus, ColorBox, LMessages,
-  simba.base, simba.imagebox, simba.imagebox_zoom, simba.imagebox_image,
+  simba.base, simba.imagebox, simba.imagebox_canvas, simba.imagebox_zoom,
   simba.colormath, simba.finder;
 
 type
@@ -84,8 +84,8 @@   TSimbaACAForm = class(TForm)
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure ChangeDrawColor(Sender: TObject);
     procedure ButtonUpdateImageClick(Sender: TObject);
-    procedure ClientImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
-    procedure ClientImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+    procedure ClientImageMouseMove(Sender: TSimbaImageBox; Shift: TShiftState; X, Y: Integer);
+    procedure ClientImageMouseDown(Sender: TSimbaImageBox; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     procedure MenuItemCopyBestColorClick(Sender: TObject);
     procedure MenuItemLoadHSLCircleClick(Sender: TObject);
     procedure MenuItemLoadHSLCircleExClick(Sender: TObject);
@@ -100,7 +100,7 @@   TSimbaACAForm = class(TForm)
     FDrawColor: TColor;
 
     procedure LoadHSLCircle(Radius: Integer);
-    procedure DoPaintArea(Sender: TObject; Bitmap: TSimbaImageBoxBitmap; R: TRect);
+    procedure DoPaintArea(Sender: TSimbaImageBox; ACanvas: TSimbaImageBoxCanvas; R: TRect);
     procedure CalculateBestColor;
 
     function GetBestColorTol: TColorTolerance;
@@ -124,18 +124,18 @@ implementation
   Clipbrd, TypInfo, LCLType,
   simba.windowhandle, simba.image, simba.colormath_aca, simba.matrix_float, simba.dialog;
 
-procedure TSimbaACAForm.ClientImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+procedure TSimbaACAForm.ClientImageMouseMove(Sender: TSimbaImageBox; Shift: TShiftState; X, Y: Integer);
 begin
   FImageZoom.SetTempColor(-1);
-  FImageZoom.MoveTest(FImageBox, X, Y);
+  FImageZoom.Move(FImageBox.Background.Canvas, X, Y);
 
   with FImageBox.Background.Canvas.Pixels[X, Y].ToRGB(), FImageBox.Background.Canvas.Pixels[X, Y].ToHSL() do
     FZoomInfo.Caption := Format('Color: %d', [FImageBox.Background.Canvas.Pixels[X, Y]]) + LineEnding +
                          Format('RGB: %d, %d, %d', [R, G, B])                            + LineEnding +
                          Format('HSL: %.2f, %.2f, %.2f', [H, S, L])                      + LineEnding;
 end;
 
-procedure TSimbaACAForm.ClientImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+procedure TSimbaACAForm.ClientImageMouseDown(Sender: TSimbaImageBox; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 var
   Pixel: Integer;
 begin
@@ -188,13 +188,13 @@ procedure TSimbaACAForm.LoadHSLCircle(Radius: Integer);
   Bitmap.Free();
 end;
 
-procedure TSimbaACAForm.DoPaintArea(Sender: TObject; Bitmap: TSimbaImageBoxBitmap; R: TRect);
+procedure TSimbaACAForm.DoPaintArea(Sender: TSimbaImageBox; ACanvas: TSimbaImageBoxCanvas; R: TRect);
 begin
   if (Length(FDebugTPA) > 0) then
-    Bitmap.DrawPoints(FDebugTPA, FDrawColor)
+    ACanvas.DrawPoints(FDebugTPA, FDrawColor)
   else
   if (Length(FDebugMat) > 0) then
-    Bitmap.DrawHeatmap(FDebugMat);
+    ACanvas.DrawHeatmap(FDebugMat);
 end;
 
 procedure TSimbaACAForm.ChangeDrawColor(Sender: TObject);
@@ -380,7 +380,7 @@ procedure TSimbaACAForm.ButtonMatchColorClick(Sender: TObject);
     FDebugTPA := [];
     FDebugMat := FImageBox.MatchColor(Color, ColorSpace, Multipliers).NormMinMax(0, 1);
 
-    FImageBox.Paint();
+    FImageBox.Repaint();
   end;
 end;
 
@@ -391,8 +391,8 @@ procedure TSimbaACAForm.ButtonFindColorClick(Sender: TObject);
     FDebugMat := [];
     FDebugTPA := FImageBox.FindColor(Color, Tolerance, ColorSpace, Multipliers);
 
-    FImageBox.StatusPanel.Text := Format('Found %.0n matches', [Double(Length(FDebugTPA))]);
-    FImageBox.Paint();
+    FImageBox.Status := Format('Found %.0n matches', [Double(Length(FDebugTPA))]);
+    FImageBox.RePaint();
   end;
 end;
 
@@ -446,7 +446,7 @@ procedure TSimbaACAForm.DoButtonClearImageClick(Sender: TObject);
   FDebugTPA := [];
   FDebugMat := [];
 
-  FImageBox.Paint();
+  FImageBox.RePaint();
 end;
 
 constructor TSimbaACAForm.Create(Window: TWindowHandle);
@@ -464,9 +464,9 @@ constructor TSimbaACAForm.Create(Window: TWindowHandle);
   FImageBox := TSimbaImageBox.Create(Self);
   FImageBox.Parent := PanelMain;
   FImageBox.Align := alClient;
-  FImageBox.OnMouseDown := @ClientImageMouseDown;
-  FImageBox.OnMouseMove := @ClientImageMouseMove;
-  FImageBox.OnPaintArea := @DoPaintArea;
+  FImageBox.OnImgMouseDown := @ClientImageMouseDown;
+  FImageBox.OnImgMouseMove := @ClientImageMouseMove;
+  FImageBox.OnImgPaint := @DoPaintArea;
   FImageBox.SetBackgroundFromWindow(FWindow);
 
   FImageZoom := TSimbaImageBoxZoom.Create(Self);

diff --git a/Source/forms/simba.debugimageform.pas b/Source/forms/simba.debugimageform.pas
@@ -11,23 +11,23 @@ interface
 
 uses
   classes, sysutils, forms, controls,
-  simba.imagebox_new;
+  simba.imagebox;
 
 type
   TSimbaDebugImageForm = class(TForm)
     procedure FormCreate(Sender: TObject);
   protected
-    FImageBox: TSimbaImageBoxNew;
+    FImageBox: TSimbaImageBox;
     FMaxWidth, FMaxHeight: Integer;
 
-    procedure DoDoubleClick(Sender: TObject);
+    procedure DoImgDoubleClick(Sender: TSimbaImageBox; X, Y: Integer);
   public
     procedure Close;
 
     procedure SetMaxSize(AWidth, AHeight: Integer);
     procedure SetSize(AWidth, AHeight: Integer; AForce: Boolean; AEnsureVisible: Boolean = True);
 
-    property ImageBox: TSimbaImageBoxNew read FImageBox;
+    property ImageBox: TSimbaImageBox read FImageBox;
   end;
 
 var
@@ -56,16 +56,15 @@ procedure TSimbaDebugImageForm.FormCreate(Sender: TObject);
   FMaxWidth := 1500;
   FMaxHeight := 1000;
 
-  FImageBox := TSimbaImageBoxNew.Create(Self);
+  FImageBox := TSimbaImageBox.Create(Self);
   FImageBox.Parent := Self;
   FImageBox.Align := alClient;
-  FImageBox.OnDblClick := @DoDoubleCLick;
+  FImageBox.OnImgDoubleClick := @DoImgDoubleClick;
 end;
 
-procedure TSimbaDebugImageForm.DoDoubleClick(Sender: TObject);
+procedure TSimbaDebugImageForm.DoImgDoubleClick(Sender: TSimbaImageBox; X, Y: Integer);
 begin
-  with TSimbaImageBoxNew(Sender).MousePoint do
-    DebugLn([EDebugLn.FOCUS], 'Debug Image Click: (%d, %d)', [X, Y]);
+  DebugLn([EDebugLn.FOCUS], 'Debug Image Click: (%d, %d)', [X, Y]);
 end;
 
 procedure TSimbaDebugImageForm.SetSize(AWidth, AHeight: Integer; AForce: Boolean; AEnsureVisible: Boolean);