From 0649632a3ed1f47157551472a50b91faad486a79 Mon Sep 17 00:00:00 2001 From: Olly Date: Tue, 13 Feb 2024 02:15:37 +0000 Subject: [PATCH] dev --- Source/imagebox/simba.imagebox.pas | 39 ++- Source/imagebox/simba.imagebox_canvas.pas | 36 ++- Source/imagebox/simba.imagebox_drawers.pas | 44 ++- .../script/imports/simba.import_imagebox.pas | 250 ++++++++++-------- .../shapebuilder_polygonfilled.inc | 18 +- 5 files changed, 253 insertions(+), 134 deletions(-) diff --git a/Source/imagebox/simba.imagebox.pas b/Source/imagebox/simba.imagebox.pas index 2a4077237..e428d2b25 100644 --- 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 index 9bdc0d6d5..274f01d51 100644 --- 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(Poly, GetDrawInfo(Color)); + ELazPixelFormat.BGRA: specialize DoDrawPolygonFilled(Poly, GetDrawInfo(Color)); + ELazPixelFormat.ARGB: specialize DoDrawPolygonFilled(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 index abe45178a..8cf7fca2a 100644 --- 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 diff --git a/Source/script/imports/simba.import_imagebox.pas b/Source/script/imports/simba.import_imagebox.pas index 2c15c2967..d7e8b706b 100644 --- a/Source/script/imports/simba.import_imagebox.pas +++ b/Source/script/imports/simba.import_imagebox.pas @@ -96,51 +96,21 @@ implementation //begin // PSimbaImageBoxBitmap(Params^[0])^.DrawHeatmap(PSingleMatrix(Params^[1])^); //end; -// -//procedure _LapeSimbaImageBox_Zoom_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -//begin -// PSingle(Result)^ := PSimbaImageBox(Params^[0])^.Zoom; -//end; -// -//procedure _LapeSimbaImageBox_Zoom_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -//begin -// PSimbaImageBox(Params^[0])^.Zoom := PSingle(Params^[1])^; -//end; -// -//procedure _LapeSimbaImageBox_StatusBar_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -//begin -// PStatusBar(Result)^ := PSimbaImageBox(Params^[0])^.StatusBar; -//end; -// -//procedure _LapeSimbaImageBox_StatusPanel_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -//begin -// PStatusPanel(Result)^ := PSimbaImageBox(Params^[0])^.StatusPanel; -//end; -// -//procedure _LapeSimbaImageBox_OnPaintArea_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -//begin -// PSimbaImageBoxPaintAreaEvent(Result)^ := PSimbaImageBox(Params^[0])^.OnPaintArea; -//end; -//procedure _LapeSimbaImageBox_OnPaintArea_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -//begin -// PSimbaImageBox(Params^[0])^.OnPaintArea := PSimbaImageBoxPaintAreaEvent(Params^[1])^; -//end; -// -//procedure _LapeSimbaImageBox_FindDTM(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -//begin -// PPointArray(Result)^ := PSimbaImageBox(Params^[0])^.FindDTM(PDTM(Params^[1])^); -//end; -// -//procedure _LapeSimbaImageBox_FindColor(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -//begin -// PPointArray(Result)^ := PSimbaImageBox(Params^[0])^.FindColor(PColor(Params^[1])^, PSingle(Params^[2])^, PColorSpace(Params^[3])^, PChannelMultipliers(Params^[4])^); -//end; -// -//procedure _LapeSimbaImageBox_MatchColor(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -//begin -// PSingleMatrix(Result)^ := PSimbaImageBox(Params^[0])^.MatchColor(PColor(Params^[1])^, PColorSpace(Params^[2])^, PChannelMultipliers(Params^[3])^); -//end; +procedure _LapeSimbaImageBox_FindDTM(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PPointArray(Result)^ := PSimbaImageBox(Params^[0])^.FindDTM(PDTM(Params^[1])^); +end; + +procedure _LapeSimbaImageBox_FindColor(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PPointArray(Result)^ := PSimbaImageBox(Params^[0])^.FindColor(PColor(Params^[1])^, PSingle(Params^[2])^, PColorSpace(Params^[3])^, PChannelMultipliers(Params^[4])^); +end; + +procedure _LapeSimbaImageBox_MatchColor(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PSingleMatrix(Result)^ := PSimbaImageBox(Params^[0])^.MatchColor(PColor(Params^[1])^, PColorSpace(Params^[2])^, PChannelMultipliers(Params^[3])^); +end; procedure _LapeSimbaImageBox_MoveTo(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin @@ -162,6 +132,11 @@ procedure _LapeSimbaImageBox_MouseY(const Params: PParamArray; const Result: Poi PInteger(Result)^ := PSimbaImageBox(Params^[0])^.MouseY; end; +procedure _LapeSimbaImageBox_MousePoint(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PPoint(Result)^ := PSimbaImageBox(Params^[0])^.MousePoint; +end; + procedure _LapeSimbaImageBox_SetBackground(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin PSimbaImageBox(Params^[0])^.SetBackground(PSimbaImage(Params^[1])^); @@ -172,20 +147,20 @@ procedure _LapeSimbaImageBox_SetBackgroundFromFile(const Params: PParamArray); L PSimbaImageBox(Params^[0])^.SetBackgroundFromFile(PString(Params^[1])^); end; -//procedure _LapeSimbaImageBox_SetBackgroundFromWindow(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -//begin -// PSimbaImageBox(Params^[0])^.SetBackgroundFromWindow(PWindowHandle(Params^[1])^); -//end; -// -//procedure _LapeSimbaImageBox_SetBackgroundFromTarget1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -//begin -// PSimbaImageBox(Params^[0])^.SetBackgroundFromTarget(PSimbaTarget(Params^[1])^, PBox(Params^[2])^); -//end; -// -//procedure _LapeSimbaImageBox_SetBackgroundFromTarget2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -//begin -// PSimbaImageBox(Params^[0])^.SetBackgroundFromTarget(PSimbaTarget(Params^[1])^); -//end; +procedure _LapeSimbaImageBox_SetBackgroundFromWindow(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.SetBackgroundFromWindow(PWindowHandle(Params^[1])^); +end; + +procedure _LapeSimbaImageBox_SetBackgroundFromTarget1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.SetBackgroundFromTarget(PSimbaTarget(Params^[1])^, PBox(Params^[2])^); +end; + +procedure _LapeSimbaImageBox_SetBackgroundFromTarget2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.SetBackgroundFromTarget(PSimbaTarget(Params^[1])^); +end; procedure _LapeSimbaImageBox_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin @@ -202,84 +177,127 @@ procedure _LapeSimbaImageBox_Cursor_Write(const Params: PParamArray; const Resul PSimbaImageBox(Params^[0])^.Cursor := PCursor(Params^[1])^; end; -{ -procedure _LapeSimbaImageBox_OnMouseMove_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_Status_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PMouseMoveEvent(Result)^ := PSimbaImageBox(Params^[0])^.OnMouseMove; + PString(Result)^ := PSimbaImageBox(Params^[0])^.Status; end; -procedure _LapeSimbaImageBox_OnMouseMove_Write(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_Status_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImageBox(Params^[0])^.OnMouseMove := PMouseMoveEvent(Params^[1])^; + PSimbaImageBox(Params^[0])^.Status := PString(Params^[1])^; end; -procedure _LapeSimbaImageBox_OnMouseDown_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_Background_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PMouseEvent(Result)^ := PSimbaImageBox(Params^[0])^.OnMouseDown; + PBitmap(Result)^ := PSimbaImageBox(Params^[0])^.Background; end; -procedure _LapeSimbaImageBox_OnMouseDown_Write(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgPaint_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImageBox(Params^[0])^.OnMouseDown := PMouseEvent(Params^[1])^; + TImageBoxPaintEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgPaint; end; -procedure _LapeSimbaImageBox_OnMouseUp_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgPaint_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PMouseEvent(Result)^ := PSimbaImageBox(Params^[0])^.OnMouseUp; + PSimbaImageBox(Params^[0])^.OnImgPaint := TImageBoxPaintEvent(Params^[1]^); end; -procedure _LapeSimbaImageBox_OnMouseUp_Write(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseEnter_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImageBox(Params^[0])^.OnMouseUp := PMouseEvent(Params^[1])^; + TImageBoxEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgMouseEnter; end; -procedure _LapeSimbaImageBox_OnMouseEnter_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseEnter_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PNotifyEvent(Result)^ := PSimbaImageBox(Params^[0])^.OnMouseEnter; + PSimbaImageBox(Params^[0])^.OnImgMouseEnter := TImageBoxEvent(Params^[1]^); end; -procedure _LapeSimbaImageBox_OnMouseEnter_Write(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseLeave_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImageBox(Params^[0])^.OnMouseEnter := PNotifyEvent(Params^[1])^; + TImageBoxEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgMouseLeave; end; -procedure _LapeSimbaImageBox_OnMouseLeave_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseLeave_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PNotifyEvent(Result)^ := PSimbaImageBox(Params^[0])^.OnMouseLeave; + PSimbaImageBox(Params^[0])^.OnImgMouseLeave := TImageBoxEvent(Params^[1]^); end; -procedure _LapeSimbaImageBox_OnMouseLeave_Write(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseDown_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImageBox(Params^[0])^.OnMouseLeave := PNotifyEvent(Params^[1])^; + TImageBoxMouseEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgMouseDown; end; -procedure _LapeSimbaImageBox_OnDblClick_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseDown_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PNotifyEvent(Result)^ := PSimbaImageBox(Params^[0])^.OnDblClick; + PSimbaImageBox(Params^[0])^.OnImgMouseDown := TImageBoxMouseEvent(Params^[1]^); end; -procedure _LapeSimbaImageBox_OnDblClick_Write(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseUp_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImageBox(Params^[0])^.OnDblClick := PNotifyEvent(Params^[1])^; + TImageBoxMouseEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgMouseUp; end; -procedure _LapeSimbaImageBox_MousePoint_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseUp_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PPoint(Result)^ := PSimbaImageBox(Params^[0])^.MousePoint; + PSimbaImageBox(Params^[0])^.OnImgMouseUp := TImageBoxMouseEvent(Params^[1]^); end; -} -procedure _LapeSimbaImageBox_Background_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSimbaImageBox_OnImgMouseMove_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBitmap(Result)^ := PSimbaImageBox(Params^[0])^.Background; + TImageBoxMouseMoveEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgMouseMove; +end; + +procedure _LapeSimbaImageBox_OnImgMouseMove_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.OnImgMouseMove := TImageBoxMouseMoveEvent(Params^[1]^); +end; + +procedure _LapeSimbaImageBox_OnImgClick_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + TImageBoxClickEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgClick; +end; + +procedure _LapeSimbaImageBox_OnImgClick_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.OnImgClick := TImageBoxClickEvent(Params^[1]^); +end; + +procedure _LapeSimbaImageBox_OnImgDoubleClick_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + TImageBoxClickEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgDoubleClick; +end; + +procedure _LapeSimbaImageBox_OnImgDoubleClick_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.OnImgDoubleClick := TImageBoxClickEvent(Params^[1]^); +end; + +procedure _LapeSimbaImageBox_OnImgKeyDown_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + TImageBoxKeyEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgKeyDown; +end; + +procedure _LapeSimbaImageBox_OnImgKeyDown_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.OnImgKeyDown := TImageBoxKeyEvent(Params^[1]^); +end; + +procedure _LapeSimbaImageBox_OnImgKeyUp_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + TImageBoxKeyEvent(Result^) := PSimbaImageBox(Params^[0])^.OnImgKeyUp; +end; + +procedure _LapeSimbaImageBox_OnImgKeyUp_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageBox(Params^[0])^.OnImgKeyUp := TImageBoxKeyEvent(Params^[1]^); end; procedure ImportSimbaImageBox(Compiler: TSimbaScript_Compiler); begin with Compiler do begin - //addClass('TImageBoxImage'); - // + addClass('TSimbaImageBoxCanvas'); + //addGlobalFunc('procedure TImageBoxImage.DrawLineGap(Start, Stop: TPoint; Gap: Integer; Color: TColor);', @_LapeSimbaImageBoxBitmap_DrawLineGap); //addGlobalFunc('procedure TImageBoxImage.DrawLine(Start, Stop: TPoint; Color: TColor);', @_LapeSimbaImageBoxBitmap_DrawLine); //addGlobalFunc('procedure TImageBoxImage.DrawCross(Center: TPoint; Radius: Integer; Color: TColor);', @_LapeSimbaImageBoxBitmap_DrawCross); @@ -295,37 +313,45 @@ procedure ImportSimbaImageBox(Compiler: TSimbaScript_Compiler); //addGlobalFunc('procedure TImageBoxImage.DrawBoxTransparent(Box: TBox; Color: TColor; Transparency: Single);', @_LapeSimbaImageBoxBitmap_DrawBoxTransparent); //addGlobalFunc('procedure TImageBoxImage.DrawHeatmap(const Mat: TSingleMatrix);', @_LapeSimbaImageBoxBitmap_DrawHeatmap); - //addGlobalType('procedure(Sender: TObject; Bitmap: TImageBoxImage; Rect: TLazRect) of object', 'TImageBoxPaintAreaEvent', FFI_DEFAULT_ABI); - - addClass('TImageBox', 'TLazWinControl'); - - //addClassVar('TImageBox', 'MousePoint', 'TPoint', @_LapeSimbaImageBox_MousePoint_Read); + addClass('TImageBox', 'TLazCustomControl'); + + addGlobalType('procedure(Sender: TImageBox; Canvas: TSimbaImageBoxCanvas; R: TLazRect) of object;', 'TImageBoxPaintEvent'); + addGlobalType('procedure(Sender: TImageBox) of object;', 'TImageBoxEvent'); + addGlobalType('procedure(Sender: TImageBox; X, Y: Integer) of object;', 'TImageBoxClickEvent'); + addGlobalType('procedure(Sender: TImageBox; var Key: UInt16; Shift: TLazShiftState) of object;', 'TImageBoxKeyEvent'); + addGlobalType('procedure(Sender: TImageBox; Button: TLazMouseButton; Shift: TLazShiftState; X, Y: Integer) of object;', 'TImageBoxMouseEvent'); + addGlobalType('procedure(Sender: TImageBox; Shift: TLazShiftState; X, Y: Integer) of object;', 'TImageBoxMouseMoveEvent'); + + addClassVar('TImageBox', 'OnImgPaint', 'TImageBoxPaintEvent', @_LapeSimbaImageBox_OnImgPaint_Read, @_LapeSimbaImageBox_OnImgPaint_Write); + addClassVar('TImageBox', 'OnImgMouseEnter', 'TImageBoxEvent', @_LapeSimbaImageBox_OnImgMouseEnter_Read, @_LapeSimbaImageBox_OnImgMouseEnter_Write); + addClassVar('TImageBox', 'OnImgMouseLeave', 'TImageBoxEvent', @_LapeSimbaImageBox_OnImgMouseLeave_Read, @_LapeSimbaImageBox_OnImgMouseLeave_Write); + addClassVar('TImageBox', 'OnImgMouseDown', 'TImageBoxMouseEvent', @_LapeSimbaImageBox_OnImgMouseDown_Read, @_LapeSimbaImageBox_OnImgMouseDown_Write); + addClassVar('TImageBox', 'OnImgMouseUp', 'TImageBoxMouseEvent', @_LapeSimbaImageBox_OnImgMouseUp_Read, @_LapeSimbaImageBox_OnImgMouseUp_Write); + addClassVar('TImageBox', 'OnImgMouseMove', 'TImageBoxMouseMoveEvent', @_LapeSimbaImageBox_OnImgMouseMove_Read, @_LapeSimbaImageBox_OnImgMouseMove_Write); + addClassVar('TImageBox', 'OnImgClick', 'TImageBoxClickEvent', @_LapeSimbaImageBox_OnImgClick_Read, @_LapeSimbaImageBox_OnImgClick_Write); + addClassVar('TImageBox', 'OnImgDoubleClick', 'TImageBoxClickEvent', @_LapeSimbaImageBox_OnImgDoubleClick_Read, @_LapeSimbaImageBox_OnImgDoubleClick_Write); + addClassVar('TImageBox', 'OnImgKeyDown', 'TImageBoxKeyEvent', @_LapeSimbaImageBox_OnImgKeyDown_Read, @_LapeSimbaImageBox_OnImgKeyDown_Write); + addClassVar('TImageBox', 'OnImgKeyUp', 'TImageBoxKeyEvent', @_LapeSimbaImageBox_OnImgKeyUp_Read, @_LapeSimbaImageBox_OnImgKeyUp_Write); + + addClassVar('TImageBox', 'Cursor', 'TLazCursor', @_LapeSimbaImageBox_Cursor_Read, @_LapeSimbaImageBox_Cursor_Write); + addClassVar('TImageBox', 'Status', 'String', @_LapeSimbaImageBox_Status_Read, @_LapeSimbaImageBox_Status_Write); addClassVar('TImageBox', 'Background', 'TLazBitmap', @_LapeSimbaImageBox_Background_Read); - //addClassVar('TImageBox', 'Zoom', 'Single', @_LapeSimbaImageBox_Zoom_Read, @_LapeSimbaImageBox_Zoom_Write); - //addClassVar('TImageBox', 'StatusBar', 'TLazStatusBar', @_LapeSimbaImageBox_StatusBar_Read); - //addClassVar('TImageBox', 'StatusPanel', 'TLazStatusPanel', @_LapeSimbaImageBox_StatusPanel_Read); - //addClassVar('TImageBox', 'OnMouseMove', 'TLazMouseMoveEvent', @_LapeSimbaImageBox_OnMouseMove_Read, @_LapeSimbaImageBox_OnMouseMove_Write); - //addClassVar('TImageBox', 'OnMouseDown', 'TLazMouseEvent', @_LapeSimbaImageBox_OnMouseDown_Read, @_LapeSimbaImageBox_OnMouseDown_Write); - //addClassVar('TImageBox', 'OnMouseUp', 'TLazMouseEvent', @_LapeSimbaImageBox_OnMouseUp_Read, @_LapeSimbaImageBox_OnMouseUp_Write); - //addClassVar('TImageBox', 'OnMouseLeave', 'TLazNotifyEvent', @_LapeSimbaImageBox_OnMouseLeave_Read, @_LapeSimbaImageBox_OnMouseLeave_Write); - //addClassVar('TImageBox', 'OnMouseEnter', 'TLazNotifyEvent', @_LapeSimbaImageBox_OnMouseEnter_Read, @_LapeSimbaImageBox_OnMouseEnter_Write); - //addClassVar('TImageBox', 'OnDblClick', 'TLazNotifyEvent', @_LapeSimbaImageBox_OnDblClick_Read, @_LapeSimbaImageBox_OnDblClick_Write); - //addClassVar('TImageBox', 'OnPaintArea', 'TImageBoxPaintAreaEvent', @_LapeSimbaImageBox_OnPaintArea_Read, @_LapeSimbaImageBox_OnPaintArea_Write); - - //addGlobalFunc('function TImageBox.FindDTM(DTM: TDTM): TPointArray', @_LapeSimbaImageBox_FindDTM); - //addGlobalFunc('function TImageBox.FindColor(Col: TColor; Tol: Single; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers): TPointArray', @_LapeSimbaImageBox_FindColor); - //addGlobalFunc('function TImageBox.MatchColor(Col: TColor; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers): TSingleMatrix', @_LapeSimbaImageBox_MatchColor); + + addGlobalFunc('function TImageBox.FindDTM(DTM: TDTM): TPointArray', @_LapeSimbaImageBox_FindDTM); + addGlobalFunc('function TImageBox.FindColor(Col: TColor; Tol: Single; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers): TPointArray', @_LapeSimbaImageBox_FindColor); + addGlobalFunc('function TImageBox.MatchColor(Col: TColor; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers): TSingleMatrix', @_LapeSimbaImageBox_MatchColor); addGlobalFunc('procedure TImageBox.MoveTo(ImageXY: TPoint);', @_LapeSimbaImageBox_MoveTo); addGlobalFunc('function TImageBox.IsPointVisible(ImageXY: TPoint): Boolean;', @_LapeSimbaImageBox_IsPointVisible); addGlobalFunc('function TImageBox.MouseX: Integer;', @_LapeSimbaImageBox_MouseX); addGlobalFunc('function TImageBox.MouseY: Integer;', @_LapeSimbaImageBox_MouseY); + addGlobalFunc('function TImageBox.MousePoint: TPoint;', @_LapeSimbaImageBox_MousePoint); addGlobalFunc('procedure TImageBox.SetBackground(Image: TImage)', @_LapeSimbaImageBox_SetBackground); addGlobalFunc('procedure TImageBox.SetBackgroundFromFile(FileName: String)', @_LapeSimbaImageBox_SetBackgroundFromFile); - //addGlobalFunc('procedure TImageBox.SetBackgroundFromWindow(Window: TWindowHandle)', @_LapeSimbaImageBox_SetBackgroundFromWindow); - //addGlobalFunc('procedure TImageBox.SetBackgroundFromTarget(Target: TTarget; Bounds: TBox); overload', @_LapeSimbaImageBox_SetBackgroundFromTarget1); - //addGlobalFunc('procedure TImageBox.SetBackgroundFromTarget(Target: TTarget); overload', @_LapeSimbaImageBox_SetBackgroundFromTarget2); + addGlobalFunc('procedure TImageBox.SetBackgroundFromWindow(Window: TWindowHandle)', @_LapeSimbaImageBox_SetBackgroundFromWindow); + addGlobalFunc('procedure TImageBox.SetBackgroundFromTarget(Target: TTarget; Bounds: TBox); overload', @_LapeSimbaImageBox_SetBackgroundFromTarget1); + addGlobalFunc('procedure TImageBox.SetBackgroundFromTarget(Target: TTarget); overload', @_LapeSimbaImageBox_SetBackgroundFromTarget2); addClassConstructor('TImageBox', '(Owner: TLazComponent)', @_LapeSimbaImageBox_Create); end; diff --git a/Source/shapebuilders/shapebuilder_polygonfilled.inc b/Source/shapebuilders/shapebuilder_polygonfilled.inc index 72525dfad..8c313b557 100644 --- a/Source/shapebuilders/shapebuilder_polygonfilled.inc +++ b/Source/shapebuilders/shapebuilder_polygonfilled.inc @@ -9,7 +9,7 @@ (ACoordIsX = false) line with border of the polygon specified by APoints. Returns the coordinates of the intersection points. *) -function GetLinePolygonIntersectionPoints(const ACoord: Double; const APoints: TPointFArray; const ACoordIsX: Boolean): TPointFArray; +procedure GetLinePolygonIntersectionPoints(const ACoord: Double; const APoints: TPointFArray; const ACoordIsX: Boolean; out lpoints: TPointFArray); var I, Count: Integer; Arr: TDoubleArray; @@ -44,23 +44,23 @@ begin end; end; - SetLength(Result, Count); + SetLength(lpoints, Count); if (Count = 0) then Exit; specialize QuickSort(Arr, 0, Count - 1); if ACoordIsX then - for I := 0 to High(Result) do + for I := 0 to High(lpoints) do begin - Result[I].X := ACoord; - Result[I].Y := Arr[I]; + lpoints[I].X := ACoord; + lpoints[I].Y := Arr[I]; end else - for I := 0 to High(Result) do + for I := 0 to High(lpoints) do begin - Result[I].X := Arr[I]; - Result[I].Y := ACoord; + lpoints[I].X := Arr[I]; + lpoints[I].Y := ACoord; end; end; @@ -106,7 +106,7 @@ begin begin // Find intersection points of horizontal scan line with polygon // with polygon - lPoints := GetLinePolygonIntersectionPoints(scanlineY, pts, false); + GetLinePolygonIntersectionPoints(scanlineY, pts, false, lpoints); if Length(lPoints) < 2 then begin Inc(scanlineY);