2
0
Эх сурвалжийг харах

ImageManipulation use of TUniversalDrawer.CreateBGRAImageWriter in Save methods; Updated Demo to use our readers/writers and the same input format

ImageManipulation use of TUniversalDrawer.CreateBGRAImageWriter in Save methods;
Updated Demo to use our readers/writers and the same input format
Massimo Magnano 11 сар өмнө
parent
commit
cdb1791f7e

+ 5 - 28
bgraimagemanipulation.pas

@@ -480,9 +480,9 @@ type
     procedure LoadFromStream(AStream: TStream; AHandler:TFPCustomImageReader; AOptions: TBGRALoadingOptions); overload;
 
     procedure SaveToFile(const AFilename: String); overload;
-    procedure SaveToFile(const AFilename: String; AFormat: TBGRAImageFormat; AHandler:TFPCustomImageWriter); overload;
+    procedure SaveToFile(const AFilename: String; AFormat: TBGRAImageFormat; AHandler:TFPCustomImageWriter=nil); overload;
     procedure SaveToFileUTF8(const AFilenameUTF8: String); overload;
-    procedure SaveToFileUTF8(const AFilenameUTF8: String; AFormat: TBGRAImageFormat; AHandler:TFPCustomImageWriter); overload;
+    procedure SaveToFileUTF8(const AFilenameUTF8: String; AFormat: TBGRAImageFormat; AHandler:TFPCustomImageWriter=nil); overload;
     procedure SaveToStream(AStream: TStream; AFormat: TBGRAImageFormat; AHandler:TFPCustomImageWriter=nil); overload;
 
     property SelectedCropArea :TCropArea read rSelectedCropArea write setSelectedCropArea;
@@ -3637,22 +3637,8 @@ var
   ext: String;
 
 begin
-  format := SuggestImageFormat(AFilenameUTF8);
-  if (format = ifXPixMap) and (fImageBitmap.NbPixels > 32768) then //xpm is slow so avoid big images
-    raise exception.Create('Image is too big to be saved as XPM');
-  writer := CreateBGRAImageWriter(Format, fImageBitmap.HasTransparentPixels);
-  if writer is TBGRAWriterPNG then
-  begin
-    if TUniversalDrawer.GetMaxColorChannelDepth(fImageBitmap) > 8 then TBGRAWriterPNG(writer).WordSized := true;
-  end;
-  if writer is TFPWriterPNM then
-  begin
-    ext := LowerCase(ExtractFileExt(AFilenameUTF8));
-    if ext = '.pbm' then TFPWriterPNM(writer).ColorDepth:= pcdBlackWhite else
-    if ext = '.pgm' then TFPWriterPNM(writer).ColorDepth:= pcdGrayscale else
-    if ext = '.ppm' then TFPWriterPNM(writer).ColorDepth:= pcdRGB;
-  end;
   try
+    writer:= TUniversalDrawer.CreateBGRAImageWriter(fImageBitmap, AFilenameUTF8, format);
     SaveToFileUTF8(AFilenameUTF8, format, writer);
   finally
     writer.free;
@@ -3681,18 +3667,9 @@ var
 
 begin
   HandlerNil:= (AHandler = nil);
-
-  if HandlerNil then
-  begin
-    if (AFormat = ifXPixMap) and (fImageBitmap.NbPixels > 32768) then //xpm is slow so avoid big images
-      raise exception.Create('Image is too big to be saved as XPM');
-    AHandler := CreateBGRAImageWriter(AFormat, fImageBitmap.HasTransparentPixels);
-    if AHandler is TBGRAWriterPNG then
-    begin
-      if TUniversalDrawer.GetMaxColorChannelDepth(fImageBitmap) > 8 then TBGRAWriterPNG(AHandler).WordSized := true;
-    end;
-  end;
   try
+     if HandlerNil then AHandler:= TUniversalDrawer.CreateBGRAImageWriter(fImageBitmap, AFormat);
+
      if Assigned(rOnBitmapSaveBefore) then rOnBitmapSaveBefore(Self, AStream, AFormat, AHandler);
 
      TFPCustomImage(fImageBitmap).SaveToStream(AStream, AHandler);

+ 11 - 3
test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.lfm

@@ -7,7 +7,6 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
   ClientHeight = 543
   ClientWidth = 926
   ShowHint = True
-  LCLVersion = '4.99.0.0'
   OnCloseQuery = FormCloseQuery
   OnCreate = FormCreate
   object Background: TBCPanel
@@ -1438,9 +1437,9 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     end
     object SpeedButton1: TSpeedButton
       Left = 208
-      Height = 19
+      Height = 25
       Top = 56
-      Width = 32
+      Width = 38
       AutoSize = True
       Caption = ':Tests'
       OnClick = SpeedButton1Click
@@ -1612,6 +1611,13 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
       State = cbChecked
       TabOrder = 5
     end
+    object lbFormat: TLabel
+      Left = 0
+      Height = 15
+      Top = 160
+      Width = 47
+      Caption = 'Format : '
+    end
   end
   object BGRAImageManipulation: TBGRAImageManipulation
     Left = 198
@@ -1632,6 +1638,8 @@ object FormBGRAImageManipulationDemo: TFormBGRAImageManipulationDemo
     OnCropAreaDeleted = DeletedCrop
     OnCropAreaChanged = ChangedCrop
     OnSelectedCropAreaChanged = SelectedChangedCrop
+    OnBitmapLoadAfter = BGRAImageManipulationBitmapLoadAfter
+    OnBitmapSaveBefore = BGRAImageManipulationBitmapSaveBefore
   end
   object BCPanelCropAreas: TBCPanel
     Left = 0

+ 148 - 14
test/test_bgraimagemanipulation/unitbgraimagemanipulationdemo.pas

@@ -119,6 +119,7 @@ type
     lbOptions:         TLabel;
     lbCompression:     TLabel;
     lbOptions1: TLabel;
+    lbFormat: TLabel;
     OpenCropList: TOpenDialog;
     OpenPictureDialog: TOpenPictureDialog;
     rgAspect: TRadioGroup;
@@ -132,6 +133,10 @@ type
     btZDown: TSpeedButton;
     btZUp: TSpeedButton;
     btCropDuplicateOp: TSpeedButton;
+    procedure BGRAImageManipulationBitmapLoadAfter(Sender: TBGRAImageManipulation; AStream: TStream;
+      AFormat: TBGRAImageFormat; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);
+    procedure BGRAImageManipulationBitmapSaveBefore(Sender: TBGRAImageManipulation; AStream: TStream;
+      AFormat: TBGRAImageFormat; AHandler: TFPCustomImageWriter);
     procedure btCFlipHLeftClick(Sender: TObject);
     procedure btCFlipHRightClick(Sender: TObject);
     procedure btCFlipVDownClick(Sender: TObject);
@@ -180,6 +185,10 @@ type
     lastNewBoxNum :Word;
     changingAspect, closing,
     inFillBoxUI :Boolean;
+    sourceFormat,
+    destFormat: TBGRAImageFormat;
+
+    jpgGray: Boolean;
 
     function GetCurrentCropArea: TCropArea;
     procedure FillBoxUI(ABox :TCropArea);
@@ -196,7 +205,7 @@ implementation
 
 {$R *.lfm}
 
-//uses BGRAWriteBMP, BGRAReadWriteConfig;
+uses UniversalDrawer, BGRAReadJpeg, BGRAWriteJpeg;
 
 const
   ResUnitStr :array[TResolutionUnit] of String = ('ruNone', 'ruPixelsPerInch', 'ruPixelsPerCentimeter');
@@ -207,20 +216,14 @@ procedure TFormBGRAImageManipulationDemo.btnOpenPictureClick(Sender: TObject);
 var
   Bitmap: TBGRABitmap;
   test:Integer;
-//  reader:TFPCustomImageReader;
+  tt:TPicture;
 
 begin
   // To put a new image in the component, you will simply need execute open
   // picture dialog to locate an image...
   if OpenPictureDialog.Execute then
   begin
-(*    // ...and create a new TBGRABitmap and load to it
-    Bitmap := TBGRABitmap.Create;
-    Bitmap.LoadFromFile(OpenPictureDialog.FileName);
-    // Finally, associate the image into component
-    BGRAImageManipulation.Bitmap := Bitmap;
-    Bitmap.Free;
-*)
+    //...and load it
     BGRAImageManipulation.LoadFromFile(OpenPictureDialog.FileName);
 
     lbResolution.Caption:='Resolution : '+#13#10+'  '+
@@ -325,6 +328,49 @@ begin
   end;
 end;
 
+procedure TFormBGRAImageManipulationDemo.BGRAImageManipulationBitmapLoadAfter(Sender: TBGRAImageManipulation;
+  AStream: TStream; AFormat: TBGRAImageFormat; AHandler: TFPCustomImageReader; AOptions: TBGRALoadingOptions);
+var
+   i: Integer;
+
+begin
+  sourceFormat:= AFormat;
+  //Store AHandler properties
+  case sourceFormat of
+    ifJpeg: begin
+      if (AHandler is TBGRAReaderJPEG) then
+      begin
+        { #todo -oMaxM : only a Test, we should save the reader properties so we can use them in the writer, but how? }
+        jpgGray:= TBGRAReaderJPEG(AHandler).GrayScale;
+      end;
+    end;
+  end;
+
+  //Find Loaded Format and select it
+  i:= cbSaveFormat.Items.IndexOfObject(TObject(PtrUInt(sourceFormat)));
+  if (i < 0) then i:= cbSaveFormat.Items.IndexOfObject(TObject(PtrUInt(ifJpeg)));
+
+  if (i >= 0) then
+  begin
+    lbFormat.Caption:= 'Format: '+DefaultBGRAImageTypeNames[TBGRAImageFormat(PtrUint(cbSaveFormat.Items.Objects[i]))];
+    RateCompression.Enabled:= TBGRAImageFormat(PtrUint(cbSaveFormat.Items.Objects[i])) = ifJpeg;
+  end;
+
+end;
+
+procedure TFormBGRAImageManipulationDemo.BGRAImageManipulationBitmapSaveBefore(Sender: TBGRAImageManipulation;
+  AStream: TStream; AFormat: TBGRAImageFormat; AHandler: TFPCustomImageWriter);
+begin
+  if (AFormat = ifJpeg) and (RateCompression.Enabled) then
+  begin
+    if (AHandler is TBGRAWriterJPEG) then
+    begin
+      TBGRAWriterJPEG(AHandler).CompressionQuality:= RateCompression.Position;
+      TBGRAWriterJPEG(AHandler).GrayScale:= jpgGray;
+    end;
+  end;
+end;
+
 procedure TFormBGRAImageManipulationDemo.btCFlipHRightClick(Sender: TObject);
 var
    CropArea :TCropArea;
@@ -410,6 +456,10 @@ end;
 procedure TFormBGRAImageManipulationDemo.btnSavePictureClick(Sender: TObject);
 var
   curBitmap :TBGRABitmap;
+  ext:String;
+  i,
+  selE:Integer;
+  destHandler: TFPCustomImageWriter;
 
 begin
   if SavePictureDialog.Execute then
@@ -419,8 +469,37 @@ begin
       then curBitmap :=BGRAImageManipulation.getBitmap(Nil, chkCopyProperties.Checked)
       else curBitmap :=BGRAImageManipulation.getResampledBitmap(Nil, chkCopyProperties.Checked);
 
-      curBitmap.SaveToFile(SavePictureDialog.FileName);
+      selE:= cbSaveFormat.ItemIndex;
+      if (selE = 0)
+      then begin
+             //Same format as Input
+             destFormat:= sourceFormat;
+           end
+      else begin
+             destFormat:= TBGRAImageFormat(PtrUInt(cbSaveFormat.Items.Objects[selE]));
+           end;
+
+      destHandler:= TUniversalDrawer.CreateBGRAImageWriter(curBitmap, destFormat);
+
+      if (destFormat = ifJpeg) and (RateCompression.Enabled) then
+      begin
+        if (destHandler is TBGRAWriterJPEG) then
+        begin
+          TBGRAWriterJPEG(destHandler).CompressionQuality:= RateCompression.Position;
+          TBGRAWriterJPEG(destHandler).GrayScale:= jpgGray;
+        end;
+      end;
+
+     ext:= SuggestImageExtension(destFormat);
+
+     // This Save with Default Properties
+     //curBitmap.SaveToFile(SavePictureDialog.FileName+'.'+ext, destFormat);
+
+     // This save with Stored Properties
+     curBitmap.SaveToFile(SavePictureDialog.FileName+'.'+ext, destHandler);
+
     finally
+      destHandler.Free;
       curBitmap.Free;
     end;
   end;
@@ -429,13 +508,50 @@ end;
 procedure TFormBGRAImageManipulationDemo.SaveCallBack(Bitmap: TBGRABitmap; CropArea: TCropArea; AUserData: Integer);
 var
   ext:String;
-  i:Integer;
+  i,
+  selE:Integer;
+  destHandler: TFPCustomImageWriter;
 
 begin
-   ext:=ImageHandlers.Extensions[cbSaveFormat.Items[cbSaveFormat.ItemIndex]];
+  try
+   selE:= cbSaveFormat.ItemIndex;
+   if (selE = 0)
+   then begin
+          //Same format as Input
+          destFormat:= sourceFormat;
+        end
+   else begin
+          destFormat:= TBGRAImageFormat(PtrUInt(cbSaveFormat.Items.Objects[selE]));
+        end;
+
+   destHandler:= TUniversalDrawer.CreateBGRAImageWriter(Bitmap, destFormat);
+
+   if (destFormat = ifJpeg) and (RateCompression.Enabled) then
+   begin
+     if (destHandler is TBGRAWriterJPEG) then
+     begin
+       TBGRAWriterJPEG(destHandler).CompressionQuality:= RateCompression.Position;
+       TBGRAWriterJPEG(destHandler).GrayScale:= jpgGray;
+     end;
+   end;
+
+  ext:= SuggestImageExtension(destFormat);
+
+  // This Save with Default Properties
+  //Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext, destFormat);
+
+  // This Save with Stored Properties
+  Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext, destHandler);
+
+  (*  ext:=ImageHandlers.Extensions[cbSaveFormat.Items[selE]];
    i :=Pos(';', ext);
    if (i>0) then ext :=Copy(ext, 1, i-1);
    Bitmap.SaveToFile(SelectDirectoryDialog1.FileName+DirectorySeparator+CropArea.Name+'.'+ext);
+*)
+
+  finally
+    destHandler.Free;
+  end;
 end;
 
 procedure TFormBGRAImageManipulationDemo.UpdateBoxList;
@@ -663,6 +779,7 @@ procedure TFormBGRAImageManipulationDemo.FormCreate(Sender: TObject);
 var
    i,j :Integer;
    t,e:String;
+   iFormat:TBGRAImageFormat;
 
 begin
    closing :=False;
@@ -671,6 +788,10 @@ begin
    lastNewBoxNum :=0;
    TStringList(cbBoxList.Items).OwnsObjects:=False;
    j:=0;
+
+   cbSaveFormat.Items.Add('Same As Input');
+
+   (* fpc Formats
    for i :=0 to ImageHandlers.Count-1 do
    begin
      t :=ImageHandlers.TypeNames[i];
@@ -678,10 +799,23 @@ begin
      if (ImageHandlers.ImageWriter[t]<>nil) then
      begin
        cbSaveFormat.Items.Add(t);
-       if (Pos('jpg', e)>0) then j:=i;
+       if (Pos('jpg', e)>0) then j:=i+1;
+     end;
+   end;
+   *)
+
+   //BGRA Formats
+   for iFormat:= low(TBGRAImageFormat) to high(TBGRAImageFormat) do
+   begin
+     if (DefaultBGRAImageWriter[iFormat]<>nil) then
+     begin
+       t:= DefaultBGRAImageTypeNames[iFormat];
+       e:= DefaultBGRAImageTypeExts[iFormat];
+       i:= cbSaveFormat.Items.AddObject(t+' ('+e+')', TObject(PtrUInt(iFormat)));
+       if (iFormat = ifJpeg) then j:=i; //if (Pos('jpg', e)>0)
      end;
    end;
-   cbSaveFormat.ItemIndex:=j-1;
+   cbSaveFormat.ItemIndex:=0;
 end;
 
 procedure TFormBGRAImageManipulationDemo.rgAspectSelectionChanged(Sender: TObject);