Populate imagelist

bgrasvgimagelist.pas

@@ -16,12 +16,12 @@ type
 
   TBGRASVGImageList = class(TComponent)
   private
-    FHeight: Integer;
+    FHeight: integer;
     FItems: TListOfTStringList;
-    FWidth: Integer;
+    FWidth: integer;
     procedure ReadData(Stream: TStream);
-    procedure SetHeight(AValue: Integer);
-    procedure SetWidth(AValue: Integer);
+    procedure SetHeight(AValue: integer);
+    procedure SetWidth(AValue: integer);
     procedure WriteData(Stream: TStream);
   protected
     procedure Load(const XMLConf: TXMLConfig);
@@ -30,22 +30,30 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    function Add(ASVG: String): Integer;
-    procedure Remove(AIndex: Integer);
-    procedure Exchange(AIndex1, AIndex2: Integer);
-    procedure Replace(AIndex: Integer; ASVG: String);
-    function Count: Integer;
+    function Add(ASVG: string): integer;
+    procedure Remove(AIndex: integer);
+    procedure Exchange(AIndex1, AIndex2: integer);
+    procedure Replace(AIndex: integer; ASVG: string);
+    function Count: integer;
     // Get SVG string
-    function Get(AIndex: Integer): String; overload;
+    function Get(AIndex: integer): string; overload;
     // Get bgrabitmap with custom width and height
-    function Get(AIndex: Integer; AWidth, AHeight: Integer; UseSVGAspectRatio: Boolean = True): TBGRABitmap; overload;
+    function Get(AIndex: integer; AWidth, AHeight: integer;
+      UseSVGAspectRatio: boolean = True): TBGRABitmap; overload;
+    // Get bitmap with custom width and height
+    function GetBitmap(AIndex: integer; AWidth, AHeight: integer;
+      UseSVGAspectRatio: boolean = True): TBitmap; overload;
     // Draw image with svgimagelist width and height
-    procedure Draw(AIndex: Integer; ACanvas: TCanvas; ALeft, ATop: Integer; UseSVGAspectRatio: Boolean = True); overload;
+    procedure Draw(AIndex: integer; ACanvas: TCanvas; ALeft, ATop: integer;
+      UseSVGAspectRatio: boolean = True); overload;
     // Draw image with custom width and height
-    procedure Draw(AIndex: Integer; ACanvas: TCanvas; ALeft, ATop, AWidth, AHeight: Integer; UseSVGAspectRatio: Boolean = True); overload;
+    procedure Draw(AIndex: integer; ACanvas: TCanvas;
+      ALeft, ATop, AWidth, AHeight: integer; UseSVGAspectRatio: boolean = True); overload;
+    // Generate bitmaps for an image list
+    procedure PopulateImageList(const AImageList: TImageList; ASizes: array of integer);
   published
-    property Width: Integer read FWidth write SetWidth;
-    property Height: Integer read FHeight write SetHeight;
+    property Width: integer read FWidth write SetWidth;
+    property Height: integer read FHeight write SetHeight;
   end;
 
 procedure Register;
@@ -54,7 +62,7 @@ implementation
 
 procedure Register;
 begin
-  RegisterComponents('BGRA Themes',[TBGRASVGImageList]);
+  RegisterComponents('BGRA Themes', [TBGRASVGImageList]);
 end;
 
 { TBGRASVGImageList }
@@ -73,16 +81,18 @@ begin
   end;
 end;
 
-procedure TBGRASVGImageList.SetHeight(AValue: Integer);
+procedure TBGRASVGImageList.SetHeight(AValue: integer);
 begin
-  if FHeight=AValue then Exit;
-  FHeight:=AValue;
+  if FHeight = AValue then
+    Exit;
+  FHeight := AValue;
 end;
 
-procedure TBGRASVGImageList.SetWidth(AValue: Integer);
+procedure TBGRASVGImageList.SetWidth(AValue: integer);
 begin
-  if FWidth=AValue then Exit;
-  FWidth:=AValue;
+  if FWidth = AValue then
+    Exit;
+  FWidth := AValue;
 end;
 
 procedure TBGRASVGImageList.WriteData(Stream: TStream);
@@ -106,7 +116,7 @@ begin
   try
     FItems.Clear;
     j := XMLConf.GetValue('Count', 0);
-    for i:=0 to j-1 do
+    for i := 0 to j - 1 do
     begin
       index := FItems.Add(TStringList.Create);
       FItems[index].Text := XMLConf.GetValue('Item' + i.ToString + '/SVG', '');
@@ -121,7 +131,7 @@ var
 begin
   try
     XMLConf.SetValue('Count', FItems.Count);
-    for i:=0 to FItems.Count-1 do
+    for i := 0 to FItems.Count - 1 do
       XMLConf.SetValue('Item' + i.ToString + '/SVG', FItems[i].Text);
   finally
   end;
@@ -147,7 +157,7 @@ begin
   inherited Destroy;
 end;
 
-function TBGRASVGImageList.Add(ASVG: String): Integer;
+function TBGRASVGImageList.Add(ASVG: string): integer;
 var
   list: TStringList;
 begin
@@ -156,33 +166,33 @@ begin
   Result := FItems.Add(list);
 end;
 
-procedure TBGRASVGImageList.Remove(AIndex: Integer);
+procedure TBGRASVGImageList.Remove(AIndex: integer);
 begin
   FItems.Remove(FItems[AIndex]);
 end;
 
-procedure TBGRASVGImageList.Exchange(AIndex1, AIndex2: Integer);
+procedure TBGRASVGImageList.Exchange(AIndex1, AIndex2: integer);
 begin
   FItems.Exchange(AIndex1, AIndex2);
 end;
 
-function TBGRASVGImageList.Get(AIndex: Integer): String;
+function TBGRASVGImageList.Get(AIndex: integer): string;
 begin
   Result := FItems[AIndex].Text;
 end;
 
-procedure TBGRASVGImageList.Replace(AIndex: Integer; ASVG: String);
+procedure TBGRASVGImageList.Replace(AIndex: integer; ASVG: string);
 begin
   FItems[AIndex].Text := ASVG;
 end;
 
-function TBGRASVGImageList.Count: Integer;
+function TBGRASVGImageList.Count: integer;
 begin
   Result := FItems.Count;
 end;
 
-function TBGRASVGImageList.Get(AIndex: Integer; AWidth, AHeight: Integer;
-  UseSVGAspectRatio: Boolean): TBGRABitmap;
+function TBGRASVGImageList.Get(AIndex: integer; AWidth, AHeight: integer;
+  UseSVGAspectRatio: boolean): TBGRABitmap;
 var
   bmp: TBGRABitmap;
   svg: TBGRASVG;
@@ -197,19 +207,36 @@ begin
   Result := bmp;
 end;
 
-procedure TBGRASVGImageList.Draw(AIndex: Integer; ACanvas: TCanvas; ALeft,
-  ATop: Integer; UseSVGAspectRatio: Boolean);
+function TBGRASVGImageList.GetBitmap(AIndex: integer; AWidth, AHeight: integer;
+  UseSVGAspectRatio: boolean): TBitmap;
+var
+  bmp: TBGRABitmap;
+  ms: TMemoryStream;
+begin
+  bmp := Get(AIndex, AWidth, AHeight, UseSVGAspectRatio);
+  ms := TMemoryStream.Create;
+  bmp.Bitmap.SaveToStream(ms);
+  bmp.Free;
+  Result := TBitmap.Create;
+  ms.Position := 0;
+  Result.LoadFromStream(ms);
+  ms.Free;
+end;
+
+procedure TBGRASVGImageList.Draw(AIndex: integer; ACanvas: TCanvas;
+  ALeft, ATop: integer; UseSVGAspectRatio: boolean);
 begin
   Draw(AIndex, ACanvas, ALeft, ATop, FWidth, FHeight, UseSVGAspectRatio);
 end;
 
-procedure TBGRASVGImageList.Draw(AIndex: Integer; ACanvas: TCanvas; ALeft,
-  ATop, AWidth, AHeight: Integer; UseSVGAspectRatio: Boolean);
+procedure TBGRASVGImageList.Draw(AIndex: integer; ACanvas: TCanvas;
+  ALeft, ATop, AWidth, AHeight: integer; UseSVGAspectRatio: boolean);
 var
   bmp: TBGRABitmap;
   svg: TBGRASVG;
 begin
-  if (AWidth = 0) or (AHeight = 0) then Exit;
+  if (AWidth = 0) or (AHeight = 0) then
+    Exit;
   bmp := TBGRABitmap.Create(AWidth, AHeight);
   svg := TBGRASVG.CreateFromString(FItems[AIndex].Text);
   try
@@ -221,4 +248,25 @@ begin
   end;
 end;
 
+procedure TBGRASVGImageList.PopulateImageList(const AImageList: TImageList;
+  ASizes: array of integer);
+var
+  i, j: integer;
+  arr: array of TCustomBitmap;
+begin
+  AImageList.Width := ASizes[0];
+  AImageList.Height := ASizes[0];
+  AImageList.Scaled := True;
+  AImageList.RegisterResolutions(ASizes);
+  SetLength(arr, Length(ASizes));
+  for j := 0 to Count - 1 do
+  begin
+    for i := 0 to Length(ASizes) - 1 do
+      Arr[i] := GetBitmap(j, ASizes[i], ASizes[i], True);
+    AImageList.AddMultipleResolutions(arr);
+    for i := 0 to Length(ASizes) - 1 do
+      TBitmap(Arr[i]).Free;
+  end;
+end;
+
 end.