如何以编程方式将图像添加到TImageCollection

问题描述

我正在尝试加载要填充并保存的timageCollection,因此它可以作为数据模块(.dfm文件)中的资源使用。 这段代码将选定的.png文件中的图像添加到图像集中,我看到计数增加了,所以它正在填充​​ p>

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

但是我需要将其另存为资源。能做到吗?

解决方法

这就是我的做法:

  1. 通过PNG(使用首选标准)将其添加到ImageCollection,PNG文件中:

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

然后构建虚拟的.DFM和.PAS文件:

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,Filename);
  finally
    outpFrm.Free;
    outpImg.Free;
    ConvStream.Free
  end;
end;

procedure TForm1.WritePasForDFM(const ImgCollName,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]));
      end;
    end;
    outp.SaveToFile(ChangeFileExt(Filename,'.pas'));
  finally
    outp.Free;
  end;
end;