Added CopyProperties parameter to ImageManipulation; Updated Demo

bgraimagemanipulation.pas

@@ -205,8 +205,8 @@ type
     UserData :Integer;
     BorderColor :TBGRAPixel;
 
-    function getResampledBitmap: TBGRABitmap;
-    function getBitmap: TBGRABitmap;
+    function getResampledBitmap(ACopyProperties: Boolean=False): TBGRABitmap;
+    function getBitmap(ACopyProperties: Boolean=False): TBGRABitmap;
 
     constructor Create(AOwner: TBGRAImageManipulation; AArea: TRectF;
                        AAreaUnit: TResolutionUnit = ruNone; //Pixels
@@ -423,11 +423,11 @@ type
     destructor Destroy; override;
     procedure Invalidate; override;
     function getAspectRatioFromImage(const Value: TBGRABitmap): string;
-    function getResampledBitmap(ACropArea :TCropArea = Nil) : TBGRABitmap;
-    function getBitmap(ACropArea :TCropArea = Nil) : TBGRABitmap;
+    function getResampledBitmap(ACropArea :TCropArea = Nil; ACopyProperties: Boolean=False) : TBGRABitmap;
+    function getBitmap(ACropArea :TCropArea = Nil; ACopyProperties: Boolean=False) : TBGRABitmap;
 
-    procedure rotateLeft;
-    procedure rotateRight;
+    procedure rotateLeft(ACopyProperties: Boolean=False);
+    procedure rotateRight(ACopyProperties: Boolean=False);
 
     procedure tests;
 
@@ -437,8 +437,8 @@ type
     function addScaledCropArea(AArea : TRect; AUserData: Integer = -1) :TCropArea;
     procedure delCropArea(ACropArea :TCropArea);
     procedure clearCropAreas;
-    procedure getAllResampledBitmaps(ACallBack :TgetAllBitmapsCallback; AUserData:Integer=0);
-    procedure getAllBitmaps(ACallBack :TgetAllBitmapsCallback; AUserData:Integer=0);
+    procedure getAllResampledBitmaps(ACallBack :TgetAllBitmapsCallback; AUserData:Integer=0; ACopyProperties: Boolean=False);
+    procedure getAllBitmaps(ACallBack :TgetAllBitmapsCallback; AUserData:Integer=0; ACopyProperties: Boolean=False);
 
     procedure SetEmptyImageSizeToCropAreas(ReduceLarger: Boolean=False);
     procedure SetEmptyImageSizeToNull;
@@ -1289,7 +1289,7 @@ begin
 end;
 
 //Get Resampled Bitmap (Scaled to current scale)
-function TCropArea.getResampledBitmap: TBGRABitmap;
+function TCropArea.getResampledBitmap(ACopyProperties: Boolean=False): TBGRABitmap;
 var
   ResampledBitmap: TBGRACustomBitmap;
   CropBitmap:  TBGRABitmap;
@@ -1300,13 +1300,13 @@ begin
   try
      try
         // Create a new bitmap for cropped region in original scale
-        CropBitmap := getBitmap;
+        CropBitmap := getBitmap(ACopyProperties);
 
         // Create bitmap to put image on final scale
         Result := TBGRABitmap.Create(rScaledArea.Width, rScaledArea.Height);
 
         // Resize the cropped image to final scale
-        ResampledBitmap := CropBitmap.Resample(rScaledArea.Width, rScaledArea.Height, rmFineResample);
+        ResampledBitmap := CropBitmap.Resample(rScaledArea.Width, rScaledArea.Height, rmFineResample, ACopyProperties);
         Result.BlendImage(0, 0, ResampledBitmap, boLinearBlend);
      finally
         ResampledBitmap.Free;
@@ -1319,13 +1319,13 @@ begin
 end;
 
 //Get Original size Bitmap (not scaled to current scale)
-function TCropArea.getBitmap: TBGRABitmap;
+function TCropArea.getBitmap(ACopyProperties: Boolean=False): TBGRABitmap;
 begin
   Result :=nil;
   if not (fOwner.fImageBitmap.Empty) then
   try
      // Get the cropped image on selected region in original scale
-     Result :=fOwner.fImageBitmap.GetPart(GetPixelArea(rArea));
+     Result :=fOwner.fImageBitmap.GetPart(GetPixelArea(rArea), ACopyProperties);
   except
      if (Result<>nil)
      then FreeAndNil(Result);
@@ -3149,7 +3149,7 @@ begin
   Result := fImageBitmap.Empty or (fImageBitmap.Width = 0) or (fImageBitmap.Height = 0);
 end;
 
-function TBGRAImageManipulation.getResampledBitmap(ACropArea :TCropArea = Nil): TBGRABitmap;
+function TBGRAImageManipulation.getResampledBitmap(ACropArea :TCropArea = Nil; ACopyProperties: Boolean=False): TBGRABitmap;
 begin
   Result := fImageBitmap;
   if not (fImageBitmap.Empty) then
@@ -3157,20 +3157,19 @@ begin
       if (ACropArea = Nil)
       then ACropArea := Self.SelectedCropArea;
       if (ACropArea <> Nil)
-      then Result :=ACropArea.getResampledBitmap;
+      then Result :=ACropArea.getResampledBitmap(ACopyProperties);
   end;
 end;
 
-function TBGRAImageManipulation.getBitmap(ACropArea :TCropArea = Nil): TBGRABitmap;
+function TBGRAImageManipulation.getBitmap(ACropArea :TCropArea = Nil; ACopyProperties: Boolean=False): TBGRABitmap;
 begin
   Result := fImageBitmap;
   if not (fImageBitmap.Empty) then
   begin
       if (ACropArea = Nil)
       then ACropArea := Self.SelectedCropArea;
-
       if (ACropArea <> Nil)
-      then Result :=ACropArea.getBitmap;
+      then Result :=ACropArea.getBitmap(ACopyProperties);
   end;
 end;
 
@@ -3194,7 +3193,7 @@ begin
              fImageBitmap.Free;
              fImageBitmap :=TBGRABitmap.Create(Value.Width, Value.Height);
 
-             fImageBitmap.Assign(Value); // Associate the new bitmap
+             fImageBitmap.Assign(Value, True); // Associate the new bitmap
            end;
 
       CreateResampledBitmap;
@@ -3218,7 +3217,7 @@ begin
   end;
 end;
 
-procedure TBGRAImageManipulation.rotateLeft;
+procedure TBGRAImageManipulation.rotateLeft(ACopyProperties: Boolean=False);
 var
   TempBitmap: TBGRACustomBitmap;
   curCropArea :TCropArea;
@@ -3231,7 +3230,7 @@ begin
     then exit;
 
     // Rotate bitmap
-    TempBitmap := fImageBitmap.RotateCCW;
+    TempBitmap := fImageBitmap.RotateCCW(ACopyProperties);
     fImageBitmap.Assign(TempBitmap);
 
     CreateResampledBitmap;
@@ -3256,7 +3255,7 @@ begin
   end;
 end;
 
-procedure TBGRAImageManipulation.rotateRight;
+procedure TBGRAImageManipulation.rotateRight(ACopyProperties: Boolean=False);
 var
   TempBitmap: TBGRACustomBitmap;
   curCropArea :TCropArea;
@@ -3269,7 +3268,7 @@ begin
     then exit;
 
     // Rotate bitmap
-    TempBitmap := fImageBitmap.RotateCW;
+    TempBitmap := fImageBitmap.RotateCW(ACopyProperties);
     fImageBitmap.Assign(TempBitmap);
 
     CreateResampledBitmap;
@@ -3379,7 +3378,7 @@ begin
   Invalidate;
 end;
 
-procedure TBGRAImageManipulation.getAllResampledBitmaps(ACallBack: TgetAllBitmapsCallback; AUserData:Integer);
+procedure TBGRAImageManipulation.getAllResampledBitmaps(ACallBack: TgetAllBitmapsCallback; AUserData:Integer; ACopyProperties: Boolean=False);
 var
    i :Integer;
    curBitmap :TBGRABitmap;
@@ -3388,7 +3387,7 @@ begin
      //Get Resampled Bitmap of each CropArea and pass it to CallBack
      for i:=0 to rCropAreas.Count-1 do
      try
-        curBitmap :=rCropAreas[i].getResampledBitmap;
+        curBitmap :=rCropAreas[i].getResampledBitmap(ACopyProperties);
         ACallBack(curBitmap, rCropAreas[i], AUserData);
       finally
         if (curBitmap<>nil)
@@ -3396,7 +3395,7 @@ begin
      end;
 end;
 
-procedure TBGRAImageManipulation.getAllBitmaps(ACallBack: TgetAllBitmapsCallback; AUserData:Integer);
+procedure TBGRAImageManipulation.getAllBitmaps(ACallBack: TgetAllBitmapsCallback; AUserData:Integer; ACopyProperties: Boolean=False);
 var
    i :Integer;
    curBitmap :TBGRABitmap;
@@ -3405,7 +3404,7 @@ begin
      //Get Bitmap of each CropArea and pass it to CallBack
      for i:=0 to rCropAreas.Count-1 do
      try
-        curBitmap :=rCropAreas[i].getBitmap;
+        curBitmap :=rCropAreas[i].getBitmap(ACopyProperties);
         ACallBack(curBitmap, rCropAreas[i], AUserData);
       finally
         if (curBitmap<>nil)

test/test_bgraimagemanipulation/ProjectBGRAImageManipulationDemo.lpi

@@ -53,6 +53,11 @@
               </Win32>
             </Options>
           </Linking>
+          <Other>
+            <ConfigFile>
+              <WriteConfigFilePath Value="$(ProjOutDir)/fpclaz.cfg"/>
+            </ConfigFile>
+          </Other>
         </CompilerOptions>
       </Item2>
     </BuildModes>
@@ -133,6 +138,11 @@
         </Win32>
       </Options>
     </Linking>
+    <Other>
+      <ConfigFile>
+        <WriteConfigFilePath Value="$(ProjOutDir)/fpclaz.cfg"/>
+      </ConfigFile>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm

@@ -1,15 +1,15 @@
 object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
-  Left = 262
+  Left = 291
   Height = 513
-  Top = 125
+  Top = 220
   Width = 926
   Caption = 'Demonstration of TBGRAImageManipulation'
   ClientHeight = 513
   ClientWidth = 926
-  OnCloseQuery = FormCloseQuery
-  OnCreate = FormCreate
   ShowHint = True
   LCLVersion = '3.99.0.0'
+  OnCloseQuery = FormCloseQuery
+  OnCreate = FormCreate
   object Background: TBCPanel
     Left = 678
     Height = 513
@@ -67,11 +67,11 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Color = clWhite
       Font.Color = clWhite
       Font.Style = [fsBold]
-      OnClick = KeepAspectRatioClick
       ParentColor = False
       ParentFont = False
       State = cbChecked
       TabOrder = 1
+      OnClick = KeepAspectRatioClick
     end
     object lbOptions: TLabel
       Left = 10
@@ -1378,17 +1378,17 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       MemoryUsage = bmuHigh
     end
     object chkFullSize: TCheckBox
-      Left = 45
+      Left = 15
       Height = 19
-      Top = 368
-      Width = 150
-      Caption = 'Save Original Size picture'
+      Top = 480
+      Width = 83
+      Caption = 'Original Size'
       Checked = True
       State = cbChecked
       TabOrder = 3
     end
     object lbResolution: TLabel
-      Left = 24
+      Left = 0
       Height = 15
       Top = 95
       Width = 65
@@ -1602,6 +1602,16 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       TextApplyGlobalOpacity = False
       MemoryUsage = bmuHigh
     end
+    object chkCopyProperties: TCheckBox
+      Left = 105
+      Height = 19
+      Top = 480
+      Width = 102
+      Caption = 'Copy Properties'
+      Checked = True
+      State = cbChecked
+      TabOrder = 5
+    end
   end
   object BGRAImageManipulation: TBGRAImageManipulation
     Left = 198
@@ -1668,9 +1678,9 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Top = 20
       Width = 125
       ItemHeight = 15
-      OnChange = cbBoxListChange
       Style = csDropDownList
       TabOrder = 0
+      OnChange = cbBoxListChange
     end
     object btBox_Add: TBGRASpeedButton
       Left = 126
@@ -1680,9 +1690,9 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Width = 23
       Caption = '+'
       Flat = True
-      OnClick = btBox_AddClick
       ShowHint = True
       ParentShowHint = False
+      OnClick = btBox_AddClick
     end
     object btBox_Del: TBGRASpeedButton
       Left = 149
@@ -1692,9 +1702,9 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       Width = 23
       Caption = '-'
       Flat = True
-      OnClick = btBox_DelClick
       ShowHint = True
       ParentShowHint = False
+      OnClick = btBox_DelClick
     end
     object lbOptions1: TLabel
       Left = 0
@@ -2377,10 +2387,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
           'inchs'
           'cm'
         )
-        OnChange = edUnit_TypeChange
         Style = csDropDownList
         TabOrder = 0
         Text = 'pixels'
+        OnChange = edUnit_TypeChange
       end
       object BCLabel5: TBCLabel
         Left = 18
@@ -2454,8 +2464,8 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Top = 8
         Width = 103
         AutoSize = False
-        OnEditingDone = edNameChange
         TabOrder = 1
+        OnEditingDone = edNameChange
       end
       object edAspectPersonal: TEdit
         Left = 45
@@ -2486,8 +2496,8 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
           'Free'
           'Personal'
         )
-        OnSelectionChanged = rgAspectSelectionChanged
         TabOrder = 3
+        OnSelectionChanged = rgAspectSelectionChanged
       end
       object btApplyAspectRatio: TSpeedButton
         Left = 133
@@ -2570,10 +2580,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Font.Color = clWindowText
         Font.Name = 'Arial'
         MaxValue = 100
-        OnChange = edLeftChange
         ParentFont = False
         TabOrder = 4
         Value = 50
+        OnChange = edLeftChange
       end
       object edTop: TFloatSpinEdit
         Left = 56
@@ -2584,10 +2594,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Font.Color = clWindowText
         Font.Name = 'Arial'
         MaxValue = 100
-        OnChange = edTopChange
         ParentFont = False
         TabOrder = 5
         Value = 50
+        OnChange = edTopChange
       end
       object edWidth: TFloatSpinEdit
         Left = 56
@@ -2598,10 +2608,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Font.Color = clWindowText
         Font.Name = 'Arial'
         MaxValue = 100
-        OnChange = edWidthChange
         ParentFont = False
         TabOrder = 6
         Value = 50
+        OnChange = edWidthChange
       end
       object edHeight: TFloatSpinEdit
         Left = 56
@@ -2612,10 +2622,10 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
         Font.Color = clWindowText
         Font.Name = 'Arial'
         MaxValue = 100
-        OnChange = edHeightChange
         ParentFont = False
         TabOrder = 7
         Value = 50
+        OnChange = edHeightChange
       end
       object Label1: TLabel
         Left = 7

test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas

@@ -98,6 +98,7 @@ type
     cbBoxList: TComboBox;
     chkFullSize: TCheckBox;
     cbSaveFormat: TComboBox;
+    chkCopyProperties: TCheckBox;
     edAspectPersonal: TEdit;
     edAspectRatio:     TEdit;
     edHeight: TFloatSpinEdit;
@@ -178,7 +179,7 @@ type
 
     function GetCurrentCropArea: TCropArea;
     procedure FillBoxUI(ABox :TCropArea);
-    procedure SaveCallBack(Bitmap :TBGRABitmap; CropArea: TCropArea);
+    procedure SaveCallBack(Bitmap :TBGRABitmap; CropArea: TCropArea; AUserData:Integer);
     procedure UpdateBoxList;
   public
     { public declarations }
@@ -191,12 +192,18 @@ implementation
 
 {$R *.lfm}
 
+uses BGRAWriteBMP;
+
+const
+  ResUnitStr :array[TResolutionUnit] of String = ('ruNone', 'ruPixelsPerInch', 'ruPixelsPerCentimeter');
+
 { TFormBGRAImageManipulationDemo }
 
 procedure TFormBGRAImageManipulationDemo.btnOpenPictureClick(Sender: TObject);
 var
   Bitmap: TBGRABitmap;
   test:Integer;
+//  reader:TFPCustomImageReader;
 
 begin
   // To put a new image in the component, you will simply need execute open
@@ -211,8 +218,8 @@ begin
     Bitmap.Free;
 
     lbResolution.Caption:='Resolution : '+#13#10+'  '+
-          FloatToStr(BGRAImageManipulation.Bitmap.ResolutionX)+' x '+
-          FloatToStr(BGRAImageManipulation.Bitmap.ResolutionY)+' '+edUnit_Type.Items[Integer(BGRAImageManipulation.Bitmap.ResolutionUnit)]+#13#10+
+          FloatToStrF(BGRAImageManipulation.Bitmap.ResolutionX, ffFixed, 15, 3)+' x '+
+          FloatToStrF(BGRAImageManipulation.Bitmap.ResolutionY, ffFixed, 15, 3)+' '+ResUnitStr[BGRAImageManipulation.Bitmap.ResolutionUnit]+#13#10+
           '  '+FloatToStr(BGRAImageManipulation.Bitmap.ResolutionWidth)+' x '+FloatToStr(BGRAImageManipulation.Bitmap.ResolutionHeight)+#13#10+
           '  pixels '+IntToStr(BGRAImageManipulation.Bitmap.Width)+' x '+IntToStr(BGRAImageManipulation.Bitmap.Height);
 
@@ -403,8 +410,8 @@ begin
   begin
     try
       if (chkFullSize.Checked)
-      then curBitmap :=BGRAImageManipulation.getBitmap
-      else curBitmap :=BGRAImageManipulation.getResampledBitmap;
+      then curBitmap :=BGRAImageManipulation.getBitmap(Nil, chkCopyProperties.Checked)
+      else curBitmap :=BGRAImageManipulation.getResampledBitmap(Nil, chkCopyProperties.Checked);
 
       curBitmap.SaveToFile(SavePictureDialog.FileName);
     finally
@@ -413,7 +420,7 @@ begin
   end;
 end;
 
-procedure TFormBGRAImageManipulationDemo.SaveCallBack(Bitmap :TBGRABitmap; CropArea: TCropArea);
+procedure TFormBGRAImageManipulationDemo.SaveCallBack(Bitmap: TBGRABitmap; CropArea: TCropArea; AUserData: Integer);
 var
   ext:String;
   i:Integer;
@@ -452,8 +459,8 @@ begin
   if SelectDirectoryDialog1.Execute then
   begin
     if (chkFullSize.Checked)
-    then Self.BGRAImageManipulation.getAllBitmaps(@SaveCallBack)
-    else Self.BGRAImageManipulation.getAllResampledBitmaps(@SaveCallBack);
+    then Self.BGRAImageManipulation.getAllBitmaps(@SaveCallBack, 0, chkCopyProperties.Checked)
+    else Self.BGRAImageManipulation.getAllResampledBitmaps(@SaveCallBack, 0, chkCopyProperties.Checked);
   end;
 end;
 
@@ -749,8 +756,25 @@ begin
 end;
 
 procedure TFormBGRAImageManipulationDemo.SpeedButton1Click(Sender: TObject);
-begin
-  BGRAImageManipulation.SetEmptyImageSizeToCropAreas(False);
+var
+   img, img2:TBGRABitmap;
+   wr:TBGRAWriterBMP;
+   wp:TFPPalette;
+
+begin
+  //BGRAImageManipulation.SetEmptyImageSizeToCropAreas(False);
+ (*
+  img:=TBGRABitmap.Create('c:\Programming\Lazarus\tmp\test_0_gray.bmp');
+  wp:=img.Palette;
+  wr:=TBGRAWriterBMP.Create;
+  wr.BitsPerPixel:=8;
+  img2 :=img.GetPart(Rect(0,0,1176,1176));
+  wp:=img2.Palette;
+  img2.SaveToFile('test_a.bmp', wr);
+  wr.Free;
+  img.Free;
+  img2.Free;
+  *)
 end;
 
 function TFormBGRAImageManipulationDemo.GetCurrentCropArea: TCropArea;