Shapebox: Add copy button

Source/script/imports/simba.import_shapebox.pas

@@ -66,6 +66,11 @@ procedure _LapeSimbaShapeBox_NameButton(const Params: PParamArray; const Result:
   PButton(Result)^ := PSimbaShapeBox(Params^[0])^.NameButton;
 end;
 
+procedure _LapeSimbaShapeBox_CopyButton(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PButton(Result)^ := PSimbaShapeBox(Params^[0])^.CopyButton;
+end;
+
 procedure _LapeSimbaShapeBox_DeleteButton(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
 begin
   PButton(Result)^ := PSimbaShapeBox(Params^[0])^.DeleteButton;
@@ -156,6 +161,11 @@ procedure _LapeSimbaShapeBox_QueryNameOnNew_WRite(const Params: PParamArray); LA
   PSimbaShapeBox(Params^[0])^.QueryNameOnNew := PBoolean(Params^[1])^;
 end;
 
+procedure _LapeSimbaShapeBox_CopyShape(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PInteger(Result)^ := PSimbaShapeBox(Params^[0])^.CopyShape(PInteger(Params^[1])^);
+end;
+
 procedure _LapeSimbaShapeBox_DeleteShape(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
 begin
   PSimbaShapeBox(Params^[0])^.DeleteShape(PInteger(Params^[1])^);
@@ -199,6 +209,7 @@ procedure ImportSimbaShapeBox(Compiler: TSimbaScript_Compiler);
     addClassVar('TShapeBox', 'UserDataSize', 'Integer', @_LapeSimbaShapeBox_UserDataSize_Read, @_LapeSimbaShapeBox_UserDataSize_Write);
     addClassVar('TShapeBox', 'QueryNameOnNew', 'Boolean', @_LapeSimbaShapeBox_QueryNameOnNew_Read, @_LapeSimbaShapeBox_QueryNameOnNew_Write);
 
+    addGlobalFunc('function TShapeBox.CopyShape(Index: Integer): Integer;', @_LapeSimbaShapeBox_CopyShape);
     addGlobalFunc('procedure TShapeBox.DeleteShape(Index: Integer);', @_LapeSimbaShapeBox_DeleteShape);
     addGlobalFunc('procedure TShapeBox.DeleteAllShapes;', @_LapeSimbaShapeBox_DeleteAllShapes);
 
@@ -211,6 +222,7 @@ procedure ImportSimbaShapeBox(Compiler: TSimbaScript_Compiler);
     addGlobalFunc('function TShapeBox.PathButton: TLazButton;', @_LapeSimbaShapeBox_PathButton);
     addGlobalFunc('function TShapeBox.PrintButton: TLazButton;', @_LapeSimbaShapeBox_PrintButton);
     addGlobalFunc('function TShapeBox.NameButton: TLazButton;', @_LapeSimbaShapeBox_NameButton);
+    addGlobalFunc('function TShapeBox.CopyButton: TLazButton;', @_LapeSimbaShapeBox_CopyButton);
     addGlobalFunc('function TShapeBox.DeleteButton: TLazButton;', @_LapeSimbaShapeBox_DeleteButton);
     addGlobalFunc('function TShapeBox.DeleteAllButton: TLazButton;', @_LapeSimbaShapeBox_DeleteAllButton);
 

Source/simba.shapebox.pas

@@ -28,6 +28,7 @@   TSimbaShapeBoxShape = class
     function GetLineColor(const Flags: EPaintShapeFlags): TColor; inline;
     function GetConnectorColor(const Flags: EPaintShapeFlags): TColor; inline;
   public
+    FShapeBox: TSimbaShapeBox;
     FDragStart: TPoint;
     FName: String;
     FUserData: Pointer;
@@ -51,6 +52,8 @@   TSimbaShapeBoxShape = class
 
     function ToStr: String; virtual; abstract;
     procedure FromStr(Str: String); virtual; abstract;
+
+    function CreateCopy: TSimbaShapeBoxShape; virtual;
   end;
 
   TSimbaShapeBoxShape_Point = class(TSimbaShapeBoxShape)
@@ -78,6 +81,8 @@   TSimbaShapeBoxShape_Point = class(TSimbaShapeBoxShape)
 
     function ToStr: String; override;
     procedure FromStr(Str: String); override;
+
+    function CreateCopy: TSimbaShapeBoxShape; override;
   end;
 
   TSimbaShapeBoxShape_Box = class(TSimbaShapeBoxShape)
@@ -110,6 +115,8 @@   TSimbaShapeBoxShape_Box = class(TSimbaShapeBoxShape)
 
     function ToStr: String; override;
     procedure FromStr(Str: String); override;
+
+    function CreateCopy: TSimbaShapeBoxShape; override;
   end;
 
   TSimbaShapeBoxShape_Poly = class(TSimbaShapeBoxShape)
@@ -140,6 +147,8 @@   TSimbaShapeBoxShape_Poly = class(TSimbaShapeBoxShape)
 
     function ToStr: String; override;
     procedure FromStr(Str: String); override;
+
+    function CreateCopy: TSimbaShapeBoxShape; override;
   end;
 
   TSimbaShapeBoxShape_Path = class(TSimbaShapeBoxShape_Poly)
@@ -189,6 +198,7 @@   TSimbaShapeBox = class(TSimbaImageBox)
     FDeleteButton: TButton;
     FDeleteAllButton: TButton;
     FPrintButton: TButton;
+    FCopyButton: TButton;
 
     FUserDataSize: Integer;
     FQueryNameOnNew: Boolean;
@@ -222,6 +232,7 @@   TSimbaShapeBox = class(TSimbaImageBox)
     procedure DoShapeDeleteAllClick(Sender: TObject);
     procedure DoShapeNameClick(Sender: TObject);
     procedure DoShapePrintClick(Sender: TObject);
+    procedure DoShapeCopyClick(Sender: TObject);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -231,6 +242,8 @@   TSimbaShapeBox = class(TSimbaImageBox)
     procedure SaveToFile(FileName: String);
     procedure LoadFromFile(FileName: String);
 
+    function CopyShape(Index: Integer): Integer;
+
     procedure DeleteShape(Index: Integer);
     procedure DeleteAllShapes;
 
@@ -255,6 +268,7 @@   TSimbaShapeBox = class(TSimbaImageBox)
     property DeleteButton: TButton read FDeleteButton;
     property DeleteAllButton: TButton read FDeleteAllButton;
     property PrintButton: TButton read FPrintButton;
+    property CopyButton: TButton read FCopyButton;
 
     property ShapeIndex: Integer read GetShapeIndex;
     property ShapeCount: Integer read GetShapeCount;
@@ -273,6 +287,7 @@ constructor TSimbaShapeBoxShape.Create(ShapeBox: TSimbaShapeBox);
 begin
   inherited Create();
 
+  FShapeBox := ShapeBox;
   FShapeType := String(ClassName).After('_');
   FName := FShapeType;
   FUserData := AllocMem(ShapeBox.UserDataSize);
@@ -286,6 +301,12 @@ destructor TSimbaShapeBoxShape.Destroy;
   inherited Destroy();
 end;
 
+function TSimbaShapeBoxShape.CreateCopy: TSimbaShapeBoxShape;
+begin
+  Result := TSimbaShapeBoxShapeClass(Self.ClassType).Create(FShapeBox);
+  Result.FName := FName;
+end;
+
 function TSimbaShapeBoxShape.GetLineColor(const Flags: EPaintShapeFlags): TColor;
 begin
   if (EPaintShapeFlag.SELECTED in Flags) or (EPaintShapeFlag.SELECTING in Flags) then
@@ -382,6 +403,13 @@ procedure TSimbaShapeBoxShape_Point.FromStr(Str: String);
   SScanf(Str, '%d,%d', [@FPoint.X, @FPoint.Y]);
 end;
 
+function TSimbaShapeBoxShape_Point.CreateCopy: TSimbaShapeBoxShape;
+begin
+  Result := inherited CreateCopy();
+
+  TSimbaShapeBoxShape_Point(Result).FPoint := FPoint;
+end;
+
 function TSimbaShapeBoxShape_Path.DistToEdge(P: TPoint): Integer;
 var
   i: Integer;
@@ -588,6 +616,13 @@ procedure TSimbaShapeBoxShape_Poly.FromStr(Str: String);
     SScanf(Elements[I], '%d,%d', [@FPoly[I].X, @FPoly[I].Y]);
 end;
 
+function TSimbaShapeBoxShape_Poly.CreateCopy: TSimbaShapeBoxShape;
+begin
+  Result := inherited CreateCopy();
+
+  TSimbaShapeBoxShape_Poly(Result).FPoly := Copy(FPoly);
+end;
+
 function TSimbaShapeBoxShape_Box.GetBox: TBox;
 begin
   Result := FBox;
@@ -604,6 +639,13 @@ procedure TSimbaShapeBoxShape_Box.FromStr(Str: String);
   SScanf(Str, '%d,%d,%d,%d', [@FBox.X1, @FBox.Y1, @FBox.X2, @FBox.Y2]);
 end;
 
+function TSimbaShapeBoxShape_Box.CreateCopy: TSimbaShapeBoxShape;
+begin
+  Result := inherited CreateCopy();
+
+  TSimbaShapeBoxShape_Box(Result).FBox := FBox;
+end;
+
 constructor TSimbaShapeBoxShape_Box.Create(ShapeBox: TSimbaShapeBox);
 begin
   inherited Create(ShapeBox);
@@ -853,6 +895,12 @@ procedure TSimbaShapeBox.DoShapePrintClick(Sender: TObject);
     SimbaDebugLn([EDebugLn.FOCUS], FShapes[FListBox.ItemIndex].ToStr);
 end;
 
+procedure TSimbaShapeBox.DoShapeCopyClick(Sender: TObject);
+begin
+  if CheckIndex(FListBox.ItemIndex) then
+    InternalAddShape(FShapes[FListBox.ItemIndex].CreateCopy());
+end;
+
 function TSimbaShapeBox.GetShapeAt(P: TPoint): TSimbaShapeBoxShape;
 var
   I: Integer;
@@ -1222,6 +1270,25 @@ procedure TSimbaShapeBox.LoadFromFile(FileName: String);
   end;
 end;
 
+function TSimbaShapeBox.CopyShape(Index: Integer): Integer;
+var
+  NewName: String;
+begin
+  Result := -1;
+
+  if CheckIndex(Index) then
+  begin
+    NewName := FShapes[Index].FName;
+    if FQueryNameOnNew and (not InputQuery('Simba', 'Enter name', NewName)) then
+      Exit;
+    InternalAddShape(FShapes[Index].CreateCopy());
+    if FQueryNameOnNew then
+      InternalNameShape(FListBox.ItemIndex, NewName);
+
+    Result := FListBox.ItemIndex;
+  end;
+end;
+
 procedure TSimbaShapeBox.DeleteShape(Index: Integer);
 begin
   InternalDeleteShape(Index);
@@ -1294,6 +1361,17 @@ constructor TSimbaShapeBox.Create(AOwner: TComponent);
     BorderSpacing.Around := 5;
   end;
 
+  FCopyButton := TButton.Create(FPanel);
+  with FCopyButton do
+  begin
+    Parent := FPanel;
+    Align := alBottom;
+    Caption := 'Copy Shape';
+    OnClick := @DoShapeCopyClick;
+    AutoSize := True;
+    BorderSpacing.Around := 5;
+  end;
+
   FPrintButton := TButton.Create(FPanel);
   with FPrintButton do
   begin