LCL: TImage: TImageList support (properties Images, ImageIndex and ImageWidth)

lcl/extctrls.pp

@@ -503,6 +503,9 @@ type
   TCustomImage = class(TGraphicControl)
   private
     FAntialiasingMode: TAntialiasingMode;
+    FImageIndex: Integer;
+    FImages: TCustomImageList;
+    FImageWidth: Integer;
     FOnPictureChanged: TNotifyEvent;
     FOnPaintBackground: TImagePaintBackgroundEvent;
     FPicture: TPicture;
@@ -517,7 +520,11 @@ type
     FUseAncestorCanvas: boolean;
     FPainting: boolean;
     function  GetCanvas: TCanvas;
+    function GetHasGraphic: Boolean;
     procedure SetAntialiasingMode(AValue: TAntialiasingMode);
+    procedure SetImageIndex(const AImageIndex: Integer);
+    procedure SetImages(const AImages: TCustomImageList);
+    procedure SetImageWidth(const AImageWidth: Integer);
     procedure SetPicture(const AValue: TPicture);
     procedure SetCenter(const AValue : Boolean);
     procedure SetKeepOriginX(AValue: Boolean);
@@ -541,6 +548,7 @@ type
     property Canvas: TCanvas read GetCanvas;
     function DestRect: TRect; virtual;
     procedure Invalidate; override;
+    property HasGraphic: Boolean read GetHasGraphic; // has either a picture or valid image from imagelist
   public
     property AntialiasingMode: TAntialiasingMode read FAntialiasingMode write SetAntialiasingMode default amDontCare;
     property Align;
@@ -549,6 +557,9 @@ type
     property KeepOriginXWhenClipped: Boolean read FKeepOriginXWhenClipped write SetKeepOriginX default False;
     property KeepOriginYWhenClipped: Boolean read FKeepOriginYWhenClipped write SetKeepOriginY default False;
     property Constraints;
+    property ImageIndex: Integer read FImageIndex write SetImageIndex default 0;
+    property ImageWidth: Integer read FImageWidth write SetImageWidth default 0; // a specific width for the image from Images
+    property Images: TCustomImageList read FImages write SetImages;
     property Picture: TPicture read FPicture write SetPicture;
     property Visible;
     property OnClick;
@@ -586,6 +597,9 @@ type
     property DragCursor;
     property DragMode;
     property Enabled;
+    property ImageIndex;
+    property ImageWidth;
+    property Images;
     property OnChangeBounds;
     property OnClick;
     property OnContextPopup;

lcl/include/customimage.inc

@@ -135,6 +135,27 @@ begin
   PictureChanged(Self);
 end;
 
+procedure TCustomImage.SetImageIndex(const AImageIndex: Integer);
+begin
+  if FImageIndex = AImageIndex then Exit;
+  FImageIndex := AImageIndex;
+  PictureChanged(Self);
+end;
+
+procedure TCustomImage.SetImages(const AImages: TCustomImageList);
+begin
+  if FImages = AImages then Exit;
+  FImages := AImages;
+  PictureChanged(Self);
+end;
+
+procedure TCustomImage.SetImageWidth(const AImageWidth: Integer);
+begin
+  if FImageWidth = AImageWidth then Exit;
+  FImageWidth := AImageWidth;
+  PictureChanged(Self);
+end;
+
 procedure TCustomImage.SetProportional(const AValue: Boolean);
 begin
   if FProportional = AValue then exit;
@@ -144,24 +165,26 @@ end;
 
 procedure TCustomImage.PictureChanged(Sender : TObject);
 begin
-  if Picture.Graphic <> nil
-  then begin
-    if AutoSize
-    then begin
+  if HasGraphic then
+  begin
+    if AutoSize then
+    begin
       InvalidatePreferredSize;
       AdjustSize;
     end;
-    Picture.Graphic.Transparent := FTransparent;
+    if Assigned(Picture.Graphic) then
+      Picture.Graphic.Transparent := FTransparent;
   end;
-  invalidate;
+  Invalidate;
   if Assigned(OnPictureChanged) then
     OnPictureChanged(Self);
 end;
 
 function TCustomImage.DestRect: TRect;
 var
-  PicWidth: Integer;
-  PicHeight: Integer;
+  PicSize: TSize;
+  PicWidth: Integer absolute PicSize.Width;
+  PicHeight: Integer absolute PicSize.Height;
   ImgWidth: Integer;
   ImgHeight: Integer;
   w: Integer;
@@ -169,8 +192,13 @@ var
   ChangeX, ChangeY: Integer;
   PicInside, PicOutside, PicOutsidePartial: boolean;
 begin
-  PicWidth := Picture.Width;
-  PicHeight := Picture.Height;
+  if Assigned(Picture.Graphic) then
+    PicSize := TSize.Create(Picture.Width, Picture.Height)
+  else
+  if Assigned(Images) then
+    PicSize := Images.SizeForPPI[ImageWidth, Font.PixelsPerInch]
+  else
+    Exit(TRect.Create(0, 0, 0, 0));
   ImgWidth := ClientWidth;
   ImgHeight := ClientHeight;
   if (PicWidth=0) or (PicHeight=0) then Exit(Rect(0, 0, 0, 0));
@@ -217,9 +245,20 @@ end;
 
 procedure TCustomImage.CalculatePreferredSize(var PreferredWidth,
   PreferredHeight: integer; WithThemeSpace: Boolean);
+var
+  S: TSize;
 begin
-  PreferredWidth := Picture.Width;
-  PreferredHeight := Picture.Height;
+  if Assigned(Picture.Graphic) then
+  begin
+    PreferredWidth := Picture.Width;
+    PreferredHeight := Picture.Height;
+  end else
+  if Assigned(Images) then
+  begin
+    S := Images.SizeForPPI[ImageWidth, Font.PixelsPerInch];
+    PreferredWidth := S.Width;
+    PreferredHeight := S.Height;
+  end;
 end;
 
 class function TCustomImage.GetControlClassDefaultSize: TSize;
@@ -228,6 +267,11 @@ begin
   Result.CY := 90;
 end;
 
+function TCustomImage.GetHasGraphic: Boolean;
+begin
+  Result := Assigned(Picture.Graphic) or (Assigned(Images) and (ImageIndex>=0));
+end;
+
 procedure TCustomImage.Paint;
 
   procedure DrawFrame;
@@ -254,8 +298,8 @@ begin
   if csDesigning in ComponentState
   then DrawFrame;
   
-  if Picture.Graphic = nil
-  then Exit;
+  if not HasGraphic then
+    Exit;
 
   C := inherited Canvas;
   R := DestRect;
@@ -264,7 +308,12 @@ begin
   try
     if Assigned(FOnPaintBackground) then
       FOnPaintBackground(Self, C, R);
-    C.StretchDraw(R, Picture.Graphic);
+
+    if Assigned(Picture.Graphic) then
+      C.StretchDraw(R, Picture.Graphic)
+    else
+    if Assigned(Images) and (ImageIndex>=0) then
+      Images.StretchDraw(C, ImageIndex, R);
   finally
     FPainting:=false;
   end;

lcl/lcltaskdialog.pas

@@ -683,7 +683,7 @@ var
   Par: TWinControl;
   Panel: TPanel;
   CurrTabOrder: TTabOrder;
-  Image: TImageListImage;
+  Image: TImage;
   List: TStrings;
   B: TCommonButton;
   CommandLink: TBitBtn;
@@ -878,7 +878,7 @@ begin
 
     if (LCL_IMAGES[aDialogIcon]<>0) then
     begin
-      Image := TImageListImage.Create(Dialog.Form);
+      Image := TImage.Create(Dialog.Form);
       Image.Parent := Par;
       Image.Images := GetDialogImages;
       Image.ImageIndex := GetDialogImages.DialogIndexes[LCL_IMAGES[aDialogIcon]];
@@ -1076,7 +1076,7 @@ begin
         inc(Y,16);
       if (LCL_FOOTERIMAGES[aFooterIcon]<>0) then
       begin
-        Image := TImageListImage.Create(Dialog.Form);
+        Image := TImage.Create(Dialog.Form);
         Image.Parent := Par;
         Image.Images := GetDialogImages;
         Image.ImageWidth := 16;