From 71a30c5be0ce047fe11f04781f446ab2ac1d8b86 Mon Sep 17 00:00:00 2001 From: Olly Date: Tue, 19 Sep 2023 17:11:30 +0100 Subject: [PATCH] use TCircle for TSimbaImage.DrawCircle --- .../imports/simba/simba.import_circle.pas | 1 + .../imports/simba/simba.import_debugimage.pas | 75 +++++++++++++++++-- .../simbaclasses/simba.import_class_image.pas | 26 +++---- .../simba.import_externalimage.pas | 18 ++--- Source/simba.circle.pas | 2 + Source/simba.externalimage.pas | 27 +++---- Source/simba.image.pas | 54 ++++++------- Source/simba.inc | 2 +- Tests/matchtemplatemask.simba | 2 +- 9 files changed, 140 insertions(+), 67 deletions(-) diff --git a/Source/script/imports/simba/simba.import_circle.pas b/Source/script/imports/simba/simba.import_circle.pas index 9ba73c7b3..f5a8f43af 100644 --- a/Source/script/imports/simba/simba.import_circle.pas +++ b/Source/script/imports/simba/simba.import_circle.pas @@ -200,6 +200,7 @@ procedure ImportCircle(Compiler: TSimbaScript_Compiler); ImportingSection := 'TCircle'; addGlobalType('record Center: TPoint; Radius: Integer; end;', 'TCircle'); + addGlobalType('array of TCircle;', 'TCircleArray'); addGlobalFunc('function TCircle.Create(ACenter: TPoint; ARadius: Integer): TCircle; static; overload', @_LapeCircle_Create); addGlobalFunc('function TCircle.CreateFromPoints(Points: TPointArray): TCircle; static; overload', @_LapeCircle_CreateFromPoints); diff --git a/Source/script/imports/simba/simba.import_debugimage.pas b/Source/script/imports/simba/simba.import_debugimage.pas index e2a16873e..da4faa562 100644 --- a/Source/script/imports/simba/simba.import_debugimage.pas +++ b/Source/script/imports/simba/simba.import_debugimage.pas @@ -58,6 +58,18 @@ implementation > procedure Show(Quad: TQuad; Filled: Boolean = False); *) +(* +Show +~~~~ +> procedure Show(Circles: TCircleArray; Filled: Boolean = False); +*) + +(* +Show +~~~~ +> procedure Show(Circle: TCircle; Filled: Boolean = False); +*) + (* Show ~~~~ @@ -97,19 +109,25 @@ implementation (* ShowOnClient ~~~~~~~~~~~~ -> procedure ShowOnClient(TPA: TPointArray; Color: Integer = $0000FF); +> procedure ShowOnClient(Circles: TCircleArray; Filled: Boolean = False); *) (* ShowOnClient ~~~~~~~~~~~~ -> procedure ShowOnClient(ATPA: T2DPointArray); +> procedure ShowOnClient(Circle: TCircle; Filled: Boolean = False); *) (* -Show -~~~~ -> procedure Show(Bitmap: TSimbaImage; EnsureVisible: Boolean = True); +ShowOnClient +~~~~~~~~~~~~ +> procedure ShowOnClient(TPA: TPointArray; Color: Integer = $0000FF); +*) + +(* +ShowOnClient +~~~~~~~~~~~~ +> procedure ShowOnClient(ATPA: T2DPointArray); *) (* @@ -309,6 +327,33 @@ procedure ImportDebugImage(Compiler: TSimbaScript_Compiler); 'end;' ]); + addGlobalFunc( + 'procedure Show(Circles: TCircleArray; Filled: Boolean = False); overload;', [ + 'var', + ' Boxes: TBoxArray;', + ' Circle: TCircle;', + 'begin', + ' for Circle in Circles do', + ' Boxes += Circle.Bounds();', + '', + ' with Boxes.Merge() do', + ' with TImage.Create(X1+X2+1, Y1+Y2+1) do', + ' try', + ' DrawCircleArray(Circles, Filled);', + ' Show();', + ' finally', + ' Free();', + ' end;', + 'end;' + ]); + + addGlobalFunc( + 'procedure Show(Circle: TCircle; Filled: Boolean = False); overload;', [ + 'begin', + ' Show(TCircleArray([Circle]), Filled);', + 'end;' + ]); + addGlobalFunc( 'procedure ShowOnClient(Quads: TQuadArray; Filled: Boolean = False); overload;', [ 'begin', @@ -349,6 +394,26 @@ procedure ImportDebugImage(Compiler: TSimbaScript_Compiler); 'end;' ]); + addGlobalFunc( + 'procedure ShowOnClient(Circles: TCircleArray; Filled: Boolean = False); overload;', [ + 'begin', + ' with TImage.CreateFromTarget() do', + ' try', + ' DrawCircleArray(Circles, Filled);', + ' Show();', + ' finally', + ' Free();', + ' end;', + 'end;' + ]); + + addGlobalFunc( + 'procedure ShowOnClient(Circle: TCircle; Filled: Boolean = False); overload;', [ + 'begin', + ' ShowOnClient(TCircleArray([Circle]), Filled);', + 'end;' + ]); + addGlobalFunc( 'procedure ShowOnClient(TPA: TPointArray; Color: Integer = $0000FF); overload;', [ 'begin', diff --git a/Source/script/imports/simbaclasses/simba.import_class_image.pas b/Source/script/imports/simbaclasses/simba.import_class_image.pas index 887daf86b..6301d3435 100644 --- a/Source/script/imports/simbaclasses/simba.import_class_image.pas +++ b/Source/script/imports/simbaclasses/simba.import_class_image.pas @@ -15,7 +15,7 @@ implementation uses Graphics, lptypes, - simba.image; + simba.image, simba.circle; type PBitmap = ^TBitmap; @@ -612,31 +612,31 @@ procedure _LapeImage_DrawPolygonInverted(const Params: PParamArray); LAPE_WRAPPE (* TImage.DrawCircle ~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); +> procedure TImage.DrawCircle(Circle: TCircle; Color: TColor); *) procedure _LapeImage_DrawCircle(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircle(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaImage(Params^[0])^.DrawCircle(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* TImage.DrawCircleFilled ~~~~~~~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); +> procedure TImage.DrawCircleFilled(Circle: TCircle; Color: TColor); *) procedure _LapeImage_DrawCircleFilled(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircleFilled(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaImage(Params^[0])^.DrawCircleFilled(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* TImage.DrawCircleInverted ~~~~~~~~~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); +> procedure TImage.DrawCircleInverted(Circle: TCircle; Color: TColor); *) procedure _LapeImage_DrawCircleInverted(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircleInverted(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaImage(Params^[0])^.DrawCircleInverted(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -732,11 +732,11 @@ procedure _LapeImage_DrawPolygonArray(const Params: PParamArray); LAPE_WRAPPER_C (* TImage.DrawCircleArray ~~~~~~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1); +> procedure TImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1); *) procedure _LapeImage_DrawCircleArray(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircleArray(PPointArray(Params^[1])^, PInteger(Params^[2])^, PBoolean(Params^[3])^, PColor(Params^[4])^); + PSimbaImage(Params^[0])^.DrawCircleArray(PCircleArray(Params^[1])^, PBoolean(Params^[2])^, PColor(Params^[3])^); end; (* @@ -1326,9 +1326,9 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TImage.DrawPolygonFilled(Points: TPointArray; Color: TColor);', @_LapeImage_DrawPolygonFilled); addGlobalFunc('procedure TImage.DrawPolygonInverted(Points: TPointArray; Color: TColor);', @_LapeImage_DrawPolygonInverted); - addGlobalFunc('procedure TImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeImage_DrawCircle); - addGlobalFunc('procedure TImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeImage_DrawCircleFilled); - addGlobalFunc('procedure TImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeImage_DrawCircleInverted); + addGlobalFunc('procedure TImage.DrawCircle(Circle: TCircle; Color: TColor);', @_LapeImage_DrawCircle); + addGlobalFunc('procedure TImage.DrawCircleFilled(Circle: TCircle; Color: TColor);', @_LapeImage_DrawCircleFilled); + addGlobalFunc('procedure TImage.DrawCircleInverted(Circle: TCircle; Color: TColor);', @_LapeImage_DrawCircleInverted); addGlobalFunc('procedure TImage.DrawBox(B: TBox; Color: TColor);', @_LapeImage_DrawBox); addGlobalFunc('procedure TImage.DrawBoxFilled(B: TBox; Color: TColor);', @_LapeImage_DrawBoxFilled); @@ -1341,7 +1341,7 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TImage.DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawQuadArray); addGlobalFunc('procedure TImage.DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawBoxArray); addGlobalFunc('procedure TImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawPolygonArray); - addGlobalFunc('procedure TImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawCircleArray); + addGlobalFunc('procedure TImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawCircleArray); addGlobalFunc('procedure TImage.DrawCrossArray(Points: TPointArray; Radius: Integer; Thickness: Integer; Color: TColor = -1);', @_LapeImage_DrawCrossArray); addGlobalFunc('procedure TImage.DrawHSLCircle(ACenter: TPoint; Radius: Integer)', @_LapeImage_DrawHSLCircle); diff --git a/Source/script/imports/simbaclasses/simba.import_externalimage.pas b/Source/script/imports/simbaclasses/simba.import_externalimage.pas index d1f6df513..ab1ff928c 100644 --- a/Source/script/imports/simbaclasses/simba.import_externalimage.pas +++ b/Source/script/imports/simbaclasses/simba.import_externalimage.pas @@ -14,7 +14,7 @@ implementation uses lptypes, - simba.image, simba.externalimage; + simba.image, simba.externalimage, simba.circle; procedure _LapeExternalImage_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin @@ -303,7 +303,7 @@ procedure _LapeExternalImage_DrawPolygonInverted(const Params: PParamArray); LAP *) procedure _LapeExternalImage_DrawCircle(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircle(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaExternalImage(Params^[0])^.DrawCircle(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -313,7 +313,7 @@ procedure _LapeExternalImage_DrawCircle(const Params: PParamArray); LAPE_WRAPPER *) procedure _LapeExternalImage_DrawCircleFilled(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircleFilled(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaExternalImage(Params^[0])^.DrawCircleFilled(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -323,7 +323,7 @@ procedure _LapeExternalImage_DrawCircleFilled(const Params: PParamArray); LAPE_W *) procedure _LapeExternalImage_DrawCircleInverted(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircleInverted(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaExternalImage(Params^[0])^.DrawCircleInverted(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -423,7 +423,7 @@ procedure _LapeExternalImage_DrawPolygonArray(const Params: PParamArray); LAPE_W *) procedure _LapeExternalImage_DrawCircleArray(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircleArray(PPointArray(Params^[1])^, PInteger(Params^[2])^, PBoolean(Params^[3])^, PColor(Params^[4])^); + PSimbaExternalImage(Params^[0])^.DrawCircleArray(PCircleArray(Params^[1])^, PBoolean(Params^[2])^, PColor(Params^[3])^); end; (* @@ -549,9 +549,9 @@ procedure ImportSimbaExternalImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TExternalImage.DrawPolygonFilled(Points: TPointArray; Color: TColor);', @_LapeExternalImage_DrawPolygonFilled); addGlobalFunc('procedure TExternalImage.DrawPolygonInverted(Points: TPointArray; Color: TColor);', @_LapeExternalImage_DrawPolygonInverted); - addGlobalFunc('procedure TExternalImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeExternalImage_DrawCircle); - addGlobalFunc('procedure TExternalImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeExternalImage_DrawCircleFilled); - addGlobalFunc('procedure TExternalImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeExternalImage_DrawCircleInverted); + addGlobalFunc('procedure TExternalImage.DrawCircle(Circle: TCircle; Color: TColor);', @_LapeExternalImage_DrawCircle); + addGlobalFunc('procedure TExternalImage.DrawCircleFilled(Circle: TCircle; Radius: Integer; Color: TColor);', @_LapeExternalImage_DrawCircleFilled); + addGlobalFunc('procedure TExternalImage.DrawCircleInverted(Circle: TCircle; Radius: Integer; Color: TColor);', @_LapeExternalImage_DrawCircleInverted); addGlobalFunc('procedure TExternalImage.DrawBox(B: TBox; Color: TColor);', @_LapeExternalImage_DrawBox); addGlobalFunc('procedure TExternalImage.DrawBoxFilled(B: TBox; Color: TColor);', @_LapeExternalImage_DrawBoxFilled); @@ -564,7 +564,7 @@ procedure ImportSimbaExternalImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TExternalImage.DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1);', @_LapeExternalImage_DrawQuadArray); addGlobalFunc('procedure TExternalImage.DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1);', @_LapeExternalImage_DrawBoxArray); addGlobalFunc('procedure TExternalImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1);', @_LapeExternalImage_DrawPolygonArray); - addGlobalFunc('procedure TExternalImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1);', @_LapeExternalImage_DrawCircleArray); + addGlobalFunc('procedure TExternalImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1);', @_LapeExternalImage_DrawCircleArray); addGlobalFunc('procedure TExternalImage.DrawCrossArray(Points: TPointArray; Radius: Integer; Thickness: Integer; Color: TColor = -1);', @_LapeExternalImage_DrawCrossArray); addGlobalFunc('procedure TExternalImage.Clear; overload', @_LapeExternalImage_Clear); diff --git a/Source/simba.circle.pas b/Source/simba.circle.pas index 9bfe7cdd4..de28abd7c 100644 --- a/Source/simba.circle.pas +++ b/Source/simba.circle.pas @@ -19,6 +19,8 @@ TCircle = record Center: TPoint; Radius: Integer; end; + PCircleArray = ^TCircleArray; + TCircleArray = array of TCircle; TCircleHelper = type helper for TCircle public const diff --git a/Source/simba.externalimage.pas b/Source/simba.externalimage.pas index 9c0c995be..aa86a1181 100644 --- a/Source/simba.externalimage.pas +++ b/Source/simba.externalimage.pas @@ -6,7 +6,8 @@ interface uses Classes, SysUtils, Graphics, - simba.mufasatypes, simba.baseclass, simba.image, simba.simplelock; + simba.mufasatypes, simba.baseclass, simba.image, simba.simplelock, + simba.circle; type TSimbaExternalImageCallback = procedure(Image: Pointer); cdecl; @@ -83,9 +84,9 @@ TSimbaExternalImage = class(TSimbaBaseClass) procedure DrawPolygonFilled(Points: TPointArray; Color: TColor); procedure DrawPolygonInverted(Points: TPointArray; Color: TColor); - procedure DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); + procedure DrawCircle(Circle: TCircle; Color: TColor); + procedure DrawCircleFilled(Circle: TCircle; Color: TColor); + procedure DrawCircleInverted(Circle: TCircle; Color: TColor); procedure DrawBox(B: TBox; Color: TColor); procedure DrawBoxFilled(B: TBox; Color: TColor); @@ -98,7 +99,7 @@ TSimbaExternalImage = class(TSimbaBaseClass) procedure DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1); procedure DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1); procedure DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1); - procedure DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1); + procedure DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1); procedure DrawCrossArray(Points: TPointArray; Radius: Integer; Color: TColor = -1); end; @@ -477,31 +478,31 @@ procedure TSimbaExternalImage.DrawPolygonInverted(Points: TPointArray; Color: TC end; end; -procedure TSimbaExternalImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaExternalImage.DrawCircle(Circle: TCircle; Color: TColor); begin Lock(); try - FImage.DrawCircle(ACenter, Radius, Color); + FImage.DrawCircle(Circle, Color); finally Unlock(); end; end; -procedure TSimbaExternalImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaExternalImage.DrawCircleFilled(Circle: TCircle; Color: TColor); begin Lock(); try - FImage.DrawCircleFilled(ACenter, Radius, Color); + FImage.DrawCircleFilled(Circle, Color); finally Unlock(); end; end; -procedure TSimbaExternalImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaExternalImage.DrawCircleInverted(Circle: TCircle; Color: TColor); begin Lock(); try - FImage.DrawCircleInverted(ACenter, Radius, Color); + FImage.DrawCircleInverted(Circle, Color); finally Unlock(); end; @@ -597,11 +598,11 @@ procedure TSimbaExternalImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: end; end; -procedure TSimbaExternalImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor); +procedure TSimbaExternalImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor); begin Lock(); try - FImage.DrawCircleArray(Points, Radius, Filled, Color); + FImage.DrawCircleArray(Circles, Filled, Color); finally Unlock(); end; diff --git a/Source/simba.image.pas b/Source/simba.image.pas index 518b0f5ed..66a36182a 100644 --- a/Source/simba.image.pas +++ b/Source/simba.image.pas @@ -13,7 +13,8 @@ interface uses Classes, SysUtils, Graphics, simba.baseclass, simba.mufasatypes, simba.image_textdrawer, - simba.colormath, simba.colormath_distance, simba.matchtemplate; + simba.colormath, simba.colormath_distance, simba.matchtemplate, + simba.circle; type {$PUSH} @@ -129,9 +130,9 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawPolygonFilled(Points: TPointArray; Color: TColor); procedure DrawPolygonInverted(Points: TPointArray; Color: TColor); - procedure DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); + procedure DrawCircle(Circle: TCircle; Color: TColor); + procedure DrawCircleFilled(Circle: TCircle; Color: TColor); + procedure DrawCircleInverted(Circle: TCircle; Color: TColor); procedure DrawBox(B: TBox; Color: TColor); procedure DrawBoxFilled(B: TBox; Color: TColor); @@ -144,7 +145,7 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1); procedure DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1); procedure DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1); - procedure DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1); + procedure DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1); procedure DrawCrossArray(Points: TPointArray; Radius: Integer; Color: TColor = -1); procedure DrawHSLCircle(ACenter: TPoint; Radius: Integer); @@ -947,40 +948,43 @@ procedure TSimbaImage.DrawPolygonInverted(Points: TPointArray; Color: TColor); FData[Y*FWidth+X] := RGB; end; -procedure TSimbaImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaImage.DrawCircle(Circle: TCircle; Color: TColor); begin - if (Radius < 1) then + if (Circle.Radius < 1) then Exit; - DrawTPA(TPointArray.CreateFromCircle(ACenter, Radius, False), Color); + DrawTPA(TPointArray.CreateFromCircle(Circle.Center, Circle.Radius, False), Color); end; -procedure TSimbaImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaImage.DrawCircleFilled(Circle: TCircle; Color: TColor); begin - if (Radius < 1) then + if (Circle.Radius < 1) then Exit; - DrawTPA(TPointArray.CreateFromCircle(ACenter, Radius, True), Color); + DrawTPA(TPointArray.CreateFromCircle(Circle.Center, Circle.Radius, True), Color); end; -procedure TSimbaImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaImage.DrawCircleInverted(Circle: TCircle; Color: TColor); var X, Y: Integer; - Bounds: TBox; + B: TBox; RGB: TColorBGRA; begin RGB := ColorToBGRA(Color); - Bounds.X1 := Max(ACenter.X-Radius, 0); - Bounds.Y1 := Max(ACenter.Y-Radius, 0); - Bounds.X2 := Min(ACenter.X+Radius, FWidth-1); - Bounds.Y2 := Min(ACenter.Y+Radius, FHeight-1); + with Circle do + begin + B.X1 := Max(Center.X-Radius, 0); + B.Y1 := Max(Center.Y-Radius, 0); + B.X2 := Min(Center.X+Radius, FWidth-1); + B.Y2 := Min(Center.Y+Radius, FHeight-1); + end; - Self.DrawBoxInverted(Bounds, Color); + Self.DrawBoxInverted(B, Color); - for X := Bounds.X1 to Bounds.X2 do - for Y := Bounds.Y1 to Bounds.Y2 do - if not TSimbaGeometry.PointInCircle(Point(X, Y), ACenter, Radius) then + for X := B.X1 to B.X2 do + for Y := B.Y1 to B.Y2 do + if not Circle.Contains(TPoint.Create(X, Y)) then FData[Y*FWidth+X] := RGB; end; @@ -1091,15 +1095,15 @@ procedure TSimbaImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; DrawPolygon(Polygons[I], GetDistinctColor(Color, I)); end; -procedure TSimbaImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor); +procedure TSimbaImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor); var I: Integer; begin - for I := 0 to High(Points) do + for I := 0 to High(Circles) do if Filled then - DrawCircleFilled(Points[I], Radius, GetDistinctColor(Color, I)) + DrawCircleFilled(Circles[I], GetDistinctColor(Color, I)) else - DrawCircle(Points[I], Radius, GetDistinctColor(Color, I)); + DrawCircle(Circles[I], GetDistinctColor(Color, I)); end; procedure TSimbaImage.DrawCrossArray(Points: TPointArray; Radius: Integer; Color: TColor); diff --git a/Source/simba.inc b/Source/simba.inc index 0585358ce..96b49107b 100644 --- a/Source/simba.inc +++ b/Source/simba.inc @@ -9,7 +9,7 @@ {$DEFINE SIMBA_HAS_DEBUGINFO} {$ELSE} {$IFDEF SIMBA_MAX_OPTIMIZATION} // O4 can do "unsafe" optimizations so this is not globally enabled. - {.$OPTIMIZATION LEVEL4} + {$OPTIMIZATION LEVEL4} {$ENDIF} {$ENDIF} diff --git a/Tests/matchtemplatemask.simba b/Tests/matchtemplatemask.simba index bc2ed846f..5e4786517 100644 --- a/Tests/matchtemplatemask.simba +++ b/Tests/matchtemplatemask.simba @@ -50,7 +50,7 @@ end; begin img := TImage.CreateFromString('IMG:eJyNm21sHMd5x0/3Qh9qly5Fnu6s1R1r8qRtcaG4t7Js93C3DdQWKBDEtWBYthyrthPLjmO7SQo1aNpPrVEbthP0S1tHFgWdI6UOiqYCCjQfk5nZ3dm9JXmUKJm21PhNTlurcNUW6Af5g1Z9nmdm742kpCARxdPN7z/zzDPPy+zm29987plUKnUJ/ve3mVR86PGtH8bz1m0sth8pxAcPbQ1m2cSdLH744HYZH3nhUT++cuVKfPrtl/04ldoS//znLN7/Bw/EL730l/FXn3zyp183kr+O/pxrznsmEjxzPmrOxY/ff3t8uFmc+4uX4/2/ccf4XPzd/Xez8WbBb7oFc94344MPbY8PPbJVnPyReHsieqvYnOPx2Lcz8dg3fn0ivv21/BxrxoeemxKnfhktLIhi/ODu20/vKwaN+IlHHw0abNtHd3aHZz3vN+dYb0ow6+nXfox/LRjJh2x4jmw3zXD3+A42zpqFKJkWa+GkHPxGPPblLRMpF+aykxejhihGdojab923gThHjVe//jedxCbTP3llzphDQ4JuAUQXATm+u87mQM8sdBJBPirI4L/jc8OaXnzw0e1im3Qk/E+8VZTHfiJxDmJoDmJwu9Tq5/jAspeaDKbAm2zeLISk/9XHtoJ0XZx8myf6PMXju/4lncIteOrFKX82NvaPs9kW+cyzL0517Q5OaHdvNvXeZApqJhKt8Y0Xnn8pHJwLSJMx/GQ23aY7z81CQBMBZyAr1EU5mQk6BE95c82cN8twEhynwIvLm09g4RcFL5mCQOG/fgWlOaylr7tmFmSiyUZFGaqy1ERKjIMuLZ1U4999bMcEKy7ZUYOZZxx57PsbCwconEhK2nfQ8xM9PqrH1So5+MSA3OyEUFLzZ0zn/WPfF/GBh7eLY++zgmvOh7CLLuxhgNw1xTaAWpY7gcrvZOPxb5vj47+VGmdzzfjgi1Msfvpb28SsO3HbBG6gAp81nV8k4BYvCDwU7nzHLHySzFUzRRMDAUyQqHMJlNe8OJ1Jz4pc+1NFXDWdf+1PVSz8WYGZ8xfNwqWesYeIruIJTfPj6bumMizH2p+6aIeJog/7zOfPmZ/EBx7cLu5gBaJ9PGxKxOXUDJsI/Ke/A49HohgkCrIs7J+HTHN5/rKJUI4WJepH/dMgy7IhACpgBxmC6cQg0q25yWGYyBV5i8EuuXZYFsayqYmsqoEfDlixTxRNd86vCe3OE7wI0WaCt4qCKN2EUuXE+GDQcH1It6aXw2+DFbGWO9GagHnIsmusIOGaSCy08TB0LhcjKitKGsUcaUjzk/lrXfQjcfIVURZ60Br8Qo5TdEuZotsQtlf2aMCl2ZbhHXvfnL+2ZBquI6oDgyZFjWnnUErDQz8GyzHDTYN7XItMw1s3mCc7hxEQh+HO4MiPcM0wEuxzLTQN/+YjnU+PXsclcyMwr4UGfL8hc3IuapfEyTdkSUzKGowtzrZwU2GW3PadKwaHvGgwXGFaxgcf2B4df31ttlX1mjI+tH+rMKJ/+DXNKYktPcosa+GeCg3x9TJlE4a/g79U3aac3mx0S2+oaDBbwnBPr5WGn8dfbjYcN1aN9qqs3K1GjqyGtPbF9Ef0c8UhAxQFjJZb1KK3nAO74exxmxuiPDy+g5ZYSn+MPzwwSDhIUAvesqoADb3nDbdsBwOIyOimL2lrBIPD9YppfGuiBgS9fQ04VY7fB+D2I0OZZJQBy0YE8gcQwu44fuOzE5ejqnjzyurCm12Hx1/84r6fvsIdjsaoBpohJsGMKjo+eGSb3BJNqqPNGwEwZOOzrEIYXSfevXs3iw8ceMR10EWq4QAiLM2KTACj9ZlmMDx0gsHhJg5Fd48GxnVwwvFXWhCmQT4kAB1p1pAACHsAWIJJ4uK1Vx33JgyRoxOeA4eQsBudLBhVO3lurdg98XmU7b55RSx8T30YH356ylV09tqrEMWyssHhu34umoy2iFNPi3a+u/CPYCggl07vQ65vB2VR91uA1q6fg0NSXCL2Lv2RBv/za2aVA5O1KAorqoHQ3xxiehgI616LIVT7R47OTnFRc/WnCPZMTlQViddD8ThggHbrLnxFI8FdcnScBonwIQID9JAxnvV1WN4YCa4FSNECjy+qY5PrQEYI0KuKERjzxRemzhZFVTlV1TfZmFv11KYCoSYnId5mVgeIHIheQswlsbNDLo01OlAxfJwBKLpZVZpjXjVQMdy/EbHMS4TkPQchqsgFxUX8WV0BZMfIMECyMXAs4EOhrZmnsrKdH6QyO9qEGpLFchJmin+pdge55FKdWwODc8iaJGPVovZV9bdqVIyqstghRyrC32RK1MDJTx0RBpDWtkAQBA54bFaDBHE6JVZbTsGfEMdaVUYQAT4KjjNAsQCSSRjkoSOQ0/uIkqmGtA2E4eSUwTClPxU0rt6CdZSAgjlRyJc3pZApwX+5css61yxpRfGzR7aBKVMifub5aXHisoi/9c1tIkWpLvUO/SlbE6lOLbK6RtTOR0ZkCTQ22RN6CnTKOiuLHz+pifk+7m7xKyKFAS71Lv6BQZalQoXK9EjtT3mJZe1F8EUEFTfh/AeaIhVsNPr0viyzO8rxBhc3ivh3MkRKrlvMEAS9DM2dZUlctLo1GT8BlPbVKNU9dSTKR7T8vA6FeWvN+MCSiiSyAjEZM37q8BSFtUFMus9YLrG8r6Lb8HgXxnMaTQFs0+Gn9+V9HcWGAZ69tOnQMo7M0EAIVsPjfHuxLn94lelCCD43BP5r/BisHcev1mQeLJO/SBHJWLX81oRxoQ+QAIB8Ozp+z9Dg1dlW3rN0cLIA4lFKf6+PCe1OnVrA6o1JZ3Fg3rV0rrZYu7RqYYgWxrt9Wgdonm3eGHUGzTiKUgfHWBtlMUhCiIPaB+Jl/BBYB2gSokwa/C4fWUt4cCymvMMCgDouhjz1jHaZjBt/7U9LcEwn1e85pEOPjtvu2dxURhwWgIiTZn2RZThToEEOBBI+hXGjk9EZMyO0gk6g0LGRQtmzhVldT6dAlO7jV7VrGS5MfMXywd2MzqlnkrzZwyd5lPjw3ayrNKqmOypB3xyRACc0qOYyukMa8PmgBCZWUqDvZoXWYFi1Y0OEiWsPFanpczWRFxZkUqtjqLRqUCGGJQ2HE9+tgEMDl/6pEqm2RJz4nL60CxOea7uYxYfYWMCmzxOaorcVGrpxBTq6CeJZH+9Bfq0s5hn8qCFdVXO7GOFlmQ2go/QacQOcgBUYfr8KexSiM7nOCL3/lcpSnkN+rMFZr6qCbxcE004ZLJRIQJbsaUiahiUN3dWigtfOk+9k3JsJiCxE6l1C8TtlrppRiC9yj0y/qzx50lLBEclr7TxsKc4d0fo4BBVJ9q90IT4LpO6CL+1yMfxSvTGMXdMhMjIgTRgXBon6X+RmQA424JCD2TAwiZlIzCBRGlHy2QYsCR4dUGXBzJ18BIQxFDnguD0QfrYhx7OhcqUe1AT/hUlBxwUkCkRRWnki7lG7JGGHusSjDwF3ETnHLyMoAktpEDeheB4FLSm/rA2gMkCy0BfB+huTBJBGQcs9J6ix0XlZ/aLNCjdhuqYt0WTroZlbJaqKpcrXYcuEzUOpVvMR3F34AqQ48vE1oEJZaEhwZsRwaregdmaKklUUTDB9ENVrNS8tit2dGjTbss4DKjNCgpL5RiA8xDV3gEOB1To3TGJqTlgp49qg098IRoe1JgZg5KYWy4xxa3lkmRpJRbLYgIk1GjLxcOYg/LevihMXoK3bicGYCj5tJzy5Z9p5naigTALvEdai+r3ybl4sLHBdQYuj19Gxhe0pKUFS0M8VZU0lpBpHrcaAFBaEljIkKen89PtHtkXUOIOWPtmVNdQSWGSPCnElpMI0imFZvE5KWH07o9bZJFkNiekPtRoG61E1FGPGrcvhHqCeTnDr5OCzm6iBmMNOviJ+NCuwpIeGCJLhs9MkBj0RmpGkYBcsKFXUtQPIdFFGkAkpvUGBVlm2BN3cYl+DPSVXej3/uDU9gXocxTK6dkO9lQyKLWGyo5uZylIiRgcK5dgGcqDGb6xmCVTqhwQUO0OLo6Ro9WMTCUOuTYQp14Ouku0dU/MWNdv5WxL16GxWIq2qSoAXD0+JXa5u/kn48Ud2oK7JHJ4Vb5lwkBsw4GsVefJl8dZ90K6dfEMFrS6dZmhKBPQ28GtFHzc6rpWo13LhysBhkrPaE5G4RoehcR23JzUzqNMuJUKZvo4+aZwOa2WZ+mhItFVfa4x5NhlRXZ0S3tsAn9L0ABK8O6yQHC9Mkj2BDAr0D6dN/tE72I6vJAKIc0W+kQ71krhfQ0bTR2tTJTyXdgBSXk9K3VTD6Sv2wt/Tz01BXRk/9cQOOSPw0VlK5KVFXmb57RLIdTHoqjMHSV5WfLXllrqFOPG53MWxAwQpoaRoX/B6e0BqzGuAzH2DGsqpLK8vUtFnraKEXGy3+yoMWhFuY4Hi9lW8RKVv3gZfJ4S+NCTU93rQ1GJjXl/LXoT6xe3FC39EBU3bgE7qPmrc3J6Sul2yghsqid5M+yYEPd8W/WUt0xOFrNqljFl1KNfA0UL396vCzIKjDPh5AE5gLbZLH4CiHJLBqVZYTQtB0wt963ohFe+qjkS+hNIX/xHv/vpndgMJN4nKFd4X6EBHu4FAVTieHVWhTzezDQpKSfkyAPRoGn2aZwe7oI3bGCfsbpabG7AyshL1CeA4gHBVbXDwoe3QhJz6DuQmh9lnMcVx6m8RktxwWKH+2S5dtFZ0aDpniYQJFTIwZfzAC/fCcjS6ANwxwNrnNZRpqEgKd536IbZe7EWi1VFquDerDpHQQGa/q4EJr1e9J/ldEZPIM4AUgORZuVcMIe2LCjjAoyJep+8eDYPLOli4N/7O7+3Q0asgmrA1D2+VBjdhokuma0foo4hHek3ogl5FD+yRrGhS/WatTmJakrA/Iisbe9k9OuwiNI2GXJr20qbdcZINwoJQ36N0sLhvl4hGXWd+GLeXNe6BAgZwRPPsFWNappmZpszf5w0U4YuGughRTH0zkmcj02R777FDs8ABKuwzNF8A0+rlOnDmVqn8Hpse1zAgpZm92mRmkx97H6Zupm1wAXx2A8FHaD9fhfACoWbeuo1csxbgBSA0asrpI7XpZbYXdgRmeb7pEQpsqfPaBjRJb7igS9bkhjRh/1vTVxzo5/zNQdoN12FCPDJlvjd+/Cs77F82/VlEQUfn3RCF04IOY2MYrLAKk/m4KY6/Lt68IpuA85vqgTRGiSLei17KKyeEvnQ1t1qM0JFh+ML3xN/PQASvMse0P0z3EGB5YBjDgBpdbLh9QGfXwHhmOq79Xpr1GGYTvGEUofe+5hHFxeemeOYX48N/OMUSFDcdKHeY/U6aJzTwhJvB6JZIhZBlPHuiHADHBBp+gOZAWAe80w4L+HwbTQ1eCp39RXVrTKtq4PNd8EpfPciDBLjs+GXPicC5I8O7RQa21UVPP82DpLbseMRY1eOBVWAbjgeTBIMI9TwP0tWy465HmAZfzyBDyD5ENighN4pwysjQ9pIjGl5ZnrggzciQEB183K3FJj0XRw/MyclA3+0s1rQxsn41KstGBGkHn0SMQRdgLzocQdXVQYpBD+Y1Rgd8cNrEIFlvlEMBc5SzZDB6OyDh6COlQWiWAVAEFEisDltP4aa2c0KBiE6QoMSKWcjyphyAQOZ2WC4Em0l8XAcJVho+BrYuvU1hgi/gFSE+wcbzNIk9L71y0smWMlnMx0qQ2Z5p1/FES9gzmfYhhu8e4Yb2GccEx9DASR3XJ4MaXY8Xwyy9AKGoaAxYYMKT63Ed+yycQXwIn/OApk/HZFij6/FioMqFo9dN+6zDE8wPt9mddZxVTGFmjg9R6BUQcmhJJCh37XMOQ9DR65pUC3Mrvfdcim5Z1OF7rQkHbHHJ3Mnn1nRHA0q6ygAfWnNc453WRNM//jqzQ0B0k7chaDw1lY4327I/NncyQPiwb5Bhjv2XrikMTojz+L2m14P0XoogCprAoZPh2B+ZOwmT0Zjk1pvZ74Ghz+FXm+7x17kdaA69HYEY8l+Hvu5w+0NzztXvBcwt5/B+oA/EO27gQfgxVmkUnlogWtAU4TV1XvlPTjaURep0G2PWBZj+YvwItCO6NZmEvAlne07ivUNZLFxUgTxtX1CV4PHnRYG2hh52gptJkGDqujof6mtBlCmrfq/M63gbU/egEL0wyVRXsl7E0M5oDAs1FaQaKh31VhBUxflOcsWnpEoZ0ImcqC7tpV6hP8lRBULKgA62nL3WG3OgHTUF1AGDkvj0lPQSD7TkJnq6D3d4PQSGqvzBebE9QIvcUDdsegX4UzWIimP4yQxO76MpVFhi6Uq3fVXgfSXoQ/yo+3q76lSgB3Vud5K2IH7o8BTGHbGHt6/KOh5mKJbUBR0kaxcTtoSKRxOmWTOqih/8rKO+UXFLrHIWxBbeHFEb8+r0nTpr3w/zBhXqG/aoNxD2sPVikNaDNGrpq7hD+7euE4M2elTN6+1gfZEEZ5jSC8l1h5Sw9gCZMI33B2pYBnX4revQw9hl/OIMHBgyX1Rie9wRFbPZSeMFQrLL9HpVk1rRIN7/O6UO7dfJvxLxoT8vRfeKiuzJwWlGR1j4gpxJesv6ihaU5gy66QzOcMatS4yYFL49KPkATy9xQSthJNubdpuQeVAx0Itj9/Y196yXVF1mfWWGFBkscYb96qggREx/SNAnQQ5q0PGhmqcu1W6qVl+dYaaSAZUoEXBRgPcEoO9Ke5AvVxEN9g1vhcvNGTuYMV2g+iY1GljMws4PgTsm7NM78HEHeeHJPyEkvYVAT9gXFiJ8YTtaWJAzZ3GmciaEsyyPXg/tELOpn5xG+3+IYPUB6aHR52E2gRoqoViDlKldyoWx/33jsSutiRlhn62HDvaavU5bnzRD2lduPB7zBAP/OVen0+ZC2MQbSMNPTgHk1c/uZQgRVtdAyON/dDdB9DV7zp2EiDITHTvOdVzF9+y5/X9OaCoPB+ASbD4+JQf/WB2i4Xx26kv0nEhIvZCpXtVn9v86kfZ4pK1AtIUM/oOfMfvMBrTkLaphHJ55hRP2FYfCO0fY2WPvyybUJ9Ng+xHY8cuKhi9Q9WDizhK700UOWUzN7z+dM0evryYkNzPGp205ze5lVnTyDWGJ48ewI4if+ONZsQ0fZxz/rtipUik+5od+BHwc0nS8/8B2OE93BCcu6+24BKm1LHrFSdk9cQEcxQwKfnzgS9vF8eeSu8D7QxS7C1+nQaktyvXBHDqZzgX4IgHKwBLuUP/3AtShyLMNCkWo+iCL1aGu672sWxakBm5ZkCR3v74OvD9Mqf9s+X+N5ae1'); templ := img.Copy(50, 50, 100, 100); - templ.DrawCircleInverted(templ.GetCenter(), 20, 0); + templ.DrawCircleInverted([templ.GetCenter(), 20], 0); try test(TM_CCOEFF, [83, 1], [50, 50]);