support for WebP images

lazpaint/dialog/usaveoption.lfm

@@ -1,132 +1,144 @@
 object FSaveOption: TFSaveOption
   Left = 375
-  Height = 491
-  Top = 181
-  Width = 596
+  Height = 777
+  Top = 62
+  Width = 944
   BorderIcons = [biSystemMenu, biMaximize]
   Caption = 'Save'
-  ClientHeight = 491
-  ClientWidth = 596
+  ClientHeight = 777
+  ClientWidth = 944
+  DesignTimePPI = 152
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnHide = FormHide
   LCLVersion = '2.0.2.0'
   object Panel_Option: TPanel
     Left = 0
-    Height = 491
+    Height = 777
     Top = 0
-    Width = 134
+    Width = 207
     Align = alLeft
     AutoSize = True
     BevelOuter = bvNone
-    ClientHeight = 491
-    ClientWidth = 134
+    ClientHeight = 777
+    ClientWidth = 207
+    ParentFont = False
     TabOrder = 0
     object Panel_BitsPerPixel: TPanel
       Left = 0
-      Height = 187
+      Height = 237
       Top = 0
-      Width = 134
+      Width = 207
       Align = alTop
       AutoSize = True
       ChildSizing.LeftRightSpacing = 4
       ChildSizing.TopBottomSpacing = 4
       ChildSizing.Layout = cclLeftToRightThenTopToBottom
       ChildSizing.ControlsPerLine = 1
-      ClientHeight = 187
-      ClientWidth = 134
+      ClientHeight = 237
+      ClientWidth = 207
+      ParentFont = False
       TabOrder = 0
       object Label_ColorDepth: TLabel
         Left = 4
-        Height = 17
+        Height = 25
         Top = 4
-        Width = 93
+        Width = 136
         Caption = 'Color depth:'
         ParentColor = False
+        ParentFont = False
       end
       object RadioButton_2Colors: TRadioButton
         Left = 4
-        Height = 23
-        Top = 21
-        Width = 93
+        Height = 29
+        Top = 29
+        Width = 136
         Caption = '2 colors'
         OnChange = RadioButton_BitsPerPixelChange
+        ParentFont = False
         TabOrder = 0
       end
       object RadioButton_16Colors: TRadioButton
         Left = 4
-        Height = 23
-        Top = 44
-        Width = 93
+        Height = 29
+        Top = 58
+        Width = 136
         Caption = '16 colors'
         OnChange = RadioButton_BitsPerPixelChange
+        ParentFont = False
         TabOrder = 1
       end
       object RadioButton_256Colors: TRadioButton
         Left = 4
-        Height = 23
-        Top = 67
-        Width = 93
+        Height = 29
+        Top = 87
+        Width = 136
         Caption = '256 colors'
         OnChange = RadioButton_BitsPerPixelChange
+        ParentFont = False
         TabOrder = 3
       end
       object RadioButton_MioMap: TRadioButton
         Left = 4
-        Height = 23
-        Top = 90
-        Width = 93
+        Height = 29
+        Top = 116
+        Width = 136
         Caption = 'MioMap'
         OnChange = RadioButton_BitsPerPixelChange
+        ParentFont = False
         TabOrder = 5
       end
       object RadioButton_24BitsPerPixel: TRadioButton
         Left = 4
-        Height = 23
-        Top = 113
-        Width = 93
+        Height = 29
+        Top = 145
+        Width = 136
         Caption = '24 bits'
         OnChange = RadioButton_BitsPerPixelChange
+        ParentFont = False
         TabOrder = 2
       end
       object RadioButton_32BitsPerPixel: TRadioButton
         Left = 4
-        Height = 23
-        Top = 136
-        Width = 93
+        Height = 29
+        Top = 174
+        Width = 136
         Caption = '32 bits'
         Checked = True
         OnChange = RadioButton_BitsPerPixelChange
+        ParentFont = False
         TabOrder = 6
         TabStop = True
       end
       object CheckBox_Dithering: TCheckBox
         Left = 4
-        Height = 23
-        Top = 159
-        Width = 93
+        Height = 29
+        Top = 203
+        Width = 136
         Caption = 'Dithering'
         Checked = True
         OnChange = CheckBox_DitheringChange
+        ParentFont = False
         State = cbChecked
         TabOrder = 4
       end
     end
     object Panel_Quality: TPanel
       Left = 0
-      Height = 206
-      Top = 187
-      Width = 134
+      Height = 326
+      Top = 237
+      Width = 207
       Align = alTop
       BorderWidth = 4
-      ClientHeight = 206
-      ClientWidth = 134
+      ClientHeight = 326
+      ClientWidth = 207
+      ParentFont = False
       TabOrder = 1
       object TrackBar_Quality: TTrackBar
         Left = 5
-        Height = 150
-        Top = 51
-        Width = 100
+        Height = 217
+        Top = 71
+        Width = 158
         Frequency = 10
         Max = 100
         OnChange = TrackBar_QualityChange
@@ -134,142 +146,167 @@ object FSaveOption: TFSaveOption
         Position = 100
         Reversed = True
         Align = alClient
+        ParentFont = False
         TabOrder = 0
       end
       object Label1: TLabel
         Left = 5
-        Height = 17
+        Height = 25
         Top = 5
-        Width = 124
+        Width = 197
         Align = alTop
         Caption = 'Quality:'
         ParentColor = False
+        ParentFont = False
       end
       object Edit_QualityValue: TEdit
         Left = 5
-        Height = 29
-        Top = 22
-        Width = 124
+        Height = 37
+        Top = 30
+        Width = 197
         Align = alTop
+        BorderSpacing.Bottom = 4
         MaxLength = 4
         OnChange = Edit_QualityValueChange
         OnExit = Edit_QualityValueExit
+        ParentFont = False
         TabOrder = 1
       end
       object Panel_Percent: TPanel
-        Left = 105
-        Height = 150
-        Top = 51
-        Width = 24
+        Left = 163
+        Height = 217
+        Top = 71
+        Width = 39
         Align = alRight
         AutoSize = True
         BevelOuter = bvNone
-        ClientHeight = 150
-        ClientWidth = 24
+        ClientHeight = 217
+        ClientWidth = 39
+        ParentFont = False
         TabOrder = 2
         object Label_1: TLabel
           Left = 0
-          Height = 17
+          Height = 25
           Top = 0
-          Width = 24
+          Width = 39
           Align = alTop
           Caption = '100'
           ParentColor = False
+          ParentFont = False
         end
         object Label_0: TLabel
           Left = 0
-          Height = 17
-          Top = 133
-          Width = 24
+          Height = 25
+          Top = 192
+          Width = 39
           Align = alBottom
           Caption = '0'
           ParentColor = False
+          ParentFont = False
         end
         object Label_50: TLabel
           Left = 0
-          Height = 116
-          Top = 17
-          Width = 24
+          Height = 167
+          Top = 25
+          Width = 39
           Align = alClient
           Caption = '50'
           Layout = tlCenter
           ParentColor = False
+          ParentFont = False
         end
       end
+      object CheckBox_Lossless: TCheckBox
+        Left = 5
+        Height = 29
+        Top = 292
+        Width = 197
+        Align = alBottom
+        BorderSpacing.Top = 4
+        Caption = 'Lossless'
+        OnChange = CheckBox_LosslessChange
+        TabOrder = 3
+      end
     end
     object Panel_OkCancel: TPanel
       Left = 0
-      Height = 89
-      Top = 393
-      Width = 134
+      Height = 113
+      Top = 563
+      Width = 207
       Align = alTop
       AutoSize = True
       BorderWidth = 4
-      ClientHeight = 89
-      ClientWidth = 134
+      ClientHeight = 113
+      ClientWidth = 207
+      ParentFont = False
       TabOrder = 2
       object Label_Size: TLabel
         Left = 5
-        Height = 17
+        Height = 25
         Top = 5
-        Width = 124
+        Width = 197
         Align = alTop
         Caption = 'Size:'
         ParentColor = False
+        ParentFont = False
       end
       object Panel_Buttons: TPanel
-        Left = 71
-        Height = 62
-        Top = 22
-        Width = 58
+        Left = 116
+        Height = 78
+        Top = 30
+        Width = 86
         Align = alRight
         AutoSize = True
         BevelOuter = bvNone
         ChildSizing.Layout = cclLeftToRightThenTopToBottom
         ChildSizing.ControlsPerLine = 1
-        ClientHeight = 62
-        ClientWidth = 58
+        ClientHeight = 78
+        ClientWidth = 86
+        ParentFont = False
         TabOrder = 0
         object Button_OK: TButton
           Left = 0
-          Height = 31
+          Height = 39
           Top = 0
-          Width = 58
+          Width = 86
           Caption = 'OK'
           Default = True
           OnClick = Button_OKClick
+          ParentFont = False
           TabOrder = 0
         end
         object Button_Cancel: TButton
           Left = 0
-          Height = 31
-          Top = 31
-          Width = 58
+          Height = 39
+          Top = 39
+          Width = 86
           Cancel = True
           Caption = 'Cancel'
           ModalResult = 2
+          ParentFont = False
           TabOrder = 1
         end
       end
     end
   end
   object BGRAPreview: TBGRAVirtualScreen
-    Left = 134
-    Height = 491
+    Left = 207
+    Height = 777
     Top = 0
-    Width = 462
+    Width = 737
     OnRedraw = BGRAPreviewRedraw
     Align = alClient
     Alignment = taLeftJustify
     Color = clBtnFace
     ParentColor = False
+    ParentFont = False
     TabOrder = 1
   end
   object Timer_Update: TTimer
     Enabled = False
     Interval = 500
     OnTimer = Timer_UpdateTimer
-    left = 152
-    top = 32
+    left = 241
+    top = 51
   end
 end

lazpaint/dialog/usaveoption.pas

@@ -17,6 +17,7 @@ type
     BGRAPreview: TBGRAVirtualScreen;
     Button_Cancel: TButton;
     Button_OK: TButton;
+    CheckBox_Lossless: TCheckBox;
     CheckBox_Dithering: TCheckBox;
     Edit_QualityValue: TEdit;
     Label1: TLabel;
@@ -42,6 +43,7 @@ type
     procedure BGRAPreviewRedraw(Sender: TObject; Bitmap: TBGRABitmap);
     procedure Button_OKClick(Sender: TObject);
     procedure CheckBox_DitheringChange(Sender: TObject);
+    procedure CheckBox_LosslessChange(Sender: TObject);
     procedure Edit_QualityValueChange(Sender: TObject);
     procedure Edit_QualityValueExit(Sender: TObject);
     procedure FormCreate(Sender: TObject);
@@ -55,24 +57,30 @@ type
     FInit: boolean;
     FLazPaintInstance: TLazPaintCustomInstance;
     FOutputFilename: string;
-    FQualityVisible, FBitsPerPixelVisible: boolean;
-    FFlattenedOriginal, FJpegPreview: TBGRABitmap;
-    FBmpStream, FJpegStream, FPngStream: TMemoryStream;
+    FQualityVisible, FLosslessVisible, FBitsPerPixelVisible: boolean;
+    FFlattenedOriginal, FJpegPreview, FWebPPreview: TBGRABitmap;
+    FBmpStream, FJpegStream, FWebPStream, FPngStream: TMemoryStream;
     FFormTitle: string;
     FImageFormat: TBGRAImageFormat;
     FQuantizer, FQuantizer1bit: TBGRAColorQuantizer;
     FSizeCaption: string;
     function GetBmpStreamNeeded: boolean;
     procedure BmpQualityChanged;
+    function GetLosslessVisible: boolean;
     function GetPngStreamNeeded: boolean;
+    function GetWebPLossless: boolean;
     procedure PngQualityChanged;
     function GetBitsPerPixelVisible: boolean;
     function GetColorQuantizer: TBGRAColorQuantizer;
     function GetJpegPreview: TBGRABitmap;
     procedure RequireJpegStream;
+    function GetWebPPreview: TBGRABitmap;
+    procedure RequireWebPStream;
     procedure MakeBmpStreamIfNeeded;
     function GetWantedBitsPerPixel: integer;
     procedure SetJpegQuality(AValue: integer);
+    procedure SetLosslessVisible(AValue: boolean);
+    procedure SetWebPLossless(AValue: boolean);
     procedure UpdateFileSize;
     procedure UpdateFileSizeTo(AValue: int64);
     function GetJpegQuality: integer;
@@ -90,11 +98,13 @@ type
     function GetOriginalBitDepth: integer;
     procedure DoUpdateBitmap;
     procedure JpegQualityChanged;
+    procedure WebPQualityChanged;
     procedure LayoutRadioButtonDepth;
     procedure MakePngStreamIfNeeded;
   public
     { public declarations }
     property QualityVisible: boolean read GetQualityVisible write SetQualityVisible;
+    property LosslessVisible: boolean read GetLosslessVisible write SetLosslessVisible;
     property BitsPerPixelVisible: boolean read GetBitsPerPixelVisible write SetBitsPerPixelVisible;
     property LazPaintInstance: TLazPaintCustomInstance read FLazPaintInstance write SetLazPaintInstance;
     property OutputFilename: string read FOutputFilename write SetOutputFilename;
@@ -103,6 +113,8 @@ type
     property QuantizerNeeded: boolean read GetQuantizerNeeded;
     property JpegPreview: TBGRABitmap read GetJpegPreview;
     property JpegQuality: integer read GetJpegQuality write SetJpegQuality;
+    property WebPPreview: TBGRABitmap read GetWebPPreview;
+    property WebPLossless: boolean read GetWebPLossless write SetWebPLossless;
     property WantedBitsPerPixel: integer read GetWantedBitsPerPixel;
     property BmpStreamNeeded: boolean read GetBmpStreamNeeded;
     property PngStreamNeeded: boolean read GetPngStreamNeeded;
@@ -114,13 +126,13 @@ implementation
 
 uses UGraph, FPWriteJPEG, UResourceStrings, FPWriteBMP, BMPcomn,
   UMySLV, BGRAWriteBmpMioMap, BGRADithering, UFileSystem, LCScaleDPI,
-  BGRAThumbnail, BGRAIconCursor, BGRAWinResource;
+  BGRAThumbnail, BGRAIconCursor, BGRAWinResource, BGRAWriteWebP;
 
 function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean;
 var f: TFSaveOption;
 begin
   result := false;
-  if not ASkipOptions and (SuggestImageFormat(AOutputFilenameUTF8) in[ifBmp,ifJpeg,ifPng,ifIco,ifCur]) then
+  if not ASkipOptions and (SuggestImageFormat(AOutputFilenameUTF8) in[ifBmp,ifJpeg,ifWebP,ifPng,ifIco,ifCur]) then
   begin
     f := TFSaveOption.Create(nil);
     try
@@ -153,6 +165,7 @@ begin
   UpdateQualityTextBox;
   FFormTitle:= Caption;
   FQualityVisible:= false;
+  FLosslessVisible:= true;
   FBitsPerPixelVisible:= false;
   Panel_Quality.Visible := FQualityVisible;
   Panel_BitsPerPixel.Visible := FBitsPerPixelVisible;
@@ -166,8 +179,10 @@ begin
   FreeAndNil(FQuantizer);
   FreeAndNil(FQuantizer1bit);
   FreeAndNil(FJpegPreview);
+  FreeAndNil(FWebPPreview);
   FreeAndNil(FBmpStream);
   FreeAndNil(FJpegStream);
+  FreeAndNil(FWebPStream);
   FreeAndNil(FPngStream);
 end;
 
@@ -271,7 +286,12 @@ begin
   if ImageFormat = ifJpeg then
   begin
     mustFreePic:= false;
-    picture := GetJpegPreview;
+    picture := JpegPreview;
+  end else
+  if (ImageFormat = ifWebP) and not WebPLossless then
+  begin
+    mustFreePic:= false;
+    picture := WebPPreview;
   end else
   if BmpStreamNeeded and (FBmpStream = nil) then
   begin
@@ -293,6 +313,7 @@ begin
     picture := FFlattenedOriginal;
   end;
   MakePngStreamIfNeeded;
+  if ImageFormat = ifWebP then RequireWebPStream;
 
   if (Bitmap.Width = 0) or (Bitmap.Height = 0) or (picture.Width = 0) or (picture.Height = 0) then exit;
   ratioX := Bitmap.Width/picture.Width;
@@ -447,6 +468,22 @@ procedure TFSaveOption.Button_OKClick(Sender: TObject);
     end;
   end;
 
+  procedure SaveWebP;
+  var outputStream: TStream;
+  begin
+    RequireWebPStream;
+    outputStream := FileManager.CreateFileStream(FOutputFilename,fmCreate);
+    try
+      FWebPStream.Position := 0;
+      outputStream.CopyFrom(FWebPStream, FWebPStream.Size);
+      FLazPaintInstance.Config.SetDefaultJpegQuality(JpegQuality);
+      FLazPaintInstance.Config.SetDefaultWebPLossless(WebPLossless);
+      if FLazPaintInstance.Image.NbLayers = 1 then FLazPaintInstance.Image.SetSavedFlag;
+    finally
+      outputStream.Free;
+    end;
+  end;
+
 begin
   try
     Case ImageFormat of
@@ -454,6 +491,10 @@ begin
               SaveJpeg;
               ModalResult := mrOK;
             end;
+    ifWebP: begin
+              SaveWebP;
+              ModalResult := mrOK;
+            end;
     ifBmp:
       begin
         SaveBmp;
@@ -489,6 +530,12 @@ begin
   NeedBitmapUpdate(True);
 end;
 
+procedure TFSaveOption.CheckBox_LosslessChange(Sender: TObject);
+begin
+  if FInit then exit;
+  WebPQualityChanged;
+end;
+
 procedure TFSaveOption.Edit_QualityValueExit(Sender: TObject);
 begin
   if FInit then exit;
@@ -519,6 +566,11 @@ begin
   FreeAndNil(FBmpStream);
 end;
 
+function TFSaveOption.GetLosslessVisible: boolean;
+begin
+  result := FLosslessVisible;
+end;
+
 function TFSaveOption.GetPngStreamNeeded: boolean;
 begin
   result := (ImageFormat = ifPng) or
@@ -527,6 +579,11 @@ begin
           ((FFlattenedOriginal.XorMask = nil) or FFlattenedOriginal.XorMask.Empty) );
 end;
 
+function TFSaveOption.GetWebPLossless: boolean;
+begin
+  result := CheckBox_Lossless.Checked;
+end;
+
 procedure TFSaveOption.UpdateQualityTextBox;
 begin
   FInit := true;
@@ -596,6 +653,33 @@ begin
   end;
 end;
 
+function TFSaveOption.GetWebPPreview: TBGRABitmap;
+begin
+  RequireWebPStream;
+  if not Assigned(FWebPPreview) then
+  begin
+    FWebPPreview := TBGRABitmap.Create;
+    FWebPStream.Position := 0;
+    FWebPPreview.LoadFromStream(FWebPStream);
+  end;
+  result := FWebPPreview;
+end;
+
+procedure TFSaveOption.RequireWebPStream;
+var writer: TBGRAWriterWebP;
+begin
+  if not Assigned(FWebPStream) then
+  begin
+    FWebPStream := TMemoryStream.Create;
+    writer := TBGRAWriterWebP.Create;
+    writer.QualityPercent := JpegQuality;
+    writer.Lossless:= WebPLossless;
+    FFlattenedOriginal.SaveToStream(FWebPStream, writer);
+    writer.Free;
+    UpdateFileSize;
+  end;
+end;
+
 procedure TFSaveOption.MakeBmpStreamIfNeeded;
 begin
   if RadioButton_MioMap.Checked then
@@ -636,6 +720,18 @@ begin
   FInit := oldInit;
 end;
 
+procedure TFSaveOption.SetLosslessVisible(AValue: boolean);
+begin
+  if FLosslessVisible = AValue then exit;
+  FLosslessVisible := AValue;
+  CheckBox_Lossless.Visible := FLosslessVisible;
+end;
+
+procedure TFSaveOption.SetWebPLossless(AValue: boolean);
+begin
+  CheckBox_Lossless.Checked := AValue;
+end;
+
 procedure TFSaveOption.UpdateFileSize;
 var size: int64;
 begin
@@ -666,6 +762,10 @@ begin
              UpdateFileSizeTo(-1)
           else
              UpdateFileSizeTo(FJpegStream.Size);
+  ifWebP: if FWebPStream = nil then
+             UpdateFileSizeTo(-1)
+          else
+             UpdateFileSizeTo(FWebPStream.Size);
   ifPng: if FPngStream = nil then
              UpdateFileSizeTo(-1)
           else
@@ -701,7 +801,8 @@ var origBPP: integer;
 begin
   if FImageFormat=AValue then Exit;
   FImageFormat:=AValue;
-  QualityVisible := FImageFormat = ifJpeg;
+  QualityVisible := FImageFormat in[ifJpeg, ifWebP];
+  LosslessVisible := (FImageFormat = ifWebP);
   BitsPerPixelVisible := FImageFormat in[ifPng,ifBmp,ifIco,ifCur];
   if FInit then exit;
   FInit := true;
@@ -792,8 +893,12 @@ begin
   FLazPaintInstance:=AValue;
   FreeAndNil(FQuantizer);
   FreeAndNil(FQuantizer1bit);
+  FreeAndNil(FJpegStream);
   FreeAndNil(FJpegPreview);
+  FreeAndNil(FWebPStream);
+  FreeAndNil(FWebPPreview);
   JpegQuality := FLazPaintInstance.Config.DefaultJpegQuality;
+  WebPLossless := FLazPaintInstance.Config.DefaultWebPLossless;
   FFlattenedOriginal := FLazPaintInstance.Image.RenderedImage;
   UpdateFileSize;
   if LazPaintInstance.Config.DefaultSaveOptionDialogMaximized then
@@ -862,6 +967,16 @@ procedure TFSaveOption.JpegQualityChanged;
 begin
   FreeAndNil(FJpegPreview);
   FreeAndNil(FJpegStream);
+  FreeAndNil(FWebPPreview);
+  FreeAndNil(FWebPStream);
+  UpdateFileSize;
+  NeedBitmapUpdate(False);
+end;
+
+procedure TFSaveOption.WebPQualityChanged;
+begin
+  FreeAndNil(FWebPPreview);
+  FreeAndNil(FWebPStream);
   UpdateFileSize;
   NeedBitmapUpdate(False);
 end;

lazpaint/uconfig.pas

@@ -61,6 +61,8 @@ type
     procedure SetBrushes(ABrushes: TStringList);
     function DefaultJpegQuality: integer;
     procedure SetDefaultJpegQuality(value: integer);
+    function DefaultWebPLossless: boolean;
+    procedure SetDefaultWebPLossless(value: boolean);
     function DefaultSaveOptionDialogMaximized: boolean;
     procedure SetDefaultSaveOptionDialogMaximized(value: boolean);
 
@@ -1389,6 +1391,16 @@ begin
   iniOptions.WriteInteger('General','JpegQuality',value);
 end;
 
+function TLazPaintConfig.DefaultWebPLossless: boolean;
+begin
+  result := iniOptions.ReadBool('General','WebPLossless',true);
+end;
+
+procedure TLazPaintConfig.SetDefaultWebPLossless(value: boolean);
+begin
+  iniOptions.WriteBool('General','WebPLossless',value);
+end;
+
 function TLazPaintConfig.DefaultSaveOptionDialogMaximized: boolean;
 begin
   result := iniOptions.ReadBool('Window','SaveOptionDialogMaximized',false);

lazpaint/ufileextensions.pas

@@ -319,6 +319,7 @@ initialization
   RegisterPicExt('Scalable Vector Graphic','svg', [eoReadable]);
   RegisterPicExt('Targa','tga', [eoReadable,eoWritable]);
   RegisterPicExt('Tiff','tif;tiff', [eoReadable,eoWritable]);
+  RegisterPicExt('WebP','webp', [eoReadable,eoWritable]);
   RegisterPicExt('X PixMap','xpm', [eoReadable,eoWritable]);
   RegisterPicExt('Portable Any Map', 'pbm;pgm;ppm', [eoReadable]);
   RegisterPicExt('X Window','xwd', [eoReadable]);