処理中にフォームの応答なしを回避するには？
解決環境
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しています。
長くなってしまい申し訳ありませんが、よろしくお願いします。
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;
ちょっとややこしいですが、TThread を使えば完璧にできます。
ループ部分をTThread で実行して、メイン部分からコントロールすればOK
今回の問題にただちに応用するかは別として，
>ちょっとややこしいですが、TThread を使えば完璧にできます。
というレスがあったので．
例えば，以下を今後の参考にされてはいかがでしょうか．
http://edn.embarcadero.com/article/images/40483/2C.pdf
http://edn.embarcadero.com/article/images/40483/2C.pdf
ちなみに，こういった資料は，以下から閲覧またはダウンロードできます．
[とりあえず、デベロッパーキャンプの資料を読んでみようか。]
http://ht-deko.minim.ne.jp/tech044.html
>takeさん,HOtaさん,Mr.XRAYさん
ありがとうございます。
マルチスレッドを使用すれば理想通りの動きが行えそうです。
とりあえずApplication.ProcessMessagesを使用して動作を確認し
TThreadの使い方について勉強しようと思います。
Application.ProcessMessages();
を使用することで応答なしを回避できました。
今回はループするごとに毎回呼び出すようにしました。
しかしApplication.ProcessMessages();には
全てのメッセージを処理してしまうなどの問題もあるとのことなので
マルチスレッドについて勉強していこうと思います。
ありがとうございました。
Application.ProcessMessages();
を使用することで応答なしを回避できました。
今回はループするごとに毎回呼び出すようにしました。
しかしApplication.ProcessMessages();には
全てのメッセージを処理してしまうなどの問題もあるとのことなので
マルチスレッドについて勉強していこうと思います。
ありがとうございました。
| ツイート |  |