Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2018年10月20日] [更新 2018年10月20日]　Delphi サンプルプログラム集
714_進捗状況の表示用コントロール
動作確認等 Windows 7 U64(SP1) + Delphi 10.2.3 Community
714_ProgressControl.zip　[4,048 KB]　2018年10月20日版 (EXE 同梱)






時間のかかる処理のプログレス表示またはアニメーション表示


時間のかかる処理の間，プログレスバーで進捗状況 (シンチョクジョウキョウ) を表示したり，アニメーション表示をする例です．
本ページのサンプルコードでは使用していませんが，一般的に，時間かかる処理は別のスレッドを使用するのが基本です．





01_TProgressBar コンポーネント


TProgressBar (プログレスバー) コンポーネントを使用して，処理の進行の程度 (進捗状況) を表示するサンプルです．


図1
プログレスバーによる進捗状況の表示

リスト1
TProgressBar コンポーネントを使用する進捗状況の表示例		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MMSystem;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ProgressBar1.Anchors := [akLeft, akTop, akRight];
end;

//=============================================================================
//  プログレス表示のテスト
//
//  usesにMMSystemが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMaxTime   : UInt64;
  LTime      : Cardinal;
  LStartTime : Cardinal;
begin
  LMaxTime   := 3500;
  LStartTime := TimeGetTime;

  ProgressBar1.Max := LMaxTime;

  //時間のかかる処理の代わりとしてのループ
  while True do begin
    LTime := timeGetTime - LStartTime;
    if LTime > LMaxTime then break;

    ProgressBar1.Position := LTime;

    Application.ProcessMessages;
    //これがないとCPU使用率が跳ね上がることがある
    Sleep(1);
  end;
end;

end.



02_TProgressBar コンポーネント - 進捗の割合を数値で表示


前項と同じく TProgressBar コンポーネントで進捗状況を表示しますが，TProgressBar の上下中央に進捗状態の割合をパーセントで表示する例です．
パーセントの数値は TLabel に表示します．実行時に TLabel の親 (Parent) を TProgressBar にして，表示位置を設定しています．


図2
設計時の画面
  • TLabel は TProgressBar には載らない
図3
プログレスバーによる進捗状況の表示
  • TLabel に進捗の割合を数字で表示

リスト2
TProgressBar コンポーネントを使用する進捗状況の表示例．進捗の割合を数値で表示		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MMSystem;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ProgressBar1.Anchors := [akLeft, akTop, akRight];

  //進捗状況のテキスト表示用TLableの設定
  Label1.Parent    := ProgressBar1;
  Label1.Align     := alClient;
  Label1.Alignment := taCenter;
  Label1.Layout    := tlCenter;
end;

//=============================================================================
//  プログレス表示のテスト
//  進捗状況をパーセント表示
//  表示にはTLabelを使用
//
//  usesにMMSystemが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMaxTime   : UInt64;
  LTime      : Cardinal;
  LStartTime : Cardinal;
begin
  LMaxTime   := 3500;
  LStartTime := TimeGetTime;

  ProgressBar1.Max := LMaxTime;

  //時間のかかる処理の代わりとしてのループ
  while True do begin
    LTime := timeGetTime - LStartTime;
    if LTime > LMaxTime then break;

    ProgressBar1.Position := LTime;
    Label1.Caption := IntToStr(Trunc(LTime / LMaxTime * 100)) + ' %';
    //表示を更新
    Label1.Update;

    Application.ProcessMessages;
    //これがないとCPU使用率が跳ね上がることがある
    Sleep(1);
  end;
end;

end.



03_TActivityIndicator コンポーネント


Delphi 10 Seattle で実装された TActivityIndicator (アクティビティインジケータ) コンポーネントを使用する例です．Windows 10 の起動時に表示される，グルグルと回転するように見えるアニメーションを描画します．

TActivityIndicator コンポーネントの表示サイズは 4 つだけです．IndicatorSize プロパティで設定します．Width, Height プロパティではサイズは設定できません．



図4
設計時の画面
  • 選択中のコントロールが TActivityIndicator コンポーネント
図5
TActivityIndicator によるアニメーション表示

リスト3
TActivityIndicator コンポを使用して処理中にアニメーション表示		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  Vcl.WinXCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ActivityIndicator1: TActivityIndicator;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MMSystem;

{$R *.dfm}

//=============================================================================
//  TActivityIndicatorによるアニメーション表示
//
//  usesにMMSystemが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMaxTime   : UInt64;
  LTime      : Cardinal;
  LStartTime : Cardinal;
begin
  LMaxTime   := 10000;
  LStartTime := TimeGetTime;

  //アニメーション開始
  ActivityIndicator1.Animate := True;

  //時間のかかる処理の代わりとしてのループ
  while True do begin
    LTime := timeGetTime - LStartTime;
    if LTime > LMaxTime then begin
      //アニメーション終了
      ActivityIndicator1.Animate := False;
      break;
    end;

    Application.ProcessMessages;
    //これがないとCPU使用率が跳ね上がることがある
    Sleep(1);
  end;
end;

end.



04_TActivityIndicator コンポーネント - 進捗の割合を数値で表示


前項と同じく TActivityIndicator コンポーネントを使用する例ですが，TActivityIndicator の上下中央に進捗状態の割合をパーセントで表示する例です．
パーセントの数値は TLabel に表示します．TActivityIndicator.ControlStyle に csAcceptsControls を含めると TLabel の親コントロールにすることができますが，アニメーションの描画の際にかなりチラつきます．そこで，TLabel を TActivityIndicator コンポーネントと同じサイズにして，同じ位置に配置して使用しています．


図6
設計時の画面
図7
TActivityIndicator によるアニメーション表示
  • TLabel に進捗の割合を数字で表示

リスト4
TActivityIndicator コンポを使用して処理中にアニメーション表示．進捗の割合を数値で表示		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  Vcl.WinXCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    ActivityIndicator1: TActivityIndicator;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MMSystem;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//
//  TActivityIndicatorのControlStyleにcsAcceptsControlsを含めるとコンテナにでき
//  TLabelを配置できるが，アニメーションの描画でかなりチラつく
//  そこでTLabelをTActivityIndicatorと同じ位置とサイズで配置
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //TActivityIndicatorの各種設定
  ActivityIndicator1.IndicatorColor := aicBlack;
  ActivityIndicator1.IndicatorSize  := aisXLarge;
  ActivityIndicator1.FrameDelay     := 50;

  //進捗状況のテキスト表示用TLableの設定
  Label1.AutoSize  := False;
  Label1.Parent    := ActivityIndicator1.Parent;
  Label1.Left      := ActivityIndicator1.Left;
  Label1.Top       := ActivityIndicator1.Top;
  Label1.Width     := ActivityIndicator1.Width;
  Label1.Height    := ActivityIndicator1.Height;
  Label1.Alignment := taCenter;
  Label1.Layout    := tlCenter;
  Label1.Visible   := False;
end;

//=============================================================================
//  TActivityIndicatorによるアニメーション表示
//  進捗状況をパーセント表示
//  表示にはTLabelを使用
//
//  usesにMMSystemが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LMaxTime   : UInt64;
  LTime      : Cardinal;
  LStartTime : Cardinal;
begin
  LMaxTime   := 10000;
  LStartTime := TimeGetTime;

  //アニメーション開始
  ActivityIndicator1.IndicatorType  := aitSectorRing;
  ActivityIndicator1.Animate := True;
  Label1.Visible := True;

  //時間のかかる処理の代わりとしてのループ
  while True do begin
    LTime := timeGetTime - LStartTime;

    if LTime > LMaxTime then begin
      //アニメーション終了
      Label1.Visible := False;
      ActivityIndicator1.Animate := False;
      break;
    end;

    //進捗状況をパーセント表示
    Label1.Caption := IntToStr(Trunc(LTime / LMaxTime * 100)) + ' %';

    Application.ProcessMessages;
    //これがないとCPU使用率が跳ね上がることがある
    Sleep(1);
  end;
end;

//=============================================================================
//  TActivityIndicatorによるアニメーション表示
//  進捗状況をパーセント表示
//  表示にはTLabelを使用
//
//  usesにMMSystemが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LMaxTime   : UInt64;
  LTime      : Cardinal;
  LStartTime : Cardinal;
begin
  LMaxTime   := 10000;
  LStartTime := TimeGetTime;

  //アニメーション開始
  ActivityIndicator1.IndicatorType := aitMomentumDots;
  ActivityIndicator1.Animate := True;
  Label1.Visible := True;

  //時間のかかる処理の代わりとしてのループ
  while True do begin
    LTime := timeGetTime - LStartTime;

    if LTime > LMaxTime then begin
      //アニメーション終了
      Label1.Visible := False;
      ActivityIndicator1.Animate := False;
      break;
    end;

    //進捗状況をパーセント表示
    Label1.Caption := IntToStr(Trunc(LTime / LMaxTime * 100)) + ' %';

    Application.ProcessMessages;
    //これがないとCPU使用率が跳ね上がることがある
    Sleep(1);
  end;
end;

end.



05_TTaskbar コンポーネン ト - タスクバーにプログレス表示


TTaskbar コンポーネン トを使用すると，タスクバーに進捗状態をプログレス表示できます．以下の記事に実際のサンプルがあります．
TTaskbar コンポーネントは Delphi XE6 で実装されたコンポーネントです．


図8
タスクバーにプログレス表示