delphi 在子线程加载GIF图元，用于显示程序运行进度

需要在程序中加载gif图片，用于显示程序的进度， 但是在主线程中初始化非常的占用资源，导致如果是在主线程中加载gif，根本就不能刷新。
后来尝试在子线程通过线程加载每一帧的图片，以实现动态的效果， 但是造成了频繁向主线程申请资源，造成了初始化程序更慢。 
代码如下， 各位还有别的思路吗？  unit TRBProcessing;interfaceuses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ImgList, Vcl.StdCtrls, Vcl.Imaging.GIFImg;type
  TRunImage = class(TThread)
  private
    FBox: TPaintBox;
    FImageList: TImageList;
    FStep: Integer;
    FisSetTransparentColor: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(ABox: TPaintBox; AImageList: TImageList);
    property isSetTransparentColor: Boolean  read FisSetTransparentColor write FisSetTransparentColor;
  end;type
  TTRBFrmProcessing = class(TForm)
    ImgRun: TImageList;
    ImgDog: TPaintBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    oRunImage: TRunImage;
    { Private declarations }
  protected
  public
    { Public declarations }
  end;var
  TRBFrmProcessing: TTRBFrmProcessing;procedure ProcessingWaitMsg2(AFlag: Integer; AMsg: string = '');const
  isProcMsgShow: Integer = 1;
  isProcMsgHide: Integer = 0;
  isFormTransparentColor: Integer = 2;
  isFormNoTransparentColor: Integer = 3;implementation{$R *.dfm}procedure ProcessingWaitMsg2(AFlag: Integer; AMsg: string = '');
begin
  if AFlag = isProcMsgHide then
  begin
    if Application.FindComponent('TRBFrmProcessing') <> nil then
    begin
      TRBFrmProcessing.TransparentColor := True;
      Sleep(100);
      TRBFrmProcessing.Refresh;
      TRBFrmProcessing.Hide;
      TRBFrmProcessing.Close;
      FreeAndNil(TRBFrmProcessing);
    end;
    Exit;
  end
  else if AFlag = isFormTransparentColor then
  begin
    if Application.FindComponent('TRBFrmProcessing') <> nil then
    begin
      TRBFrmProcessing.TransparentColor := True;
      TRBFrmProcessing.oRunImage.Suspended:= True;
      TRBFrmProcessing.oRunImage.isSetTransparentColor := True;      TRBFrmProcessing.oRunImage.Resume;
    end;
  end
  else if AFlag = isFormNoTransparentColor then
  begin
    if Application.FindComponent('TRBFrmProcessing') <> nil then
    begin
      TRBFrmProcessing.TransparentColor := False;
    end;
  end
  else
  begin
    if Application.FindComponent('TRBFrmProcessing') = nil then
    begin
      TRBFrmProcessing := TTRBFrmProcessing.Create(Application);
    end;
    TRBFrmProcessing.TransparentColor := True;
    TRBFrmProcessing.TransparentColorValue := clBtnFace;
    with TRBFrmProcessing do
    begin
      Show;
      Update;
    end;
  end;
end;{ TRunDog }constructor TRunImage.Create(ABox: TPaintBox; AImageList: TImageList);
begin
  FBox := ABox;
  FImageList := AImageList;
  FStep := 0;
  FreeOnTerminate := True;
  FisSetTransparentColor := False;
  Inherited Create(False);
end;procedure TRunImage.Execute;var
  oIcon: TIcon;
  oBitMap: TBitmap;
begin
  oIcon := TIcon.Create;
  oBitMap := TBitmap.Create;
  try
    repeat
//      if FisSetTransparentColor then
//        TRBFrmProcessing_Two.TransparentColor := True
//      else
//        TRBFrmProcessing_Two.TransparentColor := False;      FBox.Canvas.Lock;
      FImageList.GetIcon(FStep, oIcon);
//      FBox.Canvas.Brush.Color := TPanel(FBox.Parent).Color; //clBtnFace;
      FBox.Canvas.FillRect(FBox.Canvas.ClipRect);
      FBox.Canvas.Draw(0, 0, oIcon);
      FBox.Canvas.Unlock;
      Application.ProcessMessages;      Sleep(50);
      FStep := FStep + 1;
      if FStep > 45 then
      begin
        Sleep(100);
        FStep := 0;
      end;
    until Terminated;  finally
    oIcon.Free;
    oBitMap.Free;
  end;
end;procedure TTRBFrmProcessing.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  oRunImage.Terminate;
  Sleep(20);
  TRBFrmProcessing.TransparentColor := True;
  TRBFrmProcessing.Color := clBlack;
end;procedure TTRBFrmProcessing.FormShow(Sender: TObject);
begin
  oRunImage := TRunImage.Create(ImgDog, ImgRun);
  ImgDog.Left := Self.Left;
  ImgDog.Top := self.Top;
  self.Width := ImgDog.Width;
  self.Height := ImgDog.Height;
end;end.dfm
object TRBFrmProcessing: TTRBFrmProcessing
  Left = 0
  Top = 0
  BorderStyle = bsNone
  Caption = 'TRBFrmProcessing'
  ClientHeight = 166
  ClientWidth = 168
  Color = clBtnFace
  TransparentColor = True
  TransparentColorValue = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Position = poMainFormCenter
  OnClose = FormClose
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object ImgDog: TPaintBox
    Left = 8
    Top = 9
    Width = 153
    Height = 152
  end
  object ImgRun: TImageList
    ColorDepth = cd32Bit
    Height = 128
    Width = 128
    Left = 152
    Top = 32
    Bitmap = {
      494C01012E003100040080008000FFFFFFFF2110FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000000200000006000001002000000000000000
      3000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      00000000000000000000

解决方案 »

  1.   

    母鸡你在做什么？高版本的TImage直接支持gif，低版本有TGifImage可用。
      

  2.   

    在delphi里 gif显示动画一般是通过time消息来做的, 其实就是定时显示图片
    而你窗体初始化肯定也是主进程里进行的, 也就是说你的初始化是一种主进程的阻塞操作, 此时消息队列没有循环, time消息不会被处理 GIF自然也就不会动一般来说解决方案有2种
    1.把操作分块, 执行完一部分就刷新下界面显示进度百分比(类似delphi/photoshop的启动界面)
    2.把耗时操作放到线程里, 主进程等待线程结束同时显示GIF(一般等待网络初始化的多用这种方案)
      

  3.   

    不需要自己画，只要(Image1.Picture.Graphic as TGIFImage).Animate := true;
      

  4.   

    没看到你的什么代码初始化很占资源，还是程序结构的问题，如果确实有很耗时的初始化操作，不要放在主form的OnCreate事件处理中，单独开一个线程去做初始化，完成后设置一个标志即可。
      

  5.   


    不是反应不过来, 而是你连续执行没有处理消息循环, 所以不触发GIF刷新
      

  6.   

          FBox.Canvas.Lock;
          FImageList.GetIcon(FStep, oIcon);
    //      FBox.Canvas.Brush.Color := TPanel(FBox.Parent).Color; //clBtnFace;
          FBox.Canvas.FillRect(FBox.Canvas.ClipRect);
          FBox.Canvas.Draw(0, 0, oIcon);
          FBox.Canvas.Unlock;
    **********************************
    Canvas画完了，没有刷新
    试加上一句刷新：
    Canvas.Refresh
      

  7.   

    在delphi里 gif显示动画一般是通过time消息来做的, 其实就是定时显示图片
    而你窗体初始化肯定也是主进程里进行的, 也就是说你的初始化是一种主进程的阻塞操作, 此时消息队列没有循环, time消息不会被处理 GIF自然也就不会动一般来说解决方案有2种
    1.把操作分块, 执行完一部分就刷新下界面显示进度百分比(类似delphi/photoshop的启动界面)
    2.把耗时操作放到线程里, 主进程等待线程结束同时显示GIF(一般等待网络初始化的多用这种方案)