How to add images to TImageCollection programmatically

Question

I'm trying to load TImageCollection which I want to populate and save so it's available as a resource in a data module (.dfm file). This code adds images to the image collection from selected .png files and I can see the count increase, so it is populating

 ImageCollectionMS.Images.Add(ChangeFileExt(ShortName,''), Path+Shortname);`

but I need to save it as a resource. Can that be done?

Answer 1

This was how I did it:

1. Add to the ImageCollection, PNG file by PNG (using the preferred criteria):

   ImageCollectionX.Add(ChangeFileExt(ShortName,''), FullFilename);

Then build dummy .DFM and .PAS files:

function PosInStr(const substr, str: String): integer;
var start, p : integer;
begin
  start := 1;
  Result := 0;
  repeat
    p := PosEx(Substr,Str,start);
    if p>0 then begin
      start := p+1;
      inc(Result);
    end;
  until P=0;
end;

procedure TForm1.WriteDFM(aStream: TStream; const ImgCollName, Suffix, Filename: string);
const DFMStart : array[0..14] of string =
  ('object Form%s: TForm%s',
  'Left = 0',
  'Top = 0',
  'Caption = ''Form%s''',
  'ClientHeight = 299',
  'ClientWidth = 635',
  'Color = clBtnFace',
  'Font.Charset = DEFAULT_CHARSET',
  'Font.Color = clWindowText',
  'Font.Height = -11',
  'Font.Name = ''Tahoma''',
  'Font.Style = []',
  'OldCreateOrder = False',
  'PixelsPerInch = 96',
  'TextHeight = 13');
var
  i, n : integer;
  outpfrm, outpImg : TStringlist;
  ConvStream: TStream;
begin
  aStream.Position := 0;
  outpFrm := TStringlist.Create;
  outpImg := TStringlist.Create;
  ConvStream := TMemoryStream.Create;
  try
    ObjectBinaryToText (aStream, ConvStream);
    ConvStream.Position := 0;
    outpImg.LoadFromStream(ConvStream);
    for i := Low(DFMStart) to High(DFMStart) do begin
      n := PosInStr('%s', DFMStart[i]);
      case n of 0:  outpFRM.Add(DFMStart[i]);
        1 : outpFRM.Add(Format(DFMStart[i],[suffix]));
        2 : outpFRM.Add(Format(DFMStart[i],[suffix, suffix]));
      end;
    end;
    outpFrm.AddStrings(outpImg);
    outpFrm.Add('end');
    outpFrm.SaveToFile(ChangeFileExt(Filename,'.dfm'));
    writePasForDFM(ImgCollName, Suffix, Filename);
  finally
    outpFrm.Free;
    outpImg.Free;
    ConvStream.Free
  end;
end;

procedure TForm1.WritePasForDFM(const ImgCollName, Suffix, Filename: string);
const
  PasStart : array[0..15] of string =
  ('unit %s;',
  'interface',
  'uses',
  'Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,',
  'Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.BaseImageCollection, Vcl.ImageCollection;',
  '',
  'type',
  'TForm%s = class(TForm)',
  '@: TImageCollection;',
  'end;',
  '',
  'var',
  'Form%s: TForm%s;',
  'implementation',
  '{$R *.dfm}',
  'end.');
var
  i, n: integer;
  outp : TStringlist;
begin
  outp := TStringlist.Create;
  try
    for i := Low(PASStart) to High(PASStart) do begin
      n := PosInStr('%s', PASStart[i]);
      case n of 0:
      if POs('@', PASStart[i])>0 then
        outp.Add(ImgCollName+ Copy(PASStart[i],2,maxint))
        else outp.Add(PASStart[i]);
        1 : outp.Add(Format(PasStart[i],[suffix]));
        2 : outp.Add(Format(PasStart[i],[suffix, suffix]));
      end;
    end;
    outp.SaveToFile(ChangeFileExt(Filename,'.pas'));
  finally
    outp.Free;
  end;
end;