処理中にフォームの応答なしを回避するには？

解決

レプシー 2013-02-05 15:46:32 No: 43754

環境
Delphi：4
OS：Windows7 64bit
ソースは長くなってしまうため最後に記載させて頂きます。

1．最後に記載したソースの以下のループ時にフォームをクリックしたりアクティブ⇔非アクティブを繰り返すと応答なしになってしまいます。
たまに何もしなくても途中でフォームの％ゲージが止まってしまいます。
（どの状態でも内部では処理されているようで、CSV出力が終われば正常通り動くようになりCSVファイルも保存されています。）
この応答なし状態を回避したいのですが、何か方法はあるでしょうか？
具体的にはプログレスバーの更新は最優先で、その他機能フォームの移動、最小化などは制限してしまってもいいと考えています。
          for I := 1 to Parts.RecordCount do
          begin
            if PartsSUURYOU.Value then
              SaveToCSVFileAll(slCSV, sFileName, StartDate, Header);
            Parts.Next;
            Gauge1.ProGress := I;
          end;

以下がボタンクリック時の動作です。
procedure TMotocho2Form.FncBtn12Click(Sender: TObject);
var
  StartDate: TDateTime;
  Year, Month: Word;
  sFileName, Header: String;
  ans, I: Integer;
  slCSV: TStringList;
begin
  ans := Application.MessageBox('全品目の元帳を出力します。',
                                '品目別元帳', mb_OKCancel);
  if ans = IDOK then
  begin
    if FncBtn12.Enabled then
    begin
      Year := SpinEdit1.Value;
      Month := SpinEdit2.Value;
      StartDate := EncodeDate(Year, Month, 1);
      Header := '日,品目名,単価,入庫数量,出庫数量,在庫数量';
      sFileName := 'HINMOKUBALL' +FormatDateTime('yyyymm', StartDate)+'.CSV';
      SaveDialog1.FileName := sFileName;
      if SaveDialog1.Execute then
      begin
        slCSV := TStringList.Create;
        sFileName := SaveDialog1.FileName;
        Screen.Cursor := crHourglass;
        SetPrintEnabled(False);
        Gauge1.MaxValue := Parts.RecordCount;
        Gauge1.Visible := True;
        Gauge1.ProGress := 0;
        Gauge1.Update;

        Parts.DisableControls;
        Parts.First;

        StatusLine.Caption := '  出力中';
        StatusLine.Update;

        try
          for I := 1 to Parts.RecordCount do
          begin
            if PartsSUURYOU.Value then
              SaveToCSVFileAll(slCSV, sFileName, StartDate, Header);
            Parts.Next;
            Gauge1.ProGress := I;
          end;
          slCSV.SaveToFile(sFileName);
        finally
          Parts.First;
          Parts.EnableControls;

          Screen.Cursor := crDefault;
          SaveDialog1.InitialDir := ExtractFilePath(ExpandFileName(sFileName));
          SetPrintEnabled(True);
          Gauge1.Visible := False;
          SpinEdit2.SetFocus;
          EditEnter(SpinEdit2);
          slCSV.Free;
        end;
      end;
    end;
  end;
end;

※SaveToCSVFileAllではデータベースから該当するデータを順次slCSV.ADDしています。

長くなってしまい申し訳ありませんが、よろしくお願いします。

take 2013-02-05 16:34:56 No: 43755

Application.ProcessMessagesを使えば
きっと応答無しにはならないでしょう

設計自体を改善すべきかと思いますが
とりあえずこんな感じでいかがでしょうか？

          for I := 1 to Parts.RecordCount do
          begin
            if PartsSUURYOU.Value then
              SaveToCSVFileAll(slCSV, sFileName, StartDate, Header);
            Parts.Next;
            Gauge1.ProGress := I;
            if I mod 100 = 0 then begin            // 100回に1回だけ処理
              Application.ProcessMessages();   // OSに処理を戻す
            end;
          end;

HOta 2013-02-05 21:31:05 No: 43756

ちょっとややこしいですが、TThread を使えば完璧にできます。
ループ部分をTThread で実行して、メイン部分からコントロールすればOK

Mr.XRAY 2013-02-06 12:02:14 No: 43757

今回の問題にただちに応用するかは別として，

>ちょっとややこしいですが、TThread を使えば完璧にできます。

というレスがあったので．
例えば，以下を今後の参考にされてはいかがでしょうか．

http://edn.embarcadero.com/article/images/40483/2C.pdf

Mr.XRAY 2013-02-06 12:05:19 No: 43758

http://edn.embarcadero.com/article/images/40483/2C.pdf

ちなみに，こういった資料は，以下から閲覧またはダウンロードできます．

[とりあえず、デベロッパーキャンプの資料を読んでみようか。]
http://ht-deko.minim.ne.jp/tech044.html

レプシー 2013-02-06 14:16:30 No: 43759

>takeさん,HOtaさん,Mr.XRAYさん
ありがとうございます。
マルチスレッドを使用すれば理想通りの動きが行えそうです。

とりあえずApplication.ProcessMessagesを使用して動作を確認し
TThreadの使い方について勉強しようと思います。

レプシー 2013-02-08 09:39:40 No: 43760

Application.ProcessMessages();
を使用することで応答なしを回避できました。
今回はループするごとに毎回呼び出すようにしました。

しかしApplication.ProcessMessages();には
全てのメッセージを処理してしまうなどの問題もあるとのことなので
マルチスレッドについて勉強していこうと思います。

ありがとうございました。

レプシー 2013-02-08 09:39:40 No: 43761