dev

Villavu · Feb 13, 2024 · 0649632 · 0649632
1 parent 750c1b3
commit 0649632
Show file tree

Hide file tree

Showing 5 changed files with 253 additions and 134 deletions.
diff --git a/Source/imagebox/simba.imagebox.pas b/Source/imagebox/simba.imagebox.pas
@@ -13,7 +13,7 @@ interface
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
   ATScrollBar, LCLType, LMessages,
   simba.base, simba.component_statusbar, simba.image_lazbridge, simba.imagebox_canvas,
-  simba.image, simba.dtm, simba.colormath, simba.finder;
+  simba.image, simba.dtm, simba.colormath, simba.finder, simba.target;
 
 const
   ZOOM_LEVELS: TIntegerArray = (
@@ -151,6 +151,8 @@   TSimbaImageBox = class(TCustomControl)
     procedure SetBackground(Img: TSimbaImage);
     procedure SetBackgroundFromFile(FileName: String);
     procedure SetBackgroundFromWindow(Window: TWindowHandle);
+    procedure SetBackgroundFromTarget(Target: TSimbaTarget; Bounds: TBox); overload;
+    procedure SetBackgroundFromTarget(Target: TSimbaTarget); overload;
 
     property StatusBar: TSimbaStatusBar read FStatusBar;
     property Status: String read GetStatus write SetStatus;
@@ -533,11 +535,6 @@   PixelRGBA = record R,G,B,A: Byte; end;
   ScreenRect.Right := ScreenRect.Left + ClientWidth;
   ScreenRect.Bottom := ScreenRect.Top + ClientHeight;
 
-  //ScreenRect.Left   := FHorzScroll.Position;
-  //ScreenRect.Top    := FVertScroll.Position;
-  //ScreenRect.Right  := ((FHorzScroll.Position + ClientWidth) - FVertScroll.Width) + FZoomPixels;
-  //ScreenRect.Bottom := ((FVertScroll.Position + ClientHeight) - FHorzScroll.Height) + FZoomPixels;
-
   if (FZoomLevel = 100) then
     LocalRect := ScreenRect
   else
@@ -558,9 +555,7 @@   PixelRGBA = record R,G,B,A: Byte; end;
 
   FCanvas.BeginUpdate(
     LocalRect,
-    LocalRect.Width, LocalRect.Height,
-    FZoomPixels,
-    FZoomLevel
+    LocalRect.Width, LocalRect.Height
   );
 
   RenderNoZoom(background, LocalRect.Left, LocalRect.Top, LocalRect.Width, LocalRect.Height, FCanvas.Bitmap);
@@ -597,7 +592,7 @@   PixelRGBA = record R,G,B,A: Byte; end;
 procedure TSimbaImageScrollBox.Resize;
 begin
   inherited Resize();
-  //WRiteln('resize');
+
   UpdateScrollBars();
 end;
 
@@ -856,6 +851,30 @@ procedure TSimbaImageBox.SetBackgroundFromWindow(Window: TWindowHandle);
   end;
 end;
 
+procedure TSimbaImageBox.SetBackgroundFromTarget(Target: TSimbaTarget; Bounds: TBox);
+var
+  Image: TSimbaImage;
+begin
+  Image := Target.GetImage(Bounds);
+  try
+    SetBackground(Image);
+  finally
+    Image.Free();
+  end;
+end;
+
+procedure TSimbaImageBox.SetBackgroundFromTarget(Target: TSimbaTarget);
+var
+  Image: TSimbaImage;
+begin
+  Image := Target.GetImage(TBox.Create(-1,-1,-1,-1));
+  try
+    SetBackground(Image);
+  finally
+    Image.Free();
+  end;
+end;
+
 procedure TSimbaImageBox.Paint;
 begin
   FImageScrollBox.Invalidate();

diff --git a/Source/imagebox/simba.imagebox_canvas.pas b/Source/imagebox/simba.imagebox_canvas.pas
@@ -31,7 +31,7 @@   TSimbaImageBoxCanvas = class
     constructor Create;
     destructor Destroy; override;
 
-    procedure BeginUpdate(Rect: TRect; Width, Height, PixelSize, ZoomLevel: Integer);
+    procedure BeginUpdate(Rect: TRect; Width, Height: Integer);
     procedure EndUpdate;
 
     procedure DrawLine(Start, Stop: TPoint; Color: TColor);
@@ -48,7 +48,12 @@   TSimbaImageBoxCanvas = class
     procedure DrawCircleFilled(Center: TPoint; Radius: Integer; Color: TColor);
 
     procedure DrawPoly(Poly: TPointArray; Connect: Boolean; Color: TColor);
+    procedure DrawPolyFilled(Poly: TPointArray; Color: TColor);
 
+    procedure DrawQuad(Quad: TQuad; Connect: Boolean; Color: TColor);
+    procedure DrawQuadFilled(Quad: TQuad; Connect: Boolean; Color: TColor);
+
+    procedure DrawPoint(Point: TPoint; Color: TColor);
     procedure DrawPoints(TPA: TPointArray; Color: TColor);
 
     procedure DrawHeatmap(Mat: TSingleMatrix);
@@ -92,7 +97,7 @@ destructor TSimbaImageBoxCanvas.Destroy;
   inherited Destroy();
 end;
 
-procedure TSimbaImageBoxCanvas.BeginUpdate(Rect: TRect; Width, Height, PixelSize, ZoomLevel: Integer);
+procedure TSimbaImageBoxCanvas.BeginUpdate(Rect: TRect; Width, Height: Integer);
 begin
   FBitmap.BeginUpdate();
   if (FBitmap.Width < Width) or (FBitmap.Height < Height) then
@@ -236,6 +241,33 @@ procedure TSimbaImageBoxCanvas.DrawPoly(Poly: TPointArray; Connect: Boolean; Col
     DrawLine(Poly[High(Poly)], Poly[0], Color);
 end;
 
+procedure TSimbaImageBoxCanvas.DrawPolyFilled(Poly: TPointArray; Color: TColor);
+begin
+  case FPixelFormat of
+    ELazPixelFormat.BGR:  specialize DoDrawPolygonFilled<TColorBGR>(Poly, GetDrawInfo(Color));
+    ELazPixelFormat.BGRA: specialize DoDrawPolygonFilled<TColorBGRA>(Poly, GetDrawInfo(Color));
+    ELazPixelFormat.ARGB: specialize DoDrawPolygonFilled<TColorARGB>(Poly, GetDrawInfo(Color));
+  end;
+end;
+
+procedure TSimbaImageBoxCanvas.DrawQuad(Quad: TQuad; Connect: Boolean; Color: TColor);
+begin
+  DrawLine(Quad.Top, Quad.Right, Color);
+  DrawLine(Quad.Right, Quad.Bottom, Color);
+  DrawLine(Quad.Bottom, Quad.Left, Color);
+  DrawLine(Quad.Left, Quad.Top, Color);
+end;
+
+procedure TSimbaImageBoxCanvas.DrawQuadFilled(Quad: TQuad; Connect: Boolean; Color: TColor);
+begin
+  DrawPolyFilled([Quad.Top, Quad.Right, Quad.Bottom, Quad.Left], Color);
+end;
+
+procedure TSimbaImageBoxCanvas.DrawPoint(Point: TPoint; Color: TColor);
+begin
+  DrawPoints([Point], Color);
+end;
+
 procedure TSimbaImageBoxCanvas.DrawPoints(TPA: TPointArray; Color: TColor);
 begin
   case FPixelFormat of

diff --git a/Source/imagebox/simba.imagebox_drawers.pas b/Source/imagebox/simba.imagebox_drawers.pas
@@ -50,12 +50,54 @@   TDrawInfo = record
 generic procedure DoDrawCircle<_T>(Center: TPoint; Radius: Integer; DrawInfo: TDrawInfo);
 generic procedure DoDrawCircleFilled<_T>(Center: TPoint; Radius: Integer; DrawInfo: TDrawInfo);
 generic procedure DoDrawHeatmap<_T>(Mat: TSingleMatrix; DrawInfo: TDrawInfo);
+generic procedure DoDrawPolygonFilled<_T>(Poly: TPointArray; DrawInfo: TDrawInfo);
 
 implementation
 
 uses
   Math,
-  simba.matrix_float, simba.box;
+  simba.matrix_float, simba.array_point, simba.box, simba.algo_sort;
+
+generic procedure DoDrawPolygonFilled<_T>(Poly: TPointArray; DrawInfo: TDrawInfo);
+type
+  PType = ^_T;
+var
+  Color: _T;
+
+  procedure _Row(Y: Integer; X1, X2: Integer);
+  var
+    Ptr: PByte;
+    Upper: PtrUInt;
+  begin
+    if (Y >= 0) and (Y < DrawInfo.Height) then
+    begin
+      X1 := EnsureRange(X1, 0, DrawInfo.Width - 1);
+      X2 := EnsureRange(X2, 0, DrawInfo.Width - 1);
+
+      if ((X2 - X1) + 1 > 0) then
+      begin
+        Ptr := DrawInfo.Data + (Y * DrawInfo.BytesPerLine + X1 * SizeOf(_T));
+        Upper := PtrUInt(Ptr) + ((X2 - X1) * SizeOf(_T));
+        while (PtrUInt(Ptr) <= Upper) do
+        begin
+          PType(Ptr)^ := Color;
+
+          Inc(Ptr, SizeOf(_T));
+        end;
+      end;
+    end;
+  end;
+
+  {$i shapebuilder_polygonfilled.inc}
+
+begin
+  Color := Default(_T);
+  Color.R := DrawInfo.Color.R;
+  Color.G := DrawInfo.Color.G;
+  Color.B := DrawInfo.Color.B;
+
+  _BuildPolygonFilled(Poly, TRect.Create(0, 0, DrawInfo.Width-1, DrawInfo.Height-1));
+end;
 
 generic procedure DoDrawPoints<_T>(TPA: TPointArray; DrawInfo: TDrawInfo);
 type