大きなテキストファイルを読み込むときにスプラッシュ画面にプログレスバー
  を表示するもので、キャンセルボタンをつけてあります。

   ※　引用又は参考ータ
  　　　nifty:FDELPHI/MES/06/17960
  　　　nifty:FDELPHI/MES/06/17984
  　　　nifty:FDELPHI/MES/06/17986
  　
  　以上ありがとうございました。(ﾟﾟ)(..)

  // Unit1 Begin //
  unit Unit1;

  interface

  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;

  type
    TForm1 = class(TForm)
      Button1: TButton;
      OpenDialog1: TOpenDialog;
      procedure Button1Click(Sender: TObject);
    private
      procedure ReadTextFile(fName : String);
      { Private 宣言 }
    public
      FCancel : Boolean;

      { Public 宣言 }
    end;

  var
   Form1: TForm1;

  implementation

  uses Unit2;//UNit追加

  {$R *.DFM}

  procedure TForm1.ReadTextFile(fName : String);
  var
    InString : String;
    InFile : TextFile;
    SearchRec: TSearchRec;
    Step, fSize, Delta, rSize, LengthOfLine : Integer;
  begin
    rSize := 0;
    Delta := 0;
    FCancel := False;

    Form2.Caption := '読み込み中...';
    FindFirst(fname, faAnyFile, SearchRec); //ファイルサイズを計る
    Try
      fSize := SearchRec.Size;
      Step := Trunc(fSize / 100);//Truncは実数型の値を切り捨てて整数型の値
  にします。
      AssignFile(InFile,fName);
      Reset(InFile);

      While not Eof(InFile) do
      Begin
        Readln(InFile,InString);
        Application.ProcessMessages; //アプリケーションの実行を一時的に停
  止
        If FCancel then Break;
        LengthOfLine := Length(InString) + 2;
        rSize := rSize + LengthOfLine;
        Delta := Delta + LengthOfLine;
        If Delta > Step then
        Begin
          Form2.ProgressBar1.Position := Round( rSize / fSize * 100);
          Delta := 0;
        End;
      end;
    Finally
      FindClose(SearchRec);  //FindFirstで確保したメモリの開放
      CloseFile(InFile);  //開いたものは閉じるのが作法
    End;
  end;

  procedure TForm1.Button1Click(Sender: TObject);
  begin
    If OpenDialog1.Execute then
    Begin
      Form2 := TForm2.Create(Application);
      Form2.Show;
      Form2.Update;
      ReadTextFile(OpenDialog1.FileName);
      Form2.Release;
        If FCancel then
           ShowMessage('読み込みを中止しました')
        Else
           ShowMessage('読み込みを終了しました');
    End;
  end;

  end.

  // Unit1 end //

  // Unit2 Begin //

  unit Unit2;

  interface

  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls;

  type
    TForm2 = class(TForm)
      Panel1: TPanel;
      BitBtn1: TBitBtn;
      ProgressBar1: TProgressBar;
      procedure BitBtn1Click(Sender: TObject);
    private
      { Private 宣言 }
    public
      { Public 宣言 }
    end;

  var
    Form2: TForm2;

  implementation

  uses Unit1;

  {$R *.DFM}

  procedure TForm2.BitBtn1Click(Sender: TObject);
  begin
    Form1.FCancel := True;
  end;

  end.

  // Unit2 End //

Original document by かぼちゃの馬車  氏 ID:(MXF01374)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。