浏览代码

Merge branch 'thirdparty'

# Conflicts:
#	source/packages/png/PngImageList.pas
#	source/packages/png/PngImageListEditor.dfm

Source commit: 6ae8284ddc486367209277761d76f8e36a4b999c
Martin Prikryl 3 年之前
父节点
当前提交
dd0baf4fd8

+ 23 - 13
source/packages/png/PngComponentEditors.pas

@@ -182,14 +182,20 @@ var
   dlg: TPngImageListEditorDlg;
 begin
   dlg := TPngImageListEditorDlg.Create(nil);
-  ImageList := GetComponent(0) as TPngImageList;
-  dlg.Caption := Format(SEditing, [ImageList.Name, GetName]);
-  dlg.Images.Items.Assign(ImageList.PngImages);
-  dlg.ImageWidth := ImageList.Width;
-  dlg.ImageHeight := ImageList.Height;
-  if dlg.ShowModal = mrOK then begin
-    ImageList.PngImages.Assign(dlg.Images.Items);
-    Designer.Modified;
+  try
+    ImageList := GetComponent(0) as TPngImageList;
+    dlg.Caption := Format(SEditing, [ImageList.Name, GetName]);
+    dlg.Images.Items.Assign(ImageList.PngImages);
+    dlg.ImageWidth := ImageList.Width;
+    dlg.ImageHeight := ImageList.Height;
+    if dlg.ShowModal = mrOK then begin
+      ImageList.Width := dlg.ImageWidth;
+      ImageList.Height := dlg.ImageHeight;
+      ImageList.PngImages.Assign(dlg.Images.Items);
+      Designer.Modified;
+    end;
+  finally
+    dlg.Free;
   end;
 end;
 
@@ -212,11 +218,15 @@ var
 begin
   Collection := GetComponent(0) as TPngImageCollection;
   dlg := TPngImageListEditorDlg.Create(nil);
-  dlg.Caption := Format(SEditing, [Collection.Name, GetName]);
-  dlg.Images.Items.Assign(Collection.Items);
-  if dlg.ShowModal = mrOK then begin
-    Collection.Items.Assign(dlg.Images.Items);
-    Designer.Modified;
+  try
+    dlg.Caption := Format(SEditing, [Collection.Name, GetName]);
+    dlg.Images.Items.Assign(Collection.Items);
+    if dlg.ShowModal = mrOK then begin
+      Collection.Items.Assign(dlg.Images.Items);
+      Designer.Modified;
+    end;
+  finally
+    dlg.Free;
   end;
 end;
 

+ 11 - 0
source/packages/png/PngFunctions.pas

@@ -17,6 +17,7 @@ type
   TPngOption = (pngBlendOnDisabled, pngGrayscaleOnDisabled);
   TPngOptions = set of TPngOption;
 
+procedure MakeDisabledImage(Image: TPngImage; const Options: TPngOptions);
 procedure MakeImageBlended(Image: TPngImage; Amount: Byte = 127);
 procedure MakeImageGrayscale(Image: TPngImage; Amount: Byte = 255);
 procedure DrawPNG(Png: TPngImage; Canvas: TCanvas; const ARect: TRect; const Options: TPngOptions);
@@ -501,7 +502,16 @@ begin
   end;
 end;
 
+procedure MakeDisabledImage(Image: TPngImage; const Options: TPngOptions);
+begin
+  if pngBlendOnDisabled in Options then
+    MakeImageBlended(Image);
+  if pngGrayscaleOnDisabled in Options then
+    MakeImageGrayscale(Image);
+end;
+
 {$IF RTLVersion >= 20.0 }
+{$IFDEF RegisterOldPngFormat}
 type
   TPNGObject = class(TPngImage);
 initialization
@@ -509,4 +519,5 @@ initialization
 finalization
   TPicture.UnregisterGraphicClass(TPNGObject);
 {$IFEND}
+{$IFEND}
 end.

+ 176 - 14
source/packages/png/PngImageList.pas

@@ -7,23 +7,40 @@ This unit only compiles with Delphi 7 and higher!
 interface
 
 uses
-  Windows, Classes, SysUtils, Controls, Graphics, ImgList, PngImage,
-  PngFunctions;
+  Windows, Classes, SysUtils, Controls, Graphics, ImgList,
+  {$IF CompilerVersion >= 34.0 Delphi 10.4 }
+  System.UITypes,
+  {$ENDIF}
+  PngImage, PngFunctions;
+
+type
+  INameMapping = interface
+  ['{38EECDD8-7440-4EA2-BFD0-424E5BB2C1D5}']
+    function GetName(Index: Integer): string;
+    function IndexOfName(const AName: string): Integer;
+    procedure ListNames(Target: TStrings);
+    property Name[Index: Integer]: string read GetName;
+  end;
 
 type
   TPngImageCollection = class;
   TPngImageCollectionItem = class;
   TPngImageCollectionItems = class;
 
-  TPngImageList = class(TImageList)
+  TPngImageList = class(TImageList, INameMapping)
+    function INameMapping.GetName = GetImageName;
+    function INameMapping.IndexOfName = FindIndexByName;
+    procedure INameMapping.ListNames = ListImageNames;
   private
     FEnabledImages: Boolean;
+    FImageNameAvailable: Boolean;
     FLocked: Integer;
     FOverlayIndex: array[TOverlay] of Integer;
     FPngImages: TPngImageCollectionItems;
     FPngOptions: TPngOptions;
     function ExtractOverlayIndex(Style: Cardinal): Integer;
     function GetHeight: Integer;
+    function GetImageName(Index: Integer): string;
     function GetWidth: Integer;
     procedure SetHeight(const Value: Integer);
     procedure SetPngOptions(const Value: TPngOptions);
@@ -50,24 +67,37 @@ type
     function AddImage(Value: TCustomImageList; Index: Integer): Integer; virtual;
     procedure AddImages(Value: TCustomImageList); virtual;
     function AddMasked(Image: TBitmap; MaskColor: TColor): Integer; virtual;
+    {$IF CompilerVersion >= 34.0 Delphi 10.4 Sydney }
+    function AddDisabledImage(Value: TCustomImageList; Index: Integer): Integer; virtual;
+    procedure AddDisabledImages(Value: TCustomImageList); virtual;
+    {$ENDIF}
     procedure Assign(Source: TPersistent); override;
     procedure BeginUpdate;
     procedure Clear; virtual;
     procedure Delete(Index: Integer); virtual;
     procedure EndUpdate(Update: Boolean = True);
+    function FindIndexByName(const AName: string): Integer;
     procedure Insert(Index: Integer; Image, Mask: TBitmap); virtual;
     procedure InsertIcon(Index: Integer; Image: TIcon); virtual;
     procedure InsertPng(Index: Integer; Image: TPngImage; Background: TColor = clNone);
     procedure InsertMasked(Index: Integer; Image: TBitmap; MaskColor: TColor); virtual;
+    procedure ListImageNames(Target: TStrings);
     procedure Move(CurIndex, NewIndex: Integer); virtual;
     function Overlay(ImageIndex: Integer; Overlay: TOverlay): Boolean;
     procedure Replace(Index: Integer; Image, Mask: TBitmap); virtual;
     procedure ReplaceIcon(Index: Integer; Image: TIcon); virtual;
     procedure ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor); virtual;
+    {$IF CompilerVersion >= 34.0 Delphi 10.4 }
+    function IsImageNameAvailable: Boolean; override;
+    function GetIndexByName(const AName: TImageName): TImageIndex; override;
+    function GetNameByIndex(AIndex: TImageIndex): TImageName; override;
+    {$ENDIF}
+    property ImageName[Index: Integer]: string read GetImageName;
   published
     property ColorDepth default cd32Bit;
     property EnabledImages: Boolean read FEnabledImages write SetEnabledImages default True;
     property Height read GetHeight write SetHeight default 16;
+    property ImageNameAvailable: Boolean read FImageNameAvailable write FImageNameAvailable default False;
     property PngImages: TPngImageCollectionItems read FPngImages write SetPngImages;
     property PngOptions: TPngOptions read FPngOptions write SetPngOptions default [pngBlendOnDisabled];
     property Width read GetWidth write SetWidth default 16;
@@ -226,7 +256,11 @@ var
   I: Integer;
 begin
   if ImageListCount = 0 then begin
+    {$IF CompilerVersion >= 34.0 Delphi 10.4 Sydney }
+    SetLength(Pointers, 17);
+    {$ELSE}
     SetLength(Pointers, 15);
+    {$ENDIF}
     Pointers[0] := Combo(@TCustomImageList.Add, @TPngImageList.Add, 'Add');
     Pointers[1] := Combo(@TCustomImageList.AddIcon, @TPngImageList.AddIcon, 'AddIcon');
     Pointers[2] := Combo(@TCustomImageList.AddImage, @TPngImageList.AddImage, 'AddImage');
@@ -242,6 +276,10 @@ begin
     Pointers[12] := Combo(@TCustomImageList.ReplaceIcon, @TPngImageList.ReplaceIcon, 'ReplaceIcon');
     Pointers[13] := Combo(@TCustomImageList.ReplaceMasked, @TPngImageList.ReplaceMasked, 'ReplaceMasked');
     Pointers[14] := Combo(@TCustomImageList.Overlay, @TPngImageList.Overlay, 'Overlay');
+    {$IF CompilerVersion >= 34.0 Delphi 10.4 Sydney }
+    Pointers[15] := Combo(@TCustomImageList.AddDisabledImage, @TPngImageList.AddDisabledImage, 'AddDisabledImage');
+    Pointers[16] := Combo(@TCustomImageList.AddDisabledImages, @TPngImageList.AddDisabledImages, 'AddDisabledImages');
+    {$ENDIF}
 
     MethodPatches := TObjectList.Create;
     for I := Low(Pointers) to High(Pointers) do begin
@@ -361,6 +399,10 @@ begin
     FOverlayIndex[I] := -1;
   end;
   inherited Create(AOwner);
+  {$IF CompilerVersion >= 33.0 Delphi 10.3 Rio }
+  StoreBitmap := False;
+  {$ENDIF}
+  FImageNameAvailable := False;
   ColorDepth := cd32Bit;
   if ImageListCount = 0 then
     ApplyMethodPatches;
@@ -470,12 +512,15 @@ begin
     Png := TPngImage.Create;
     try
       CopyImageFromImageList(Png, Value, Index);
-      result := AddPng(Png);
-      { Since Berlin AddImage returns the new size of the list, while before it returned the index of the added image.
-        Although this behaviour seems somewhat strange, it actually matches the documentation. }
-      {$IF RTLVersion >= 31.00}
-      result := FPngImages.Count;
-      {$IFEND}
+      if RTLVersion < 31.00 then begin
+        result := AddPng(Png);
+      end
+      else begin
+        { Since Berlin AddImage returns the new size of the list, while before it returned the index of the added image.
+          Although this behaviour seems somewhat strange, it actually matches the documentation. }
+        AddPng(Png);
+        result := FPngImages.Count;
+      end;
     finally
       Png.Free;
     end;
@@ -531,6 +576,76 @@ begin
   end;
 end;
 
+{$IF CompilerVersion >= 34.0 Delphi 10.4 Sydney }
+function TPngImageList.AddDisabledImage(Value: TCustomImageList; Index: Integer): Integer;
+var
+  Patch: TMethodPatch;
+  Png: TPngImage;
+begin
+  if TObject(Self) is TPngImageList then begin
+    Png := TPngImage.Create;
+    try
+      CopyImageFromImageList(Png, Value, Index);
+      MakeDisabledImage(Png, PngOptions);
+      AddPng(Png);
+      result := FPngImages.Count;
+    finally
+      Png.Free;
+    end;
+  end
+  else begin
+    Patch := FindMethodPatch('AddDisabledImage');
+    if Patch <> nil then begin
+      Patch.BeginInvokeOldMethod;
+      try
+        Result := TCustomImageList(Self).AddDisabledImage(Value, Index);
+      finally
+        Patch.FinishInvokeOldMethod;
+      end;
+    end
+    else
+      Result := -1;
+  end;
+end;
+
+procedure TPngImageList.AddDisabledImages(Value: TCustomImageList);
+var
+  Patch: TMethodPatch;
+  I: Integer;
+  Png: TPngImage;
+begin
+  if TObject(Self) is TPngImageList then begin
+    BeginUpdate;
+    try
+      //Copy every image from Value into this imagelist.
+      Png := TPngImage.Create;
+      try
+        for I := 0 to Value.Count - 1 do begin
+          CopyImageFromImageList(Png, Value, I);
+          MakeDisabledImage(Png, PngOptions);
+          AddPng(Png);
+        end;
+      finally
+        Png.Free;
+      end;
+    finally
+      EndUpdate;
+    end;
+  end
+  else begin
+    Patch := FindMethodPatch('AddDisabledImages');
+    if Patch <> nil then begin
+      Patch.BeginInvokeOldMethod;
+      try
+        TCustomImageList(Self).AddDisabledImages(Value);
+      finally
+        Patch.FinishInvokeOldMethod;
+      end;
+    end;
+  end;
+end;
+{$ENDIF}
+
 function TPngImageList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
 var
   Patch: TMethodPatch;
@@ -657,10 +772,7 @@ begin
       else begin
         //Basically the same as in the DrawPNG function
         Png.Assign(item.PngImage);
-        if pngBlendOnDisabled in FPngOptions then
-          MakeImageBlended(Png);
-        if pngGrayscaleOnDisabled in FPngOptions then
-          MakeImageGrayscale(Png);
+        MakeDisabledImage(Png, PngOptions);
         Icon := PngToIcon(Png);
       end;
       ImageList_AddIcon(Handle, Icon);
@@ -747,11 +859,25 @@ begin
     idx := idx shr 8;
     if (idx > 0) then begin
       Dec(idx);
-{$WARN COMPARISON_TRUE OFF}
+      {$WARN COMPARISON_TRUE OFF }
       if (idx >= Low(FOverlayIndex)) and (idx <= High(FOverlayIndex)) then begin
         Result := FOverlayIndex[idx];
 {$WARN COMPARISON_TRUE DEFAULT}
       end;
+      {$WARN COMPARISON_TRUE DEFAULT }
+    end;
+  end;
+end;
+
+function TPngImageList.FindIndexByName(const AName: string): Integer;
+var
+  I: Integer;
+begin
+  Result := -1;
+  for I := 0 to PngImages.Count - 1 do begin
+    if SameText(PngImages[I].Name, AName) then begin
+      Result := I;
+      Break;
     end;
   end;
 end;
@@ -761,6 +887,33 @@ begin
   Result := inherited Height;
 end;
 
+function TPngImageList.GetImageName(Index: Integer): string;
+var
+  item: TPngImageCollectionItem;
+begin
+  Result := '';
+  item := PngImages[Index];
+  if item <> nil then
+    Result := item.Name;
+end;
+
+{$IF CompilerVersion >= 34.0 Delphi 10.4 }
+function TPngImageList.IsImageNameAvailable: Boolean;
+begin
+  Result := FImageNameAvailable;
+end;
+
+function TPngImageList.GetIndexByName(const AName: TImageName): TImageIndex;
+begin
+  Result := FindIndexByName(AName);
+end;
+
+function TPngImageList.GetNameByIndex(AIndex: TImageIndex): TImageName;
+begin
+  Result := ImageName[AIndex];
+end;
+{$ENDIF}
+
 function TPngImageList.GetWidth: Integer;
 begin
   Result := inherited Width;
@@ -917,6 +1070,15 @@ begin
   end;
 end;
 
+procedure TPngImageList.ListImageNames(Target: TStrings);
+var
+  I: Integer;
+begin
+  for I := 0 to PngImages.Count - 1 do begin
+    Target.Add(PngImages[I].Name);
+  end;
+end;
+
 procedure TPngImageList.Move(CurIndex, NewIndex: Integer);
 var
   Patch: TMethodPatch;

+ 12 - 14
source/packages/png/PngImageListEditor.dfm

@@ -66,7 +66,6 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
         Top = 79
         Width = 140
         Height = 21
-        ItemHeight = 13
         TabOrder = 2
         OnChange = cmbBackgroundColorChange
         OnDblClick = cmbBackgroundColorDblClick
@@ -92,7 +91,6 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
       Anchors = [akLeft, akTop, akRight, akBottom]
       DragCursor = crDefault
       DragMode = dmAutomatic
-      ItemHeight = 16
       MultiSelect = True
       TabOrder = 3
       OnClick = lbxImagesClick
@@ -232,11 +230,11 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
         Width = 75
         Height = 25
         Caption = '&Add'
-        TabOrder = 0
-        OnClick = btnAddClick
         Layout = blGlyphRight
         Margin = 6
         Spacing = 3
+        TabOrder = 0
+        OnClick = btnAddClick
         PngImage.Data = {
           89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
           610000001974455874536F6674776172650041646F626520496D616765526561
@@ -269,11 +267,11 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
         Width = 75
         Height = 25
         Caption = '&Delete'
-        TabOrder = 1
-        OnClick = btnDeleteClick
         Layout = blGlyphRight
         Margin = 6
         Spacing = 3
+        TabOrder = 1
+        OnClick = btnDeleteClick
         PngImage.Data = {
           89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
           610000001974455874536F6674776172650041646F626520496D616765526561
@@ -306,11 +304,11 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
         Width = 75
         Height = 25
         Caption = '&Replace'
-        TabOrder = 2
-        OnClick = btnReplaceClick
         Layout = blGlyphRight
         Margin = 6
         Spacing = 3
+        TabOrder = 2
+        OnClick = btnReplaceClick
         PngImage.Data = {
           89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
           610000001974455874536F6674776172650041646F626520496D616765526561
@@ -350,11 +348,11 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
         Width = 75
         Height = 25
         Caption = '&Clear'
-        TabOrder = 3
-        OnClick = btnClearClick
         Layout = blGlyphRight
         Margin = 6
         Spacing = 3
+        TabOrder = 3
+        OnClick = btnClearClick
         PngImage.Data = {
           89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
           610000001974455874536F6674776172650041646F626520496D616765526561
@@ -392,11 +390,11 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
         Width = 75
         Height = 25
         Caption = '&Up'
-        TabOrder = 4
-        OnClick = btnUpClick
         Layout = blGlyphRight
         Margin = 6
         Spacing = 3
+        TabOrder = 4
+        OnClick = btnUpClick
         PngImage.Data = {
           89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
           610000001974455874536F6674776172650041646F626520496D616765526561
@@ -426,11 +424,11 @@ object PngImageListEditorDlg: TPngImageListEditorDlg
         Width = 75
         Height = 25
         Caption = '&Down'
-        TabOrder = 5
-        OnClick = btnDownClick
         Layout = blGlyphRight
         Margin = 6
         Spacing = 3
+        TabOrder = 5
+        OnClick = btnDownClick
         PngImage.Data = {
           89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
           610000001974455874536F6674776172650041646F626520496D616765526561

+ 29 - 5
source/packages/png/PngImageListEditor.pas

@@ -80,6 +80,7 @@ type
     FSelectionBodyColor: TColor;
     FSelectionBorderColor: TColor;
     function ConformDimensions(Png: TPngImage): Boolean;
+    function ConformAdjustDimensions(Png: TPngImage; const AFileName: string): Boolean;
     function FirstSelected: Integer;
     function LastSelected: Integer;
     procedure DrawBackground(Canvas: TCanvas; const ARect: TRect; ScrollPos, Index: Integer;
@@ -117,7 +118,7 @@ const
 const
   SIncorrectSize =
     'The selected PNG "%s" must be %dx%d in size, while its actual size is %dx%d';
-
+  SAgustSize = 'Adjust size of imagelist to match loaded image?';
 var
   ResX, ResY: Integer;
 
@@ -551,7 +552,7 @@ begin
           Chunks.RemoveChunk(Chunks.ItemFromClass(TChunkgAMA));
       end;
       //Does the image conform the specified dimensions, if any?
-      if ConformDimensions(Png.PngImage) then begin
+      if ConformAdjustDimensions(Png.PngImage, ExtractFilename(dlgOpenPicture.Files[I])) then begin
         //Update maximum image width
         if FMaxWidth < Png.PngImage.Width then
           FMaxWidth := Png.PngImage.Width;
@@ -571,9 +572,6 @@ begin
       end
       else begin
         //The image does not conform the specified dimensions
-        MessageBox(Handle, PChar(Format(SIncorrectSize,
-          [ExtractFilename(dlgOpenPicture.Files[I]), ImageWidth, ImageHeight,
-          Png.PngImage.Width, Png.PngImage.Height])), PChar(Caption), MB_ICONERROR or MB_OK);
         Images.Items.Delete(Png.Index);
       end;
     end;
@@ -785,6 +783,32 @@ begin
   end;
 end;
 
+{ TPngImageListEditorDlg }
+
+function TPngImageListEditorDlg.ConformAdjustDimensions(Png: TPngImage; const AFileName: string): Boolean;
+begin
+  Result := ConformDimensions(Png);
+  if not Result then begin
+    if Images.Items.Count = 1 then begin
+      { The image does not conform the specified dimensions, but is the first image loaded.
+        We offer to adjust the image size of the imagelist to the size of the just loaded image. }
+      if MessageBox(Handle, PChar(Format(SIncorrectSize + #13 + SAgustSize,
+        [AFileName, ImageWidth, ImageHeight,
+        Png.Width, Png.Height])), PChar(Caption), MB_ICONQUESTION or MB_YESNO) = mrYes then begin
+        ImageWidth := Png.Width;
+        ImageHeight := Png.Height;
+        Result := True;
+      end;
+    end
+    else begin
+      { The image does not conform the specified dimensions }
+      MessageBox(Handle, PChar(Format(SIncorrectSize,
+        [AFileName, ImageWidth, ImageHeight,
+        Png.Width, Png.Height])), PChar(Caption), MB_ICONERROR or MB_OK);
+    end;
+  end;
+end;
+
 procedure TPngImageListEditorDlg.edtNameChange(Sender: TObject);
 begin
   //Update the selected image with the entered name, in realtime