Browse Source

Removed EmptyImage.Allow, so is always allowed (bug #189), CopyPropertiesToArea and Icons in NewCropAreaDefault, Updated Component icon and Demo)

Removed EmptyImage.Allow, so is always allowed (bug #189),
CopyPropertiesToArea and Icons in NewCropAreaDefault,
Updated Component icon and Demo
Massimo Magnano 1 year ago
parent
commit
f3bf78a2f6

+ 33 - 22
bgraimagemanipulation.pas

@@ -75,6 +75,12 @@ unit BGRAImageManipulation;
              - CropArea Rotate and Flip
              - CropArea Rotate and Flip
              - CropArea Duplicate and SetSize
              - CropArea Duplicate and SetSize
              - NewCropAreaDefault property (to Cm); ResolutionUnitConvert function; SetEmptyImageSizeToCropAreas
              - NewCropAreaDefault property (to Cm); ResolutionUnitConvert function; SetEmptyImageSizeToCropAreas
+      -10    - Load/Save XML Path Parameters, ContextMenu, UserData in GetAllBitmapCallback, CropArea Icons
+  2024-01    - Added CopyProperties to GetBitmap methods
+      -06    - Solved Bugs when load/save from xml
+      -08    - Removed EmptyImage.Allow, so is always allowed
+               CopyPropertiesToArea and Icons in NewCropAreaDefault
+               Updated Component icon
   ============================================================================
   ============================================================================
 }
 }
 
 
@@ -292,7 +298,6 @@ type
   TBGRAEmptyImage = class(TPersistent)
   TBGRAEmptyImage = class(TPersistent)
   private
   private
     fOwner: TBGRAImageManipulation;
     fOwner: TBGRAImageManipulation;
-    rAllow: Boolean;
     rResolutionHeight: Single;
     rResolutionHeight: Single;
     rResolutionUnit: TResolutionUnit;
     rResolutionUnit: TResolutionUnit;
     rResolutionWidth: Single;
     rResolutionWidth: Single;
@@ -309,7 +314,6 @@ type
     constructor Create(AOwner: TBGRAImageManipulation);
     constructor Create(AOwner: TBGRAImageManipulation);
 
 
   published
   published
-    property Allow: Boolean read rAllow write rAllow default False;
     property ResolutionUnit: TResolutionUnit read rResolutionUnit write SetResolutionUnit default ruPixelsPerCentimeter;
     property ResolutionUnit: TResolutionUnit read rResolutionUnit write SetResolutionUnit default ruPixelsPerCentimeter;
     property ResolutionWidth: Single read rResolutionWidth write rResolutionWidth;
     property ResolutionWidth: Single read rResolutionWidth write rResolutionWidth;
     property ResolutionHeight: Single read rResolutionHeight write rResolutionHeight;
     property ResolutionHeight: Single read rResolutionHeight write rResolutionHeight;
@@ -322,13 +326,17 @@ type
   private
   private
     fOwner: TBGRAImageManipulation;
     fOwner: TBGRAImageManipulation;
     rAspectRatio: string;
     rAspectRatio: string;
+    rIcons: TCropAreaIcons;
     rKeepAspectRatio: BoolParent;
     rKeepAspectRatio: BoolParent;
     rResolutionUnit: TResolutionUnit;
     rResolutionUnit: TResolutionUnit;
 
 
   public
   public
     constructor Create(AOwner: TBGRAImageManipulation);
     constructor Create(AOwner: TBGRAImageManipulation);
 
 
+    procedure CopyPropertiesToArea(ANewArea: TCropArea);
+
   published
   published
+    property Icons: TCropAreaIcons read rIcons write rIcons;
     property ResolutionUnit: TResolutionUnit read rResolutionUnit write rResolutionUnit default ruPixelsPerCentimeter;
     property ResolutionUnit: TResolutionUnit read rResolutionUnit write rResolutionUnit default ruPixelsPerCentimeter;
     property AspectRatio: string read rAspectRatio write rAspectRatio;
     property AspectRatio: string read rAspectRatio write rAspectRatio;
     property KeepAspectRatio: BoolParent read rKeepAspectRatio write rKeepAspectRatio default bFalse;
     property KeepAspectRatio: BoolParent read rKeepAspectRatio write rKeepAspectRatio default bFalse;
@@ -1854,7 +1862,6 @@ constructor TBGRAEmptyImage.Create(AOwner: TBGRAImageManipulation);
 begin
 begin
   inherited Create;
   inherited Create;
   fOwner :=AOwner;
   fOwner :=AOwner;
-  rAllow :=False;
   rShowBorder :=False;
   rShowBorder :=False;
   rResolutionUnit:=ruPixelsPerCentimeter;
   rResolutionUnit:=ruPixelsPerCentimeter;
 end;
 end;
@@ -1868,6 +1875,14 @@ begin
   rKeepAspectRatio:=bFalse;
   rKeepAspectRatio:=bFalse;
   rAspectRatio:='3:4';
   rAspectRatio:='3:4';
   rResolutionUnit:=ruPixelsPerCentimeter;
   rResolutionUnit:=ruPixelsPerCentimeter;
+  rIcons:= [];
+end;
+
+procedure TBGRANewCropAreaDefault.CopyPropertiesToArea(ANewArea: TCropArea);
+begin
+  ANewArea.rIcons:= Self.rIcons;
+  ANewArea.rAspectRatio:= Self.rAspectRatio;
+  ANewArea.KeepAspectRatio:= Self.rKeepAspectRatio;
 end;
 end;
 
 
 { TBGRAImageManipulation }
 { TBGRAImageManipulation }
@@ -2678,7 +2693,7 @@ procedure TBGRAImageManipulation.Loaded;
 begin
 begin
   inherited Loaded;
   inherited Loaded;
 
 
-  if Self.Empty and rEmptyImage.Allow then
+  if Self.Empty then
   begin
   begin
     CreateEmptyImage;
     CreateEmptyImage;
     CreateResampledBitmap;
     CreateResampledBitmap;
@@ -2875,7 +2890,7 @@ begin
   inherited Resize;
   inherited Resize;
 
 
   //MaxM: Maybe csLoading in ComponentState but it does not work
   //MaxM: Maybe csLoading in ComponentState but it does not work
-  if rLoading then exit;
+  //if rLoading then exit;
 
 
   if (fVirtualScreen <> nil) then
   if (fVirtualScreen <> nil) then
   begin
   begin
@@ -2883,7 +2898,7 @@ begin
       min(Self.Height, (fBorderSize * 2 + fAnchorSize + fMinHeight)));
       min(Self.Height, (fBorderSize * 2 + fAnchorSize + fMinHeight)));
     fVirtualScreen.InvalidateBitmap;
     fVirtualScreen.InvalidateBitmap;
 
 
-    if Self.Empty and rEmptyImage.Allow
+    if Self.Empty
     then CreateEmptyImage;
     then CreateEmptyImage;
 
 
     CreateResampledBitmap;
     CreateResampledBitmap;
@@ -2941,7 +2956,7 @@ begin
     FillColor := BGRA(0, 0, 0, 128);
     FillColor := BGRA(0, 0, 0, 128);
     Mask := TBGRABitmap.Create(WorkRect.Right - WorkRect.Left, WorkRect.Bottom - WorkRect.Top, FillColor);
     Mask := TBGRABitmap.Create(WorkRect.Right - WorkRect.Left, WorkRect.Bottom - WorkRect.Top, FillColor);
 
 
-    if Self.Empty and rEmptyImage.Allow and rEmptyImage.ShowBorder then
+    if Self.Empty and rEmptyImage.ShowBorder then
     begin
     begin
       emptyRect :=Rect(0,0,fResampledBitmap.Width-1, fResampledBitmap.Height-1);
       emptyRect :=Rect(0,0,fResampledBitmap.Width-1, fResampledBitmap.Height-1);
       Mask.CanvasBGRA.Frame3d(emptyRect, 1, bvRaised, BGRA(255, 255, 255, 180), BGRA(0, 0, 0, 160));
       Mask.CanvasBGRA.Frame3d(emptyRect, 1, bvRaised, BGRA(255, 255, 255, 180), BGRA(0, 0, 0, 160));
@@ -2979,6 +2994,7 @@ begin
           BorderColor, BGRAPixelTransparent, 1, False);
           BorderColor, BGRAPixelTransparent, 1, False);
 
 
       //Draw Icons
       //Draw Icons
+      { #todo 1 -oMaxM : Draw Other Icons }
       if (cIcoIndex in curCropArea.Icons) then
       if (cIcoIndex in curCropArea.Icons) then
       begin
       begin
         TextS.Alignment:=taCenter;
         TextS.Alignment:=taCenter;
@@ -3192,11 +3208,7 @@ begin
   begin
   begin
     try
     try
       if Value.Empty or (Value.Width = 0) or (Value.Height = 0)
       if Value.Empty or (Value.Width = 0) or (Value.Height = 0)
-      then begin
-             if EmptyImage.Allow
-             then CreateEmptyImage
-             else exit;
-           end
+      then CreateEmptyImage
       else begin
       else begin
              // Clear actual image
              // Clear actual image
              fImageBitmap.Free;
              fImageBitmap.Free;
@@ -3234,9 +3246,8 @@ var
 
 
 begin
 begin
   try
   try
-    // Prevent empty image if not Allowed
-    if Self.Empty and not(rEmptyImage.Allow)
-    then exit;
+    // Prevent empty image
+    if Self.Empty then exit;
 
 
     // Rotate bitmap
     // Rotate bitmap
     TempBitmap := fImageBitmap.RotateCCW(ACopyProperties);
     TempBitmap := fImageBitmap.RotateCCW(ACopyProperties);
@@ -3272,9 +3283,8 @@ var
 
 
 begin
 begin
   try
   try
-    // Prevent empty image if not Allowed
-    if Self.Empty and not(rEmptyImage.Allow)
-    then exit;
+    // Prevent empty image
+    if Self.Empty then exit;
 
 
     // Rotate bitmap
     // Rotate bitmap
     TempBitmap := fImageBitmap.RotateCW(ACopyProperties);
     TempBitmap := fImageBitmap.RotateCW(ACopyProperties);
@@ -3317,7 +3327,10 @@ var
 begin
 begin
   try
   try
      newCropArea :=TCropArea.Create(Self, AArea, AAreaUnit, AUserData);
      newCropArea :=TCropArea.Create(Self, AArea, AAreaUnit, AUserData);
-     newCropArea.BorderColor :=BGRAWhite;
+
+     newCropArea.BorderColor:= BGRAWhite;
+     rNewCropAreaDefault.CopyPropertiesToArea(newCropArea);
+
      rCropAreas.add(newCropArea);
      rCropAreas.add(newCropArea);
 
 
      if (rSelectedCropArea = nil)
      if (rSelectedCropArea = nil)
@@ -3340,8 +3353,6 @@ end;
 function TBGRAImageManipulation.addScaledCropArea(AArea: TRect; AUserData: Integer): TCropArea;
 function TBGRAImageManipulation.addScaledCropArea(AArea: TRect; AUserData: Integer): TCropArea;
 begin
 begin
      Result :=Self.addCropArea(RectF(0,0,0,0), rNewCropAreaDefault.rResolutionUnit, AUserData);
      Result :=Self.addCropArea(RectF(0,0,0,0), rNewCropAreaDefault.rResolutionUnit, AUserData);
-     Result.rAspectRatio:=rNewCropAreaDefault.rAspectRatio;
-     Result.KeepAspectRatio:=rNewCropAreaDefault.rKeepAspectRatio;
      Result.ScaledArea :=AArea;
      Result.ScaledArea :=AArea;
 
 
      if (fMouseCaught)
      if (fMouseCaught)
@@ -3430,7 +3441,7 @@ var
    xRatio, yRatio, resX :Single;
    xRatio, yRatio, resX :Single;
 
 
 begin
 begin
-  if Self.Empty and rEmptyImage.Allow and (rCropAreas.Count>0) then
+  if Self.Empty and (rCropAreas.Count>0) then
   begin
   begin
      if ReduceLarger
      if ReduceLarger
      then begin
      then begin

BIN
images/bgracontrols_images.res


+ 1 - 0
images/bgracontrols_images_list.txt

@@ -76,6 +76,7 @@ tbgratheme_200.png
 tbgracolortheme.png
 tbgracolortheme.png
 tbgracolortheme_150.png
 tbgracolortheme_150.png
 tbgracolortheme_200.png
 tbgracolortheme_200.png
+tbgraimagemanipulation.png
 tbgraimagetheme.png
 tbgraimagetheme.png
 tbgraimagetheme_150.png
 tbgraimagetheme_150.png
 tbgraimagetheme_200.png
 tbgraimagetheme_200.png

BIN
images/tbgraimagemanipulation.png


+ 29 - 11
test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm

@@ -1,10 +1,10 @@
 object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
 object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
-  Left = 291
-  Height = 513
-  Top = 220
+  Left = 262
+  Height = 543
+  Top = 84
   Width = 926
   Width = 926
   Caption = 'Demonstration of TBGRAImageManipulation'
   Caption = 'Demonstration of TBGRAImageManipulation'
-  ClientHeight = 513
+  ClientHeight = 543
   ClientWidth = 926
   ClientWidth = 926
   ShowHint = True
   ShowHint = True
   LCLVersion = '3.99.0.0'
   LCLVersion = '3.99.0.0'
@@ -12,7 +12,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
   OnCreate = FormCreate
   OnCreate = FormCreate
   object Background: TBCPanel
   object Background: TBCPanel
     Left = 678
     Left = 678
-    Height = 513
+    Height = 543
     Top = 0
     Top = 0
     Width = 248
     Width = 248
     Align = alRight
     Align = alRight
@@ -1615,7 +1615,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
   end
   end
   object BGRAImageManipulation: TBGRAImageManipulation
   object BGRAImageManipulation: TBGRAImageManipulation
     Left = 198
     Left = 198
-    Height = 513
+    Height = 543
     Top = 0
     Top = 0
     Width = 480
     Width = 480
     Align = alClient
     Align = alClient
@@ -1623,10 +1623,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     AspectRatio = '3:4'
     AspectRatio = '3:4'
     MinHeight = 40
     MinHeight = 40
     MinWidth = 30
     MinWidth = 30
-    EmptyImage.Allow = True
     EmptyImage.ResolutionWidth = 21
     EmptyImage.ResolutionWidth = 21
     EmptyImage.ResolutionHeight = 29.7000007629395
     EmptyImage.ResolutionHeight = 29.7000007629395
     EmptyImage.ShowBorder = True
     EmptyImage.ShowBorder = True
+    NewCropAreaDefault.Icons = [cIcoIndex]
     NewCropAreaDefault.AspectRatio = '3:4'
     NewCropAreaDefault.AspectRatio = '3:4'
     OnCropAreaAdded = AddedCrop
     OnCropAreaAdded = AddedCrop
     OnCropAreaDeleted = DeletedCrop
     OnCropAreaDeleted = DeletedCrop
@@ -1635,7 +1635,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
   end
   end
   object BCPanelCropAreas: TBCPanel
   object BCPanelCropAreas: TBCPanel
     Left = 0
     Left = 0
-    Height = 513
+    Height = 543
     Top = 0
     Top = 0
     Width = 198
     Width = 198
     Align = alLeft
     Align = alLeft
@@ -1722,7 +1722,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     object BCPanelCropAreaLoad: TBCPanel
     object BCPanelCropAreaLoad: TBCPanel
       Left = 1
       Left = 1
       Height = 106
       Height = 106
-      Top = 406
+      Top = 436
       Width = 196
       Width = 196
       Align = alBottom
       Align = alBottom
       Background.Color = clBtnFace
       Background.Color = clBtnFace
@@ -2206,7 +2206,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     end
     end
     object BCPanelCropArea: TBCPanel
     object BCPanelCropArea: TBCPanel
       Left = 0
       Left = 0
-      Height = 360
+      Height = 384
       Top = 48
       Top = 48
       Width = 186
       Width = 186
       Background.Color = clBtnFace
       Background.Color = clBtnFace
@@ -2279,7 +2279,7 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Left = 20
         Left = 20
         Height = 15
         Height = 15
         Top = 95
         Top = 95
-        Width = 26
+        Width = 25
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.StartColor = clWhite
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.EndColor = clBlack
         Background.Gradient1.GradientType = gtLinear
         Background.Gradient1.GradientType = gtLinear
@@ -3134,6 +3134,24 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         }
         }
         GroupIndex = 1
         GroupIndex = 1
       end
       end
+      object cbIconIndex: TCheckBox
+        Left = 48
+        Height = 19
+        Top = 359
+        Width = 47
+        Caption = 'Index'
+        Checked = True
+        State = cbChecked
+        TabOrder = 8
+        OnChange = cbIconIndexChange
+      end
+      object Label4: TLabel
+        Left = 7
+        Height = 15
+        Top = 359
+        Width = 34
+        Caption = 'Icons :'
+      end
     end
     end
     object btCropDuplicate: TSpeedButton
     object btCropDuplicate: TSpeedButton
       Left = 172
       Left = 172

+ 15 - 4
test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas

@@ -43,6 +43,7 @@ unit UnitBGRAImageManipulationDemo;
   2013-10-13 - Massimo Magnano
   2013-10-13 - Massimo Magnano
              - Add multi crop demo
              - Add multi crop demo
   2023-08    - Resolution, Save in various formats, Z Order
   2023-08    - Resolution, Save in various formats, Z Order
+  2024-08    - Icons in CropArea
 
 
   ============================================================================
   ============================================================================
 }
 }
@@ -55,7 +56,7 @@ uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
   Buttons, ExtDlgs, ComCtrls, ExtCtrls, Menus, Spin,
   Buttons, ExtDlgs, ComCtrls, ExtCtrls, Menus, Spin,
   {$IFDEF FPC} FPImage,{$ENDIF} BGRAImageManipulation,
   {$IFDEF FPC} FPImage,{$ENDIF} BGRAImageManipulation,
-  BGRABitmap, BGRABitmapTypes, BCPanel, BCButton, BGRASpeedButton, BCLabel, Laz2_XMLCfg;
+  BGRABitmap, BGRABitmapTypes, BCPanel, BCButton, BGRASpeedButton, BCLabel;
 
 
 type
 type
 
 
@@ -96,6 +97,7 @@ type
     btCRotateRight: TSpeedButton;
     btCRotateRight: TSpeedButton;
     btCRotateLeft: TSpeedButton;
     btCRotateLeft: TSpeedButton;
     cbBoxList: TComboBox;
     cbBoxList: TComboBox;
+    cbIconIndex: TCheckBox;
     chkFullSize: TCheckBox;
     chkFullSize: TCheckBox;
     cbSaveFormat: TComboBox;
     cbSaveFormat: TComboBox;
     chkCopyProperties: TCheckBox;
     chkCopyProperties: TCheckBox;
@@ -111,6 +113,7 @@ type
     Label1: TLabel;
     Label1: TLabel;
     Label2: TLabel;
     Label2: TLabel;
     Label3: TLabel;
     Label3: TLabel;
+    Label4: TLabel;
     lbResolution: TLabel;
     lbResolution: TLabel;
     lbAspectRatio:     TLabel;
     lbAspectRatio:     TLabel;
     lbOptions:         TLabel;
     lbOptions:         TLabel;
@@ -150,6 +153,7 @@ type
     procedure btZDownClick(Sender: TObject);
     procedure btZDownClick(Sender: TObject);
     procedure btZFrontClick(Sender: TObject);
     procedure btZFrontClick(Sender: TObject);
     procedure btZUpClick(Sender: TObject);
     procedure btZUpClick(Sender: TObject);
+    procedure cbIconIndexChange(Sender: TObject);
     procedure edNameChange(Sender: TObject);
     procedure edNameChange(Sender: TObject);
     procedure edUnit_TypeChange(Sender: TObject);
     procedure edUnit_TypeChange(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
@@ -192,7 +196,7 @@ implementation
 
 
 {$R *.lfm}
 {$R *.lfm}
 
 
-uses BGRAWriteBMP, BGRAReadWriteConfig;
+//uses BGRAWriteBMP, BGRAReadWriteConfig;
 
 
 const
 const
   ResUnitStr :array[TResolutionUnit] of String = ('ruNone', 'ruPixelsPerInch', 'ruPixelsPerCentimeter');
   ResUnitStr :array[TResolutionUnit] of String = ('ruNone', 'ruPixelsPerInch', 'ruPixelsPerCentimeter');
@@ -529,6 +533,13 @@ begin
        end;
        end;
 end;
 end;
 
 
+procedure TFormBGRAImageManipulationDemo.cbIconIndexChange(Sender: TObject);
+begin
+  if cbIconIndex.Checked
+  then BGRAImageManipulation.NewCropAreaDefault.Icons:= [cIcoIndex]
+  else BGRAImageManipulation.NewCropAreaDefault.Icons:= [];
+end;
+
 procedure TFormBGRAImageManipulationDemo.edNameChange(Sender: TObject);
 procedure TFormBGRAImageManipulationDemo.edNameChange(Sender: TObject);
 var
 var
    CropArea :TCropArea;
    CropArea :TCropArea;
@@ -756,12 +767,12 @@ begin
 end;
 end;
 
 
 procedure TFormBGRAImageManipulationDemo.SpeedButton1Click(Sender: TObject);
 procedure TFormBGRAImageManipulationDemo.SpeedButton1Click(Sender: TObject);
-var
+(*var
    img, img2:TBGRABitmap;
    img, img2:TBGRABitmap;
    wr:TBGRAWriterBMP;
    wr:TBGRAWriterBMP;
    wp:TFPPalette;
    wp:TFPPalette;
    ReadWriteConfig, ReadWriteConfig2: TBGRAReadWriteConfig;
    ReadWriteConfig, ReadWriteConfig2: TBGRAReadWriteConfig;
-
+*)
 begin
 begin
   //BGRAImageManipulation.SetEmptyImageSizeToCropAreas(False);
   //BGRAImageManipulation.SetEmptyImageSizeToCropAreas(False);
  (*
  (*