TThreadクラス
TThreadクラスのスレッド
此処では、スレッドの使用について少し検討をします。
スレッドは、高速に処理が出来るのと、複数のスレッドを並列に処理が出来るので便利な機能です。
特に、通信処理には欠かせない機能です。
本ホームページで紹介をしています、ＲＳ２３２Ｃコンポーネントも、スレッドを使用しています。
TCP/IP通信も、送受信処理にスレッドが欠かせません。
左図は、ここでダウンロード出来るサンプルプログラムの ThreadTest0 の実行画面です。
ThreadTest0
は、一般的なスレッドの実行例ですが、インターネットで、スレッドの実行例として検索しても、スレッドを一つだけ起動する例が殆どですので、同じスレッドを二つ起動する例を取り上げてみました。
とにかく、一つ出来れば、簡単だろうと複数同時同じスレッドを起動するのは、例として取り上げてないようです。
同じスレッドを複数起動するのには、スレッド型を必要な数だけ用意します。
配列にすれば、簡単です。動的配列にすれば、プログラム中で必要な数を確保することも可能です。
Threadary : array[0..1] of TplTimerThread; スレッド型の配列
ここの例ではボタン、パネル等は、固定となっていますが、ＴＢｕｔｔｏｎ、ＴＰａｎｅｌ 等の配列を用意し Create を使用してＢｕｔｔｏｎ、Ｐａｎｅｌ 等も生成すれば、必要な数だけ用意することができます。
メインVCL/CLXスレッドを使用する場合は、 Synchronize を使用しますが、スレッドセーフなら必要無いようですが、何がスレッドセーフなのか判断が難しいようです。
(メモリー関係にも、アクセス保護の機能がありますが、そちらは、Helpを参照して下さい。)
普通のスレッドの使用例は、インターネットで探せば沢山あるのでそれを参考にして下さい。
ここでダウンロード出来るサンプルプログラムでは、スレッドの実行中に、クローズボタンでプログラムを終了するとメモリーリークが発生します。
スレッドの実行中は、プログラムを終了出来ないようにするか、スレッドを終了してからプログラムが終了するようにするする必要があります。
BeginThread
BeginThreadは、スレッドを簡単に生成、終了することが簡単に出来るのですが、あまり使用例が無いので、少し検討をしてみました。
左図は、スレッドの中から、ラベルの表示を変更した場合のフォントサイズの異常表示の例です。
ＬａｂｅｌのAutoSizeをTrueに設定しておくと、文字のサイズが正しく設定されない時があります。
発生頻度はかなり高いのですが、プログラム自体の暴走は無いようです。
正しく表示させるためには、AotoSizeをFalseに設定し、更に、文字が表示されるだけの領域を確保しておきます。
StaticTextの場合は、起動時に確保された領域より長い文字を表示しようとすると、AutoSizeが動作せず、領域を超えた部分は表示されません。
プログラムの起動時に、表示する文字の長さ分、表示領域を確保しておけば、正常に表示されます。
BeginThread
のスレッドから、VCL関係を実行する場合は PostMessageを使用するのが一番良いようです。
AotoSizeをTrue
のままにしておいても、問題は発生しません。
VCL関係にPostMessageを使用しない場合は、VCLとの同期が完全に取れないので、どのような条件のときハングアップが生じるか分かりません。
しかし、PostMessage を使用した メカコントロールプログラムの場合は、フォームの移動処理、フォームクローズボタンのマウス左ボタンダウンは、メッセージを停止させるので、対策が必要です。
この章で取り上げている プログラム例以外の物も、ダウンロードＺｉｐ ファイルの中に入っているので、テストしてみて下さい。
ThreadTest1
次のプログラムリストは、Label 及び StaticText
の文字の異常表示が無いようにしたものです。
Label StaticText は、固定長に設定しています。
スレッド内で String 変数が使用されるとメモリーリークが発生するため、String
を使用するルーチンは、スレッド外に置いています。
ここの例では、beginThread が二つ有りますが、二つのスレッドが、同じサブルーチンを同時に実行することは出来ないので、TCriticalSection を使用して衝突を避けています。
Synchronize は beginThread では使用出来ません。
ためしに Button のサイズ、Caption をスレッド内から変更してみましたが、スレッド毎にButtonが違えば、これは特に問題は生じないようです。
同じボタンの場合は TCriticalSection を使用する必要があります。
TChartへのデーターの追加も行ってみましたが、問題なく追加が可能です。
TChartへデーターを追加する場合、二つのスレッドから一つの TChartの同じ Series[*] にデーターを追加する場合は、当然 TCriticalSection
を使用してスレッド同士の衝突を避ける必要があります。
又、スレッドが複数の場合はループの中で 必ず Sleep(*)
を行い、他のスレッドが実行出来る様にする必要があります。
データーの追加表示は、データーの数が増えると同時に、時間も掛かるようになるので、最大のデーター数に注意する必要があります。
(for
ループで連続してデーターの追加のみ行う場合は、表示の更新が行われないので、問題ありません。)
スレッド内から
VCL関係を直接使用すると、TChartのようなプログラムの実行には、多くの時間を要するので、スレッドを使用する意味があまりなくなってしまいます。
プログラムを一つしか起動しない場合は良いのですが、画面の表示に沢山の時間を要するインターネット等を同時に起動するとハングアップするようです。
又、ＯＳのバージョン、グラフィクのドライバーによっても、ハングアップする確率が違うようなので注意が必要です。
テストした結果では、ＸＰ、VISTAでは、長時間インターネットと同時に実行したらハングアップしました。
ＷＩＮ７、８、１０では、未だ発生の確認は出来ていません。（テストをした範囲内では発生しませんでしたが、本当に発生しないかは、不明です）
TChart、或いは、時間を要する表示は、PostMessage を利用したほうが良いようです。
PostMessageを使用すると、スレッドと、表示のルーチンが切り離されるので、スレッドの処理が早くなります。
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, SyncObjs, VCLTee.TeEngine, VCLTee.Series, Vcl.ExtCtrls,
VCLTee.TeeProcs, VCLTee.Chart;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Edit3: TEdit;
Chart1: TChart;
Series1: TLineSeries;
Series2: TLineSeries;
CheckBox1: TCheckBox;
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private 宣言 }
Procedure WMSysCommand(var Messages: TWMSysCommand);message WM_SysCommand;
public
{ Public 宣言 }
procedure ThreadStart1;
procedure ThreadStart2;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type // スレッドレコードの定義
TThreadParams = record // スレッドに値を渡す
FButton : TButton;
FEdit : Tedit;
FLabel : TLabel;
FTimeValue : Integer;
Fidno : Integer;
end;
PThreadParams = ^TThreadParams;
var
StopF : Boolean; // スレッド停止用フラグ
CS : TCriticalSection; // 多重実行防止 スレッドによる実行の衝突を防ぐ
//=============================================================================================
// SYSTEM Command 処理
// 測定用ソフトやメカコントロールソフトの場合 SYSTEM Command メッセージ(Postmessage)処理があると
// 悪影響があるものがあり、特に SC_MOVE は表示の実行をとめ表示の割り込み処理が溜まってしまいます。
// ここの例ではメッセージ(Postmessage)処理を使用していないので、滞ることはありません
//=============================================================================================
Procedure TForm1.WMSysCommand(var Messages: TWMSysCommand); // フォームのborder Close ボタンのみ有効の場合
begin
case (messages.CmdType and $FFF0) of
SC_SIZE : Messages.Result := 0; // サイズ変更キャンセル bsSizeableの時 bsSingleであれば不要
SC_CLOSE: Button4Click(nil); // フォームのborder Closeボタン
// SC_MOVE : if StopF
// then inherited // スレッド停止していたらフォーム移動
// else Messages.Result := 0; // フォームの移動キャンセル
else
inherited; // 指定以外はデフォルト処理
end;
end;
//=============================================================================================
// カウント値表示
// スレッド内でStringを扱うとメモリーリークが発生するためサブルーチンにします。
//=============================================================================================
procedure Threadsub(FCont: integer; Param: PThreadParams); // スレッド内のカウンターの値表示
begin
Param^.FEdit.Text := inttostr(FCont);
Param^.FEdit.Update;
if not Form1.CheckBox1.Checked then exit;
case Param^.Fidno of
1: begin
if Fcont < 120 then
Form1.Chart1.Series[0].Add(Fcont)
else
Form1.Chart1.Series[0].Clear;
end;
2: begin
if Fcont < 250 then
Form1.Chart1.Series[1].Add(Fcont)
else
Form1.Chart1.Series[1].Clear;
end;
end;
// Form1.Chart1.Update;
end;
//=============================================================================================
// スレッド
// スレッド内で、Labelの文字を変更していますが、VCL（表示ルーチン）と同期が取れないので
// 問題があります。
// Labelを固定サイズにして、表示領域を最大文字数より大きくし、VCLの処理を短くします。
// Button. の変更は特に問題は無いようです。
// このスレッド内で、String を扱う実行文が入るとメモリーリークが発生します。
//=============================================================================================
procedure TimerThread(Param : PThreadParams); // スレッドの例
var
Count: integer;
begin
while not StopF do begin
Param^.FLabel.Caption := 'Going'; // 'Going' const stringはOK メモリーリークなし。
Param^.FLabel.Update; // LabelをAutoSizeにしておくと、文字のサイズに
// 異常が出る場合があります。
Param^.FButton.Caption := 'Going'; // Button.caption は 特に問題なし
Param^.FButton.Width := 80; // Button with 変更特に問題なし
Param^.FButton.Height := 30; // Button hight 変更特に問題なし
Count:= 0;
while Param^.FTimeValue >= Count do begin // Countの値待ち
{
// スレッド内でIntToStr (String)を使用するとメモリーリークが発生します。
Param^.FEdit.Text := IntToStr(FCont);
Param^.FEdit.Update;
}
// 他のスレッドが処理を終了するのを待つ
CS.Enter;
try
// メモリーリークが発生しないようにサブルーチンでStringルーチンを使用します
Threadsub(Count, Param);
finally
CS.Leave; // 処理終了
end;
// これがないとCPU使用率が跳ね上がります 此処ではタイマー役割も兼用
// 他のスレッドが実行できるようにするため必ず必要です
Sleep(5); // 用途に応じてスリープ時間を設定する最小値は１
inc(Count); // カウンターインクリメント
end;
if not StopF then begin
Param^.FLabel.Caption := 'Stop'; // 'Stop' const stringはOK メモリーリークなし
Param^.FLabel.Update;
end;
Param^.FButton.Caption := 'Stop';
Param^.FButton.Width := 50;
Param^.FButton.Height := 25;
// 終了したらビープ音
case Param^.Fidno of
1: Winapi.windows.Beep( 800, 70);
2: Winapi.windows.Beep(1000, 70);
end;
Sleep(200); // 用途に応じてスリープ時間を設定する最小値は１
end;
case Param^.Fidno of
1: Param^.FButton.Caption := 'スレッド１';
2: Param^.FButton.Caption := 'スレッド２';
end;
Param^.FButton.Height := 25;
Param^.FButton.Width := 89;
Param^.FButton.Enabled := True;
//スレッド終了
Dispose(Param); // スレッドレコードの破棄 New で確保したメモリーの破棄
EndThread(0); // スレッド終了 無くても自動的に終了 スレッドは破棄されます
end; // (0) の値は、終了コードで、GetExitCodeThreaで取得出来ます
//=============================================================================================
// 終了処理
//=============================================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
CS.Free; // スレッドによる多重実行防止開放
end;
//=============================================================================================
// 初期設定
// Labelを固定サイズにする 固定サイズにしないと表示異常が発生します。
// Labelの表示領域を最大文字数より大きくしておきます。
//=============================================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Top := (Screen.Height - Height) div 2;
Left := (Screen.Width - Width) div 2;
StopF := True;
Label1.AutoSize := False; // Labelを固定サイズにする 固定サイズにしないと表示異常が発生します。
Label2.AutoSize := False;
Label1.Height := 13; // Labelの表示領域設定 文字が全て表示出来るだけのサイズを確保します。
Label1.Width := 65;
Label2.Height := 13;
Label2.Width := 65;
CS := TCriticalSection.Create; // スレッドによる多重実行防止生成
end;
//=============================================================================================
// スレッドのスタート処理
//=============================================================================================
procedure TForm1.ThreadStart1;
var
id : Cardinal;
Pinfo : PThreadParams;
begin
Button1.Enabled := False;
New(Pinfo); // 新しい動的変数を作成し，Pinfo をその変数のポインタに設定します。
Pinfo.FButton := Button1; // Button1のポインタ
Pinfo.FEdit := Edit1; // Edit1のポインタ
Pinfo.FLabel := Label1; // Label1のポインタ
Pinfo.FTimeValue := 120; // カウンター値の値
Pinfo.Fidno := 1;
CloseHandle(BeginThread(nil, 0, Addr(TimerThread), Pinfo, 0, id)); // スレッドの生成
end;
procedure TForm1.ThreadStart2;
var
id : Cardinal;
Pinfo : PThreadParams;
begin
Button2.Enabled := False;
New(Pinfo); // 新しい動的変数を作成し，Pinfo をその変数のポインタに設定します。
Pinfo.FButton := Button2; // Button2のポインタ
Pinfo.FEdit := Edit2; // Edit2のポインタ
Pinfo.FLabel := Label2; // Label2のポインタ
Pinfo.FTimeValue := 250; // カウンター値の値
Pinfo.Fidno := 2;
CloseHandle(BeginThread(nil, 0, Addr(TimerThread), Pinfo, 0, id)); // スレッドの生成
end;
//=============================================================================================
// スタート、ストップ ボタン関係
//=============================================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
StopF := False;
ThreadStart1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StopF := False;
ThreadStart2;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
StopF := True;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if Button1.Enabled and Button2.Enabled then Close;
end;
end.
ThreadTest3
次のプログラムリストは、Label 及び StaticText
の文字の異常表示が無いようにしたものです。
Label StaticText は、固定長に設定しています。
スレッド内で String 変数が使用されるとメモリーリークが発生するため、String
を使用するルーチンは、スレッド外に置いています。
ここの例では、beginThread が二つ有るので、二つのスレッドが同じサブルーチンを同時に実行することは出来ないので、TCriticalSection を使用して衝突を避けています。
Synchronize は beginThread では使用出来ません。
ここまでは、ThreadTest1と同じです。
StaticTextにはハンドルがあるので SendMessage を使用して書き換えを行ってみましたが、固定長で 文字の長さ分領域の確保をしないと、正しく表示されません。
SendMassageを使用しない場合と変わりませんでした。
又、SendMassagは、処理がすむまで戻らないので、実行処理時間の長いものには向いていません。
スレッドの開始時、ハンドルを閉じていますが、
CloseHandle(BeginThread(nil, 0, Addr(TimerThread), Pinfo, 0, id)); // スレッドの開始
スレッドが終了するわけではありません、単にハンドルがなくなるだけで、スレッドが実行状態に有れば、そのまま維持し続けます。
スレッドは、EndThreadか、スレッドが終了した時点で、自動的に破棄されます。
スレッドが終了した時の状態を知りたい場合は、ハンドルは、スレッドが終了した後で破棄をします。
ダウンロードZipファイルの中の ThreadTest3 は、スレッドの中から 全て SendMessage を使用して表示の変更をしています。
VCLとの同期が取れるのし、スレッドの衝突は発生しませんが、SendMessage
は、実行が終了まで、制御が戻らないので、スレッドの実行時間が非常に多く掛かります。
SendMessage の、表示関係は、Update を使用しないと、表示されるのが遅れます。
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, MMSystem, SyncObjs;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
StaticText1: TStaticText;
StaticText2: TStaticText;
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
Procedure WMSysCommand(var Messages: TWMSysCommand);message WM_SysCommand;
public
{ Public 宣言 }
procedure ThreadStart1;
procedure ThreadStart2;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type // スレッドレコードの定義
TThreadParams = record // スレッドに値を渡す
FButton : TButton;
FEdit : Tedit;
FTimeValue : Integer;
FHWd : HWND;
end;
PThreadParams = ^TThreadParams;
var
StopF : Boolean; // スレッド停止用フラグ
CS : TCriticalSection; // 多重実行防止 実行の衝突を防ぐ
//=============================================================================================
// SYSTEM Command 処理
// 測定用ソフトやメカコントロールソフトの場合 SYSTEM Command でメッセージの処理に
// 悪影響があるものがあり、特に SC_MOVE はメッセージによる表示の実行をとめ表示の
// 処理が溜まってしいます。
//=============================================================================================
Procedure TForm1.WMSysCommand(var Messages: TWMSysCommand); // フォームのborder Close ボタンのみ有効の場合
begin // メカコントロール用の場合は、minimize Maximize は非表示に設定
case (messages.CmdType and $FFF0) of
SC_SIZE : Messages.Result := 0; // サイズ変更キャンセル bsSizeableの時 bsSingleであれば不要です
SC_CLOSE: Button4Click(nil); // フォームのborder Closeボタン
SC_MOVE : if StopF
then inherited // スレッド停止していたらフォーム移動
else Messages.Result := 0; // フォームの移動キャンセル
else
inherited; // 指定以外はデフォルト処理
end;
end;
//=============================================================================================
// スレッド内のカウンターの値表示
// スレッド内でStringを扱うとメモリーリークが発生するためサブルーチンにします。
//=============================================================================================
procedure Threadsub(FCont: integer; Param: PThreadParams); // スレッド内のカウンターの値表示
begin
Param^.FEdit.Text := inttostr(FCont); // 此処でStringが使用されています。
Param^.FEdit.Update;
end;
//=============================================================================================
// スレッド
// スレッド内のカウンターの値表示は、サブルーチンを呼び出しますが他のスレッドと衝突を避けるため
// TCriticalSectionを使用します。
// Button.Enabled の変更は、フラグの変更のみであとは VCLが自動的に行うので問題ないようです。
// Statictextには、Handleが有るので、SendMessageで表示を変更します
//=============================================================================================
procedure TimerThread(Param : PThreadParams); // スレッドの例
var
Count : integer;
FPchar1, FPchar2 : pchar;
begin
FPchar1 := 'Going'; // 固定長なのでメモリーリーク問題なし
FPchar2 := 'Stop'; // 固定長なのでメモリーリーク問題なし
// StopF が true になるまでループする
while not StopF do begin
SendMessage(Param^.FHWD, WM_SETTEXT, 0, integer(FPchar1)); // Statictextに表示書き換えメッセージを送る
Count:= 0;
// カウンターの値が設定値になるまでループする
while Param^.FTimeValue >= Count do begin // Countの値待ち
CS.Enter; // 他のスレッドが処理を終了するのを待つ
try
Threadsub(Count, Param);
finally
CS.Leave; // 処理終了
end;
// これがないとCPU使用率が跳ね上がります 此処ではタイマー役割も兼用
// 又、他のスレッドが正しく動作しません
Sleep(5); // 用途に応じてスリープ時間を設定する最小値は１
inc(Count); // カウンターインクリメント
end;
// 終了したらビープ音
Winapi.windows.Beep(800, 70);
SendMessage(Param^.FHWD, WM_SETTEXT, 0, integer(FPchar2)); // Statictextに表示書き換えメッセージを送る
Sleep(200); // 用途に応じてスリープ時間を設定する最小値は１
end;
Param^.FButton.Enabled := True;
//スレッド終了
Dispose(Param); // レコードの破棄
EndThread(0); // スレッド終了
end;
//=============================================================================================
// 終了処理
//=============================================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CS.Free; // スレッド多重実行防止開放
end;
//=============================================================================================
// 初期設定
//=============================================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Top := (Screen.Height - Height) div 2;
Left := (Screen.Width - Width) div 2;
StopF := True;
Statictext1.Caption := 'Stop '; // 表示領域の確保 文字数で確保 又は width で確保する
Statictext2.Width := 71; // 表示領域てwidthで確保
Statictext1.AutoSize := False; // 表示枠サイズ固定
Statictext2.AutoSize := False;
CS := TCriticalSection.Create; // スレッド多重実行防止生成
end;
//=============================================================================================
// スレッドのスタート
//=============================================================================================
procedure TForm1.ThreadStart1;
var
id : Cardinal;
Pinfo : PThreadParams;
begin
Button1.Enabled := False;
New(Pinfo);
Pinfo.FButton := Button1;
Pinfo.FEdit := Edit1;
Pinfo.FTimeValue := 120;
Pinfo.FHWd := Statictext1.Handle;
CloseHandle(BeginThread(nil, 0, Addr(TimerThread), Pinfo, 0, id)); // スレッドの開始
end;
procedure TForm1.ThreadStart2;
var
id : Cardinal;
Pinfo : PThreadParams;
begin
Button2.Enabled := False;
New(Pinfo);
Pinfo.FButton := Button2;
Pinfo.FEdit := Edit2;
Pinfo.FTimeValue := 250;
Pinfo.FHWd := Statictext2.Handle;
CloseHandle(BeginThread(nil, 0, Addr(TimerThread), Pinfo, 0, id)); // スレッドの開始
end;
//=============================================================================================
// スタートストップ ボタン類
//=============================================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
StopF := False;
ThreadStart1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StopF := False;
ThreadStart2;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
StopF := True;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if Button1.Enabled and Button2.Enabled then Close;
end;
end.
ThreadTest2
此処ではPostMessageを使用してLabel、StaticText 等の変更を行う場合を取り上げています。
Label、StaticText
の AutoSize をTrueに設定していても、 PostMessag を使用すれば、正しく表示されます。
又、TCriticalSection
を使用しなくても、ルーチンの多重実行、衝突は発生しません。
但し、実行速度が多少遅くなりますが、スレッドのループには大きな影響は与えません。
Synchronize は、メッセージを使用しているので、PostMessage を使用すれば、Synchronize と同じ効果を得ることが出来ます。
注意する点は、メカコントロール実行時は、SC_MOVE コマンドの処理をしないようにします。
又、フォームのクローズボタンはグレイアウトします。
Windows
API の EnableMenuItem を利用して グレイアウトを行いますが EnableMenuItem は、スレッド終了時に、グレイアウトから復帰させることも出来ます。
SC_CLOSEの処理は、フォームのクローズボタンを表示していなければ必要ありません。
特にメカコントロールプログラム、測定プログラムの実行中は、SC_MOVE、フォームのクローズボタンは、マウスでの左ボタンダウン時にメッセージ処理が停滞してしまう為です。
TThreadクラスのスレッドでも、メッセージを使用しているので、同じ処理が必要です、又、スレッドの終了を待たずにプログラムを終了すると、メモリーリークが発生します。
更に、プログラムの実行時間にも注意が必要です。
PostMessaの処理は、ビギンスレッドの Sleep(*) 時間に実行されるので、* 時間の長さに注意が必要です。
前のPostMessage 処理が済まない内に、次のPostMessageを送られて、処理が停滞すると、他のスレッドの実行が困難となります。
しかし、異常終了するような事は発生しません。
ここでは、スレッドの起動時に、スレッドハンドルを破棄しないようにしています。
スレッドハンドルの破棄は、スレッドが終了してから行い、スレッドの終了の理由が分かるようにしています。
EndThread(FEXITCOAD) の FEXITCOAD の 値を指定すると、スレッド終了後 FEXITCOAD の値を取得することが出来ます。
EndThread 無しで終了すると、 終了コードは １ の値が帰ってきます。
EndThreadが無くても、スレッドが終了すると、そのスレッドはメモリーから破棄されますが、ハンドルは、明示的に破棄をする必要があります。
スレッドの実行中にハンドルを破棄しても、実行中のスレッドが停止するわけでもなく、スレッドの破棄も起こりません。
スレッドのメモリーからの解放は、あくまでもスレッド終了時点で、自動的になされます。
ダウンロードZipファイルのプログラム例の ThreadTest2
にはＴＣｈａｒｔ を追加した例が入っています。
PostMessage を使用する為には、メッセージの送り先が必要です。
メッセージの送り先としては、二つあり、
１： Formのハンドルに PostMessage
を送り、ユーザー用メッセージにより、指定の手続き（プロシージャ）を実行する。
２： 指定の手続きに（プロシージャ）に Windows handle
を設定しPostMessage を送る。
です。
メッセージに使用できる値は WM_APP (0x8000) ～ 0xBFFF の範囲です。
ここの例は、ダウンロードＺｉｐファイル中のプログラムの一部です。 //****************** １：の例 **************************************************************************** unit Main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; const TH_MESSAGE0 = WM_APP; // WM_APP through 0xBFFF Messages available for use by applications. TH_MESSAGE1 = WM_APP + 1; // 0x8000 ～ 0xBFFF アプリケーションで自由に定義できる Messages コード type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private 宣言 } //----------------------------------------------------------------------------------- // Form1.Handle へのメッセージ処理に組み込まれます。 // Form1.Handle に TH_MESSAGE が message として送られると 指定の実行行(WindowsProcd) // が呼び出されます //----------------------------------------------------------------------------------- procedure WindowsProcd0(var Msg: Tmessage); message TH_MESSAGE0; procedure WindowsProcd1(var Msg: Tmessage); message TH_MESSAGE1; public { Public 宣言 } end; //============================================================================================= // Postmessage の処理 //============================================================================================= // 表示処理 procedure TForm1.WindowsProcd0(var Msg: Tmessage); // PostMessage送信先 begin Threadsub(WParam, PThreadParams(LParam)); // 表示ルーチンの呼び出し ポインターに戻す PThreadParams(LParam) end; ・・・・・・・・・ ・・・・・・・・・ // スレッド終了処理 procedure TForm1.WindowsProcd1(var Msg: Tmessage); // PostMessage送信先 begin Msg do begin PThreadParams(LParam).FButton.Enabled := True; // スタートボタンイネーブルにする CloseHandle(PThreadParams(LParam).ThreadHandle); // スレッドの破棄 Dispose(PThreadParams(LParam)); // レコード TThreadParams の破棄 end; end; //============================================================================================= // スレッドの例 VCL 関係は postmessage を使用しているので // スレッドから切り離されて表示される為、ラベルが自動サイズでも表示異常は発生しません。 // 但し表示に時間が掛かるので、あまり短い間隔で表示を更新するとメッセージキューが溜まります。 //============================================================================================= procedure TimerThread(Param : PThreadParams); begin // StopF の ビットが FIdNo ビットと一致するまでまでループする。 while (StopF and Param^.FIdNo) <> Param^.FIdNo do begin PostMessage(Form1.Handle, TH_MESSAGE0, VGOING, cardinal(Param)); // 'Going'表示 メッセージ送信後直ぐに制御を戻す Param^.Fcount := 0; // カウンターの値が設定値になるまでループする。 while Param^.FTimeValue >= Param^.Fcount do begin // Countの値待ち PostMessage(Form1.Handle, TH_MESSAGE0, VCOUNTER, cardinal(Param)); // カウンターの値表示 メッセージ送信後直ぐに制御を戻す // これがないとCPU使用率が跳ね上がります 此処ではタイマー役割も兼用 Sleep(5); // 用途に応じてスリープ時間を設定する最小値は１ // VCL の実行時間より短くするとメッセージが停滞します inc(Param^.Fcount); // カウンターインクリメント end; // 終了したらビープ音 Winapi.windows.Beep(Param^.FBeep, 100); PostMessage(Form1.Handle, TH_MESSAGE0, VSTOP, cardinal(Param)); // 'Stop'表示 メッセージ送信後直ぐに制御を戻す Sleep(200); // 用途に応じてスリープ時間を設定する最小値は１ end; // スレッドの終了 PostMessage(Form1.Handle, TH_MESSAGE1, 0, cardinal(Param)); // StartBtn イネーブルに メッセージ送信後直ぐに制御を戻す EndThread(0); // スレッド終了 end; //****************** 2：の例 ********************************************************************************* ・・・・・・・・・ ・・・・・・・・・ private { Private 宣言 } procedure WindowsProcd(var Msg: Tmessage); // このプロシージャに Windows Handle を割り付ける public { Public 宣言 } end; var FHandle : HWNd; // Windows Handle メッセージ用ハンドル //============================================================================================= // 初期設定 //============================================================================================= procedure TForm1.FormCreate(Sender: TObject); begin FHandle := AllocateHWnd(WindowsProcd); // WindowsProcd Handle の 生成 end; //============================================================================================= // 終了処理 //============================================================================================= procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin DeallocateHWnd(FHandle); // WindowsProcd Handle の破棄 end; //============================================================================================= // Postmessage の処理 //============================================================================================= procedure TForm1.WindowsProcd(var Msg: Tmessage); // SendMessage又はPostMessage送信先 begin // 直接グラフィク表示ルーチンを呼び出すと正常に動作しない with Msg do case Msg of // 送られた Msg の値によりサブルーチンコール WM_APP : Threadsub(WParam, PThreadParams(LParam)); // 表示ルーチンの呼び出し ポインターに戻す PThreadParams(LParam) WM_APP + 1 : ThreadendProc(PThreadParams(LParam)); // スレッド終了処理 WM_APP + 2 : Graphsub(WParam, PThreadParams(LParam)); // グラフ表示 else Result := DefWindowProc(FHandle, Msg, WParam, LParam); // 例外の処理 end; end; //============================================================================================= // スレッドの例 VCL 関係は postmessage を使用しているので // スレッドから切り離されて表示される為、ラベルが自動サイズでも表示異常は発生しません。 // 但し表示に時間が掛かるので、あまり短い間隔で表示を更新するとメッセージキューが溜まります。 //============================================================================================= procedure TimerThread(Param : PThreadParams); begin // Param^.FStop が True になるまで ループする。 while not Param^.FStop do begin PostMessage(FHandle, WM_APP, VGOING, cardinal(Param)); // 'Going'表示 メッセージ送信後直ぐに制御を戻す Param^.Fcount := 0; // カウンターの値が設定値になるまでループする。 while Param^.FTimeValue >= Param^.Fcount do begin // Countの値待ち if StopF[Param.FIdNo] then break; // 緊急停止フラグだったらブレーク PostMessage(FHandle, WM_APP + 2, Param^.Fcount, cardinal(Param)); // グラフ表示 メッセージ送信後直ぐに制御を戻す // Param^.Fcountの値を WParam値として渡します。 // PostMessgeの送信先で呼びだされると正しくループ // しない事があるので // これがないとCPU使用率が跳ね上がります 此処ではタイマー役割も兼用 // 又、他のスレッドが正しく動作しません Sleep(FitevlTime); // 用途に応じてスリープ時間を設定する最小値は１ // VCL の実行時間より短くするとメッセージが停滞します inc(Param^.Fcount); // カウンターインクリメント end; if StopF[Param.FIdNo] then Break; // 緊急停止ならブレーク // 終了したらビープ音 Winapi.windows.Beep(Param^.FBeep, 100); PostMessage(FHandle, WM_APP, VSTOP, cardinal(Param)); // 'Stop'表示 メッセージ送信後直ぐに制御を戻す Sleep(FSllepTime); // 用途に応じてスリープ時間を設定する最小値は１ end; PostMessage(FHandle, WM_APP + 1, 0, cardinal(Param)); // StartBtn イネーブルに メッセージ送信後直ぐに制御を戻す EndThread(FEXITCOAD); // 終了コード0を指定しています end; ・・・・・・・・・ ・・・・・・・・・
ThreadTest2のプログラムリスト
ダウンロードＺｉｐファイルの内容とは若干ちがいます。
ダウンロードＺｉｐファイルには、TChart を追加して、Vclに実行時間が掛かる場合のサンプルとしてあります。
Param^.FCountの値を表示するため、PostMessage
を使用していますが、メッセージが停滞すると、その間に、Param^.FCountが更新されてしまいます。
スレッド内で値を変更している場合は、その値そのものを PostMessage のパラメーターにして送ったほうが良いでしょう。
unit Main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Label4: TLabel;
StaticText1: TStaticText;
Label2: TLabel;
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private 宣言 }
procedure WindowsProcd(var Msg: Tmessage);
Procedure WMSysCommand(var Messages: TWMSysCommand);message WM_SYSCOMMAND;
public
{ Public 宣言 }
procedure ThreadStart1;
procedure ThreadStart2;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type // スレッドレコードの定義
TThreadParams = record // スレッドに値を渡す
FThreadHandle : integer; // スレッドハンドル
FButton : TButton;
FEdit : Tedit;
FLabel : TLabel;
FTimeValue : Integer; // カウンター終了設定値
FCount : integer; // カウンター値
FIdNo : integer; // スレッド判別IDNo
FBeep : integer; // ビープ音程
FThreadID : Cardinal; // スレッドＩＤ
FStop : Boolean; // 停止フラグ
FEXCoad : Cardinal;
end;
PThreadParams = ^TThreadParams;
const
VCOUNTER = 1; // カウンターの値表示
VGOING = 2; // 'Going' 表示
VSTOP = 3; // 'Stop' 表示
FThreadN = 2; // スレッドの数
FTNM = FThreadN - 1; // for 用
FitevlTime = 5; // カウンターインターバルタイム
FSllepTime = 200; // タイマーループ停止時間
FWaitShort = 20; // 通常の終了待ち時間
FWaitTime = 200 * 10; // スレッド停止待ち時間
FEXITCOAD = 0; // スレッド終了コード
var
FHandle : HWNd; // Windows Handle スレッド用ハンドル
StopF : array[0..FTNM] of Boolean; // 緊急停止フラグ
TPPp: array[0..FTNM] of PThreadParams; // スレッドレコードの配列
//=============================================================================================
// SYSTEM Command 処理
// 測定用ソフトやメカコントロールソフトの場合 SYSTEM Command で Postmassage に処理に
// 悪影響があるものがあり、特に SC_MOVE は表示の実行をとめ表示の割り込み処理が溜まってしまいます。
// 此処では、スレッド実行時 SC_MOVE コマンドをキャンセルしています。
//=============================================================================================
Procedure TForm1.WMSysCommand(var Messages: TWMSysCommand); // フォームのborder Close ボタンのみ有効の場合
var
II : integer;
MStopF : Boolean;
begin // メカコントロールの場合、minimize Maximize は非表示に設定すること
MStopF := True;
case (Messages.CmdType and $FFF0) of
SC_SIZE : Messages.Result := 0; // サイズ変更キャンセル bsSizeableの時 bsSingleであれば不要
// SC_CLOSE: Button5Click(nil); // フォームのborder Closeボタン
SC_MOVE : begin
for II := 0 to FTNM do // 停止していないスレッドの検索
if TPPp[II] <> nil then MStopF := False;
if MStopF then inherited // 全てのスレッド停止していたらフォーム移動
else Messages.Result := 0; // フォームの移動キャンセル
end;
else
inherited; // 指定以外はデフォルト処理
end;
end;
//=============================================================================================
// VCL 関係はスレッド内で実行しないようにします スレッド内では表示と同期が取れません
// スレッド内でStringを扱うとメモリーリークが発生するので postmessage で此処で扱います
//=============================================================================================
procedure Threadsub(FMode: integer; Param: PThreadParams); // スレッド内のカウンターの値表示
var
SCoadEXE : string;
begin
// Stringの表示
case FMode of
VCOUNTER: begin
Param^.FEdit.Text := inttostr(Param^.FCount); // スレッド内でStringを扱うとメモリーリークが発生するため
Param^.FEdit.Update; // サブルーチンにする
end;
VGOING: begin
Param^.FLabel.Caption := 'Going';
Param^.FLabel.Update;
end;
VSTOP: begin
Param^.FLabel.Caption := 'Stop';
Param^.FLabel.Update;
end;
end;
// スレッドの状態取得
GetExitCodeThread(Param^.FThreadHandle, Param^.FEXCoad); // 終了コードの取得
if Param^.FEXCoad = STILL_ACTIVE then SCoadEXE := 'STILL_ACTIVE'
else SCoadEXE := intTostr(Param^.FEXCoad);
// 終了コード参考表示 STILL_ACTIVE 実行が表示されます。
if Param^.FIdNo = 0 then
Form1.StaticText1.Caption := 'ExitNO1 ' + SCoadEXE;
if Param^.FIdNo = 1 then
Form1.Label4.Caption := 'ExitNO2 ' + SCoadEXE;
end;
//=============================================================================================
// スレッドの終了処理
// スレッドの終了を待ちスレッドハンドルを解放します
// スレッドの終了コード取得と表示は参考です。
//=============================================================================================
procedure ThreadendProc(Param: PThreadParams);
var
FEndstr : string;
delMenu : HMenu;
begin
WaitForSingleObject(Param^.FThreadHandle, FWaitShort); // スレッドの終了待ち
// MsgWaitForMultipleObjects(1, &Param^.FThreadHandle, True, FWaitShort, QS_ALLINPUT );
GetExitCodeThread(Param^.FThreadHandle, Param^.FEXCoad); // 終了コードの取得
CloseHandle(Param^.FThreadHandle); // スレッドハンドルの破棄 スレッドはEndThreadで解放されます
Param^.FButton.Enabled := True; // スタートボタンイネーブルにする
case Param^.FEXCoad of
FEXITCOAD : FEndstr := ' 終了';
STILL_ACTIVE : FEndstr := ' 実行中';
1 : FEndstr := ' 終了コマンドが無い';
else FEndstr := ' エラー';
end;
if Param^.FIdNo = 0 then // 終了コード参考表示
Form1.StaticText1.Caption := 'ExitNO1 ' + intTostr(Param^.FEXCoad) + FEndstr;
if Param^.FIdNo = 1 then // 終了コード参考表示
Form1.Label4.Caption := 'ExitNO2 ' + intTostr(Param^.FEXCoad) + FEndstr;
TPPp[Param^.FIdNo] := nil; // 配列ポインタ初期化
Dispose(Param); // レコード TThreadParams の破棄
if Form1.Button1.Enabled and Form1.Button2.Enabled then begin
Form1.Button5.Enabled := True; // Close ボタンイネーブル
Form1.Button6.Enabled := False; // 緊急停止ボタンディスエブル
EnaMenu := GetSystemMenu(Form1.Handle, False);
EnableMenuItem(
EnaMenu, // メニューのハンドル
SC_CLOSE, // 更新対象のメニュー項目
MF_ENABLED // オプション
);
DrawMenuBar (Form1.Handle);
end;
end;
//=============================================================================================
// スレッドの例 VCL 関係は postmessage を使用しているので
// スレッドから切り離されて表示される為、ラベルが自動サイズでも表示異常は発生しません。
// 但し表示に時間が掛かるので、あまり短い間隔で表示を更新するとメッセージキューが溜まります。
//=============================================================================================
procedure TimerThread(Param : PThreadParams);
begin
// Param^.FStop が True になるまで ループする。
while not Param^.FStop do begin
PostMessage(FHandle, WM_APP, VGOING, cardinal(Param)); // 'Going'表示 メッセージ送信後直ぐに制御を戻す
Param^.Fcount := 0;
// カウンターの値が設定値になるまでループする。
while Param^.FTimeValue >= Param^.Fcount do begin // Countの値待ち
if StopF[Param.FIdNo] then break; // 緊急停止フラグだったらブレーク
PostMessage(FHandle, WM_APP, VCOUNTER, cardinal(Param)); // カウンターの値表示 メッセージ送信後直ぐに制御を戻す
// これがないとCPU使用率が跳ね上がります 此処ではタイマー役割も兼用
// 又、他のスレッドが正しく動作しません
Sleep(FitevlTime); // 用途に応じてスリープ時間を設定する最小値は１
// VCL の実行時間より短くするとメッセージが停滞します
inc(Param^.Fcount); // カウンターインクリメント
end;
if StopF[Param.FIdNo] then Break; // 緊急停止ならブレーク
// 終了したらビープ音
Winapi.windows.Beep(Param^.FBeep, 100);
PostMessage(FHandle, WM_APP, VSTOP, cardinal(Param)); // 'Stop'表示 メッセージ送信後直ぐに制御を戻す
Sleep(FSllepTime); // 用途に応じてスリープ時間を設定する最小値は１
// Sleep(10000); // 緊急停止テスト用
end;
// Sleep(10000); // 緊急停止テスト用
PostMessage(FHandle, WM_APP + 1, 0, cardinal(Param)); // StartBtn イネーブルに メッセージ送信後直ぐに制御を戻す
EndThread(FEXITCOAD); // 終了コード0を指定します
end;
//=============================================================================================
// Postmessage の処理
//=============================================================================================
procedure TForm1.WindowsProcd(var Msg: Tmessage); // SendMessage又はPostMessage送信先
begin // 直接グラフィク表示ルーチンを呼び出すと正常に動作しない
with Msg do
case Msg of // 送られた Msg の値によりサブルーチンコール
WM_APP : Threadsub(WParam, PThreadParams(LParam)); // 表示ルーチンの呼び出し ポインターに戻す PThreadParams(LParam)
WM_APP + 1 : ThreadendProc(PThreadParams(LParam)); // スレッド終了処理
else
Result := DefWindowProc(FHandle, Msg, WParam, LParam); // 例外の処理
end;
end;
//=============================================================================================
// 終了処理
//=============================================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeallocateHWnd(FHandle); // WindowsProcd Handle の破棄
end;
//=============================================================================================
// 初期設定
//=============================================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Top := (Screen.Height - Height) div 2;
Left := (Screen.Width - Width) div 2;
Button3.Enabled := False;
Button4.Enabled := False;
Button6.Enabled := False;
FHandle := AllocateHWnd(WindowsProcd); // WindowsProcd Handle の 生成
end;
//=============================================================================================
// スレッド１の起動
//=============================================================================================
procedure TForm1.ThreadStart1;
var
delMenu : HMenu;
begin
Button1.Enabled := False;
New(TPPp[0]); // レコードポインタの生成 レコードの生成
TPPp[0].FButton := Button1; // Button1 のポインター
TPPp[0].FEdit := Edit1; // Edit1のポインター
TPPp[0].FLabel := Label1; // Label1のポインター
TPPp[0].FTimeValue := 120; // カウンターの設定値
TPPp[0].FIdNo := 0; // スレッド番号
TPPp[0].FBeep := 800; // ビープ音音程
TPPp[0].FStop := False; // 通常停止フラグリセット
TPPp[0].FEXCoad := FEXITCOAD; // 終了コード初期化
StopF[0] := False; // 緊急停止フラグリセット
Statictext1.Caption := 'ExitNO1 ' + intTostr(TPPp[0].FEXCoad);
TPPp[0].FThreadHandle := BeginThread(nil, 0, Addr(TimerThread), TPPp[0], 0, TPPp[0].FThreadID); // スレッドの起動
if TPPp[0].FThreadHandle = 0 then
begin
Dispose(TPPp[0]); // レコード TThreadParams の破棄
application.MessageBox('スレッド１の生成に失敗しました','注意',0);
Button1.Enabled := True;
TPPp[0] := nil;
exit;
end;
delMenu := GetSystemMenu(Handle, False); // メニューハンドルの取得
EnableMenuItem(delMenu, SC_CLOSE, MF_GRAYED); // クローズボタンのグレイアウト
DrawMenuBar (Handle);
Button3.Enabled := True; // 停止ボタンイネーブル
Button5.Enabled := false; // close ボタンディスエブル
Button6.Enabled := True;
end;
//=============================================================================================
// スレッド２の起動
//=============================================================================================
procedure TForm1.ThreadStart2;
var
delMenu : HMenu;
begin
Button2.Enabled := False;
New(TPPp[1]); // レコードポインタの生成
TPPp[1].FButton := Button2; // Button2 のポインター
TPPp[1].FEdit := Edit2; // Edit2のポインター
TPPp[1].FLabel := Label2; // Label2のポインター
TPPp[1].FTimeValue := 75; // カウンターの設定値
TPPp[1].FIdNo := 1; // スレッド番号
TPPp[1].FBeep := 700; // ビープ音音程
TPPp[1].FStop := False; // 通常停止フラグリセット
TPPp[1].FEXCoad := FEXITCOAD; // 終了コード初期化
Label4.Caption := 'ExitNO2 ' + intTostr(TPPp[1].FEXCoad);
StopF[1] := False; // 緊急停止フラグリセット
TPPp[1].FThreadHandle := BeginThread(nil, 0, Addr(TimerThread), TPPp[1], 0, TPPp[1].FThreadID); // スレッドの起動
if TPPp[1].FThreadHandle = 0 then
begin
Dispose(TPPp[1]); // レコード TThreadParams の破棄
application.MessageBox('スレッド２の生成に失敗しました','注意',0);
Button2.Enabled := True;
TPPp[1] := nil;
exit;
end;
delMenu := GetSystemMenu(Handle, False); // メニューハンドルの取得
EnableMenuItem(delMenu, SC_CLOSE, MF_GRAYED); // クローズボタンのグレイアウト
DrawMenuBar (Handle);
Button4.Enabled := True; // 停止ボタンイネーブル
Button5.Enabled := False; // close ボタンディスエブル
Button6.Enabled := True;
end;
//=============================================================================================
// 起動停止 ボタン関係
//=============================================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
ThreadStart1;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ThreadStart2;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
TPPp[0].FStop := True; // 停止フラグ
Button3.Enabled := False;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
TPPp[1].FStop := True; // 停止フラグ
Button4.Enabled := False;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if Button1.Enabled and Button2.Enabled then close; // 終了
end;
//=============================================================================================
// スレッド緊急停止
// 最初は停止フラグにより停止を試みて、時間までに停止しなかったら
// 強制的にスレッドを停止します。
//=============================================================================================
procedure TForm1.Button6Click(Sender: TObject); // スレッドの無条件停止 危険
var
II : integer;
ExitCoad : DWORD;
TPPpHWD : HWND;
FEXit : DWORD;
StopErr : integer;
begin
StopErr := 0;
ExitCoad := 0;
for II := 0 to FTNM do begin
if (TPPp[II] <> nil) then begin
StopF[II] := True; // 緊急停止フラグセット
TPPp[II].FStop := True; // スレッドの通常停止フラグをセット
TPPpHWD := TPPp[II].FThreadHandle;
FEXit := WaitForSingleObject(TPPpHWD, FWaitTime); // スレッドの停止を待つ
if FEXit <> 0 then begin // スレッドが停止しなかったら
// スレッドを強制停止させると、メモリーリーク データーの異常値等 何が起こるかわかりません
// 強制停止が発生したらプログラムを終了させましょう。
if GetExitCodeThread(TPPpHWD, ExitCoad) then // スレッドのハンドル 終了コード取得
if ExitCoad = STILL_ACTIVE then
Terminatethread(TPPpHWD, 0); // スレッドの強制停止
Closehandle(TPPpHWD); // スレッドハンドルの解放
Dispose(TPPp[II]); // レコード TThreadParams の破棄
TPPp[II] := nil; // レコードポインタの初期化
StopErr := StopErr + II + 1; // エラーフラグセット
end;
case II of
0: begin
Button1.Enabled := True; // スタートボタンイネーブル
Button3.Enabled := False; // 停止ボタンデスエブル
end;
1: begin
Button2.Enabled := True; // スタートボタンイネーブル
Button4.Enabled := False; // 停止ボタンデスエブル
end;
end;
end;
end;
Button5.Enabled := True;
Button6.Enabled := False;
if StopErr <> 0 then
Application.MessageBox('スレッド異常停止しました プログラムを終了して下さい。' ,'注意',0);
end;
end.
前記 プログラムでは、プロシージャにハンドルを割り付けていますが、Form1のハンドルへメッセージを送って処理をする場合は、まず WndProc をオーバライズします。
private
****** *******
protected
procedure WndProc(var Msg: TMessage); override;
public
****** *******
end;
ウィンドウプロシージャを新しく書き直します。
procedure TForm1.WndProc(var
Msg: TMessage);
begin
case
Msg.Msg of
WM_APP
: Threadsub(Msg.WParam, PThreadParams(Msg.LParam));
// 表示ルーチンの呼び出し ポインターに戻す PThreadParams(LParam)
WM_APP + 1 : ThreadendProc(PThreadParams(Msg.LParam));
else
inherited WndProc(Msg); //
違ったらデフォルト処理
end;
end;
オーバライズを使用しない場合は
const
TH_MESSAGE0
= WM_APP ;
TH_MESSAGE1 = WM_APP + 1;
private
{ Private
宣言 }
procedure WindowsProcd0(var
Msg: Tmessage); message TH_MESSAGE0;
// メッセージ WM_APP
処理
procedure WindowsProcd1(var
Msg: Tmessage); message TH_MESSAGE1;
// メッセージ WM_APP + 1 処理
public
****** *******
end;
procedure TForm1.WindowsProcd0(var Msg:
Tmessage);
begin
---
---
end;
procedure TForm1.WindowsProcd1(var Msg:
Tmessage);
begin
---
---
end;
この様にすることで、Form1のハンドルにメッセージを送ることで処理が出来ますが、プログラムミスの防止、動作の安定性を考慮すると、新しくプロシージャにハンドルを割り付けて処理をしたほうが良いと思います。
ThreadTest6
同じオブジェクトにアクセスする場合は、MonitorEnter MonitorExit を使用して衝突をさけます。
MonitorEnterは、オブジェクトを、たのスレッドが使用している場合、開放されるのを待ちますが、設定された待ち時間を過ぎても開放されない場合、False
を返すので、開放されるまで、長い時間待つことを避けることが出来まし、オブジェクトを実行したかどうかの確認にもなります。
次はその使用例です。
unit Main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.SyncObjs; type // スレッドレコードの定義 TThreadParams = record // スレッドに値を渡す FEdit : Tedit; FLabel : TLabel; FTimeValue : Integer; Fidno : Integer; FStopF : boolean; FButton : TButton; FStopBtn : TButton; end; PThreadParams = ^TThreadParams; type TForm1 = class(TForm) StartBtn1: TButton; StopBtn1: TButton; StartBtn2: TButton; StopBtn2: TButton; Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Edit3: TEdit; procedure StartBtn1Click(Sender: TObject); procedure StopBtn1Click(Sender: TObject); procedure StartBtn2Click(Sender: TObject); procedure StopBtn2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private 宣言 } Procedure WMSysCommand(var Messages: TWMSysCommand);message WM_SYSCOMMAND; procedure EditOut(ID, NO: integer); public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} var Pinfo1 : PThreadParams; Pinfo2 : PThreadParams; CS : TCriticalSection; // 多重実行防止 実行の衝突を防ぐ EDCount : integer; Edit3Str : String; //============================================================================================= // SYSTEM Command 処理 // 測定用ソフトやメカコントロールソフトの場合 SYSTEM Command メッセージ(Postmessage)処理があると // 悪影響があるものがあり、特に SC_MOVE は表示の実行をとめ表示の割り込み処理が溜まってしまいます。 // ここの例ではメッセージ(Postmessage)処理を使用していないので、滞ることはありません //============================================================================================= Procedure TForm1.WMSysCommand(var Messages: TWMSysCommand); // フォームのborder Close ボタンのみ有効の場合 begin // メカコントロール用の場合は、minimize Maximize は非表示に設定すること case (messages.CmdType and $FFF0) of SC_SIZE : Messages.Result := 0; // サイズ変更キャンセル bsSizeableの時 bsSingleであれば不要 SC_CLOSE: if StartBtn1.Enabled and StartBtn2.Enabled then inherited else Messages.Result := 0; // SC_MOVE : if StartBtn1.Enabled and StartBtn2.Enabled // then inherited // スレッド停止していたらフォーム移動 // else Messages.Result := 0; // フォームの移動キャンセル else inherited; // 指定以外はデフォルト処理 end; end; //================================================================================================== // スレッド // MonitorEnter MonitorExit の使用例です。 // MonitorEnter MonitorExit が 無いと Edit3 の 文字表示に たまに二つ繋がった値が表示されます // ここでの Edit3 の表示は、 0,1,2,3...99,100 とならず 2,4,5,.98,100 の様に値が跳ぶことがあります。 // 値を連続での表示は、 EditOut の Edit3 表示となります。 //================================================================================================== procedure ThreadProc(Param : PThreadParams); // スレッドの例; var FCount : integer; begin FCount := 0; Param.FStopBtn.Enabled := True; while not Param.FStopF do begin Param.FLabel.Caption := 'Going'; Param.FLabel.Update; while Param.FTimeValue >= Fcount do begin Form1.EditOut(Param.Fidno, Fcount); if MonitorEnter(Form1.Edit3, 500) then // Edit3 オブジェクト多重アクセス禁止設定 500 は Wait time try Form1.Edit3.SelectAll; Form1.Edit3.SetSelText(Edit3Str); // Form1.Edit3.text := Edit3Str は ＮＧ // Form1.Edit3.SetSelTextBuf(Pchar(Edit3Str)); Form1.Edit3.Update; finally MonitorExit(Form1.Edit3); // Edit3 オブジェクト多重アクセス禁止解除 end; // SendMessage(Form1.Edit3.Handle, WM_SETTEXT, 0, integer(Pchar(Edit3Str))); // Edit3に表示書き換えメッセージを送る Sleep(10); // Sleep(*) 他のスレッドを動作させるため必ず必要です Inc(Fcount); end; Param.FLabel.Caption := 'Stop'; Param.FLabel.Update; // 終了したらビープ音 case Param^.Fidno of 1: Winapi.windows.Beep( 800, 70); 2: Winapi.windows.Beep(1000, 70); end; sleep(100); FCount := 0; end; Param.FButton.Enabled := True; Param.FStopBtn.Enabled := False; Dispose(Param); // スレッドレコードの破棄 New で確保したメモリーの破棄 EndThread(0); // スレッド終了 無くても自動的に終了 スレッドは破棄されます end; //============================================================================================= // スレッド内で String を変更、String を扱うサブルーチンを使用出来ないのでここで実行します。 //============================================================================================= procedure TForm1.EditOut(ID, NO: integer); begin case ID of 1: begin Edit1.Text := intTostr(NO); Edit1.Update; end; 2: begin Edit2.Text := intTostr(NO); Edit2.Update; end; end; CS.Enter; // 多重アクセス禁止 Edit3の表示をしなければ無くてもＯＫ try if EDCount > 100 then begin if EDCount > 150 then EDCount := -1 end else begin Edit3Str := inTtostr(EDCount); // Edit3.SelectAll; // Edit3.SetSelText(Edit3Str); // Edit3.Update; end; inc(EDCount); finally CS.Leave; // 多重アクセス禁止処理終了 end; end; //============================================================================================= // スレッドのスタート。 //============================================================================================= procedure TForm1.StartBtn1Click(Sender: TObject); var id : Cardinal; begin StartBtn1.Enabled := False; New(Pinfo1); // 新しい動的変数を作成し，Pinfo をその変数のポインタに設定します。 Pinfo1.FEdit := Edit1; Pinfo1.FLabel := Label1; Pinfo1.FTimeValue := 100; pinfo1.Fidno := 1; pinfo1.FStopF := False; pinfo1.FButton := StartBtn1; pinfo1.FStopBtn := StopBtn1; CloseHandle(BeginThread(nil, 0, @ThreadProc, Pinfo1, 0, id)); // スレッドの生成 end; procedure TForm1.StartBtn2Click(Sender: TObject); var id : Cardinal; begin StartBtn2.Enabled := False; New(Pinfo2); // 新しい動的変数を作成し，Pinfo をその変数のポインタに設定します。 Pinfo2.FEdit := Edit2; Pinfo2.FLabel := Label2; Pinfo2.FTimeValue := 110; pinfo2.Fidno := 2; pinfo2.FStopF := False; pinfo2.FButton := StartBtn2; pinfo2.FStopBtn := StopBtn2; CloseHandle(BeginThread(nil, 0, @ThreadProc, Pinfo2, 0, id)); // スレッドの生成 end; //============================================================================================= // スレッドの停止 //============================================================================================= procedure TForm1.StopBtn1Click(Sender: TObject); begin Pinfo1.FStopF := True; Pinfo1 := nil; // Pinfo1の初期化 メモリーの解放はスレッドで行われます。 end; procedure TForm1.StopBtn2Click(Sender: TObject); begin Pinfo2.FStopF := True; Pinfo2 := nil; // Pinfo2の初期化 メモリーの解放はスレッドで行われます。 end; //============================================================================================= // 初期設定 //============================================================================================= procedure TForm1.FormCreate(Sender: TObject); begin Top := 200; Left := (Screen.Width - Width) div 2; Label1.AutoSize := False; Label1.Width := 100; Label1.Caption := 'Stop'; Label2.AutoSize := False; Label2.Width := 100; Label2.Caption := 'Stop'; Edit1.Text := '0'; Edit2.Text := '0'; Edit3.Text := '0'; CS := TCriticalSection.Create; // スレッド多重実行防止生成 end; //============================================================================================= // 終了処理 //============================================================================================= procedure TForm1.FormDestroy(Sender: TObject); begin CS.Free; // スレッド多重実行防止解放 end; end.
スレッドの終了の待ち合わせ
何らかの理由により、スレッドの終了を待ち合わせる必要がある場合、
While True do
application.ProcessMessagesを使用して、待ち合わせるのは、あまり良い方法ではありません。
WaitForsingleobject(Handle,
INFINITE); を使用して、スレッドで他のスレッドの終了を待ち合わせる方法が良いのでプログラムを作成してみました。
これは、ダウンロードZIPファイルの中には入っていません。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
SpinEdit1: TSpinEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
flgStop : Boolean;
Thread1 : Integer;
//-------------------------------------------------------
// スレッドレコードの定義
// スレッドに値を渡す
//-------------------------------------------------------
type
TThreadParams = record
FButton : TButton;
FPanel : TPanel;
FTimeValue : Cardinal;
FEndCoad : Cardinal;
end;
PThreadParams = ^TThreadParams;
//--------------------------------------------------------
// タイマーの値表示
// UnicodeStringを使用するのでメインスレッドで表示します
// スレッド内で使用するとメモリーリークが発生します
//--------------------------------------------------------
procedure PanelCaption(FTimeDis: Cardinal; Fpanel : Tpanel);
var
Amin, Asec : Integer;
begin
// 分と秒の値
Amin := Trunc(FTimeDis / 60);
Asec := Trunc(FTimeDis) - Amin * 60;
// 表示更新
FPanel.Caption := Format('残%4d分%2d秒', [Amin, Asec]);
FPanel.Update;
end;
//--------------------------------------------------------
// スレッドの実行部分
//--------------------------------------------------------
procedure TimerThread(Param : PThreadParams);
var
FTimeStart : Cardinal;
FTimeDis : Cardinal;
begin
Param^.FButton.Enabled := False;
FTimeStart := GetTickCount;
while True do begin
// 残り時間を秒に換算
FTimeDis := Param^.FTimeValue - (GetTickCount - FTimeStart) div 1000;
// 表示更新
PanelCaption(FTimeDis, Param^.FPanel);
if flgStop then begin
Param^.FEndCoad := 10;
break;
end;
if FTimeDis <= 0 then break;
// これがないとCPU使用率が跳ね上がります
Sleep(10);
end;
Param^.FButton.Enabled := True;
// メモリーの開放
Dispose(Param);
// 終了したらビープ音
Winapi.windows.Beep(800, 1200);
// スレッド終了
EndThread(Param^.FEndCoad);
end;
//--------------------------------------------------------
// スレッド１の終了コード表示
//--------------------------------------------------------
procedure endcodedisp(FEXCoad : Cardinal);
begin
Form1.Panel1.Caption := '終了コード = ' + IntTostr(FEXCoad);
end;
//-------------------------------------------------------------------------------------------
// スレッド１の終了待ちスレッドです。
// 表示関係がメインスレッドにあるので、メインスレッドでは、スレッド１の待ち合わせは出来ません。
// メインスレッドで待ち合わせをすると表示が停止しします。(メインスレッドが停止します)。
// スレッド１が終了するまで、このスレッドが停止します。
//-------------------------------------------------------------------------------------------
procedure WaitThread(TH: pointer);
var
FEXCoad : Cardinal;
begin
WaitForSingleObject(integer(TH^), INFINITE); // スレッド１の終了待ち
GetExitCodeThread(integer(TH^), FEXCoad); // スレッド１の終了コードの取得
endcodedisp(FEXCoad); // 終了コードの表示
CloseHandle(integer(TH^)); // スレッド１のハンドルの解放
EndThread(0); // スレッド終了
end;
//=============================================================================
// スレッドを作成して実行
// タイマーの起動や時間経過の監視はスレッドで行います
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
Thread2 : Integer;
pInfo : PThreadParams;
id1,id2 : Cardinal;
begin
flgStop := False;
// メモリを確保し，スレッドに渡す値をセットしてスレッド開始
New(pInfo);
pInfo^.FButton := Button1;
pInfo^.FPanel := Panel1;
pInfo^.FTimeValue := SpinEdit1.Value;
pInfo^.FEndCoad := 11;
// スレッド１の開始
Thread1 := BeginThread(nil, 0, Addr(TimerThread), pInfo, 0, Id1);
// スレッド１の終了を待つスレッド２の起動
if Thread1 <> 0 then begin
Thread2 := BeginThread(nil, 0, addr(WaitThread), addr(Thread1), 0, Id2);
// スレッド２ハンドルクローズ クローズしてもスレッドは終了しません
CloseHandle(Thread2);
end;
end;
//=============================================================================
// タイマーストップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
flgStop := True;
end;
end.
まとめ
TThreadクラスのスレッド
１．表示(VCL)を使用する場合はメインスレッドと同期を取るため、Synchronize を使用します。
２．表示の必要が無い場合、共通のサブルーチンコール、メモリーアクセスは、TCriticalSection を使用して衝突をさけます。
３．メカコントロールの場合フォームの移動開始時、Synchronize 処理の一瞬の停滞を防ぐため、スレッド実行時、移動処理をしないようにします。
４．スレッドを停止しないで、プログラムを終了すると、メモリーリークが発生するので、メニューのクローズボタンは、グレーアウトするか、表示しないようにします。
５．同じオブジェクトにアクセスする場合は、MonitorEnter MonitorExit を使用して衝突をさけます。
BeginThread
１．表示(VCL)を使用する場合はメインスレッドと同期を取るため、PostMessage Sendmessageを使用します。
２．表示の必要が無い場合、共通のサブルーチンコール、メモリーアクセスは、TCriticalSection を使用して衝突をさけます。
３．メカコントロールの場合フォームの移動開始時、、PostMessage 処理の一瞬の停滞を防ぐため、スレッド実行時、移動処理をしないようにします。
４．スレッドを停止しないで、プログラムを終了すると、メモリーリークが発生するので、メニューのクローズボタンは、グレーアウトするか、表示しないようにします。
５．同じオブジェクトにアクセスする場合は、MonitorEnter MonitorExit を使用して衝突をさけます。
Threadsample.zip