delphi 在子執行緒加載GIF圖元，用于顯示程式運行進度

需要在程式中加載gif圖片，用于顯示程式的進度， 但是在主執行緒中初始化非常的占用資源，導致如果是在主執行緒中加載gif，根本就不能重繪。
后來嘗試在子執行緒通過執行緒加載每一幀的圖片，以實作動態的效果， 但是造成了頻繁向主執行緒申請資源，造成了初始化程式更慢。 
代碼如下， 各位還有別的思路嗎？  

unit TRBProcessing;

interface

uses
  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

uj5u.com熱心網友回復：

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

uj5u.com熱心網友回復：

就是在程式初始化的時候， 通過動態加載圖，顯示程式的進度， 上面是顯示動態的代碼， 幫忙看看該怎么優化，不站主程式的資源

uj5u.com熱心網友回復：

在delphi里 gif顯示影片一般是通過time訊息來做的, 其實就是定時顯示圖片
而你表單初始化肯定也是主行程里進行的, 也就是說你的初始化是一種主行程的阻塞操作, 此時訊息佇列沒有回圈, time訊息不會被處理 GIF自然也就不會動

一般來說解決方案有2種
1.把操作分塊, 執行完一部分就重繪下界面顯示進度百分比(類似delphi/photoshop的啟動界面)
2.把耗時操作放到執行緒里, 主行程等待執行緒結束同時顯示GIF(一般等待網路初始化的多用這種方案)

uj5u.com熱心網友回復：

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

uj5u.com熱心網友回復：

回復4樓， 不可以， 程式初始化很站資源， 反映不過來， 不能夠重繪

uj5u.com熱心網友回復：

在頂一下，別沉底

uj5u.com熱心網友回復：

沒看到你的什么代碼初始化很占資源，還是程式結構的問題，如果確實有很耗時的初始化操作，不要放在主form的OnCreate事件處理中，單獨開一個執行緒去做初始化，完成后設定一個標志即可。

uj5u.com熱心網友回復：

參考 5 樓 張志峰 的回復:

回復4樓， 不可以， 程式初始化很站資源， 反映不過來， 不能夠重繪

不是反應不過來, 而是你連續執行沒有處理訊息回圈, 所以不觸發GIF重繪

uj5u.com熱心網友回復：

      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

uj5u.com熱心網友回復：

在delphi里 gif顯示影片一般是通過time訊息來做的, 其實就是定時顯示圖片
而你表單初始化肯定也是主行程里進行的, 也就是說你的初始化是一種主行程的阻塞操作, 此時訊息佇列沒有回圈, time訊息不會被處理 GIF自然也就不會動

一般來說解決方案有2種
1.把操作分塊, 執行完一部分就重繪下界面顯示進度百分比(類似delphi/photoshop的啟動界面)
2.把耗時操作放到執行緒里, 主行程等待執行緒結束同時顯示GIF(一般等待網路初始化的多用這種方案)

轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/34211.html

標籤：VCL組件開發及應用

上一篇：delphi 10 生成XML檔案時 無法生成 語言資訊 encoding

下一篇：fastreport的allowSplit選項找不到