关于进度条和线程的问题?
本人写了一个关于公用进度条的程序,进度条处理的时候出现了一个很棘手的问题,即外部运行事件中有关于VCL控件操作的代码,线程中如果用Synchronize(外部事件)有时后会出现进度条窗口无法关闭的问题,请各位帮我看看,该怎么觉得这个问题,谢谢!
程序先列一下;
unit f_SimpleProgress;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, Gauges;
type
//过程类型定义
TProgressRunEvent = procedure (lpzVar: Pointer; var sMsg: string;
var iPos: Integer) of object;
TProgressRunEventThread = class;
TProgressDisPlayThread = class;
//主控窗口
Tfrm_SimpleProgress = class(TForm)
pnlCaption: TPanel;
lbBusinessName: TLabel;
lblMsg: TLabel;
GaugeMain: TGauge;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FRunThread: TProgressRunEventThread;
FDisplayThread: TProgressDisPlayThread;
procedure OnThreadTerminate(Sender: TObject);
public
{ Public declarations }
FsMsg: string;
FiPos: Integer;
FVar: Pointer;
FbTerminate: Boolean;
constructor Create(AVar: Pointer; RunEvent: TProgressRunEvent;
iMaxProgress: Integer; sCaption, sSubCaption: string; bHaveVCL: Boolean);
end;
//外部过程运行线程
TProgressRunEventThread = class(TThread)
private
FProgressForm: Tfrm_SimpleProgress;
FRunEvent: TProgressRunEvent;
FbHaveVCL: Boolean;
procedure RunHaveVCL;
protected
procedure Execute;override;
public
constructor Create(Sender: Tfrm_SimpleProgress; RunEvent: TProgressRunEvent;
bHaveVCL: Boolean);
end;
//进度信息显示线程
TProgressDisPlayThread = class(TThread)
private
FProgressForm: Tfrm_SimpleProgress;
procedure Display;
protected
procedure Execute;override;
public
constructor Create(Sender: Tfrm_SimpleProgress);
end;
var
frm_SimpleProgress: Tfrm_SimpleProgress;
procedure DoProgress(AVar: Pointer; RunEvent: TProgressRunEvent;
iMaxPos: Integer; sCaption, sSunCaption: string; bHaveVCL: Boolean = False);
implementation
uses f_GlobalSet;
procedure DoProgress(AVar: Pointer; RunEvent: TProgressRunEvent;
iMaxPos: Integer; sCaption, sSunCaption: string; bHaveVCL: Boolean = False);
begin
with Tfrm_SimpleProgress.Create(AVar, RunEvent, iMaxPos,
sCaption, sSunCaption, bHaveVCL) do
try
ShowModal;
finally
Free;
end;
end;
{$R *.dfm}
{ TProgressRunEventThread }
constructor TProgressRunEventThread.Create(Sender: Tfrm_SimpleProgress;
RunEvent: TProgressRunEvent; bHaveVCL: Boolean);
begin
FProgressForm := Sender;
FRunEvent := RunEvent;
FbHaveVCL := bHaveVCL;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TProgressRunEventThread.Execute;
begin
inherited;
//if not FbHaveVCL then RunHaveVCL
//else Synchronize(RunHaveVCL);
RunHaveVCL;
end;
procedure TProgressRunEventThread.RunHaveVCL;
begin
FRunEvent(FProgressForm.FVar, FProgressForm.FsMsg, FProgressForm.FiPos);
end;
{ TProgressDisPlayThread }
constructor TProgressDisPlayThread.Create(Sender: Tfrm_SimpleProgress);
begin
FProgressForm := Sender;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TProgressDisPlayThread.Display;
begin
if not FProgressForm.FbTerminate then
begin
FProgressForm.lblMsg.Caption := FProgressForm.FsMsg;
FProgressForm.GaugeMain.Progress := FProgressForm.FiPos;
Application.ProcessMessages;
//FProgressForm.Refresh;
end;
end;
procedure TProgressDisPlayThread.Execute;
begin
inherited;
while not FProgressForm.FbTerminate do Synchronize(Display);
end;
{ Tfrm_SimpleProgress }
constructor Tfrm_SimpleProgress.Create(AVar: Pointer;
RunEvent: TProgressRunEvent; iMaxProgress: Integer; sCaption,
sSubCaption: string; bHaveVCL: Boolean);
begin
inherited Create(nil);
Caption := sCaption;
lbBusinessName.Caption := sSubCaption;
Application.ProcessMessages;
//FVar := AVar;
//CopyMemory(FVar, AVar, size(AVar));
FVar := AVar;
GaugeMain.MaxValue := iMaxProgress;
FbTerminate := False;
FRunThread := TProgressRunEventThread.Create(Self, RunEvent, bHaveVCL);
FRunThread.OnTerminate := OnThreadTerminate;
FDisplayThread := TProgressDisPlayThread.Create(Self);
end;
procedure Tfrm_SimpleProgress.OnThreadTerminate(Sender: TObject);
begin
FbTerminate := True;
ModalResult := mrOk;
end;
procedure Tfrm_SimpleProgress.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if not FbTerminate then
begin
if not FRunThread.Suspended then
FRunThread.Suspend;
if not FDisplayThread.Suspended then
FRunThread.Suspend;
FbTerminate := True;
end;
end;
procedure Tfrm_SimpleProgress.FormCreate(Sender: TObject);
begin
if gclFrameBackColor <> clBlack then
Color := gclFrameBackColor;
if gclTopBarColor <> clBlack then
begin
GaugeMain.ForeColor := gclTopBarColor;
end;
if gclTopBarColor <> clBlack then
pnlCaption.Color := gclTopBarColor;
FbTerminate := False;
lblMsg.Caption := '';
end;
end.
程序先列一下;
unit f_SimpleProgress;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, Gauges;
type
//过程类型定义
TProgressRunEvent = procedure (lpzVar: Pointer; var sMsg: string;
var iPos: Integer) of object;
TProgressRunEventThread = class;
TProgressDisPlayThread = class;
//主控窗口
Tfrm_SimpleProgress = class(TForm)
pnlCaption: TPanel;
lbBusinessName: TLabel;
lblMsg: TLabel;
GaugeMain: TGauge;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FRunThread: TProgressRunEventThread;
FDisplayThread: TProgressDisPlayThread;
procedure OnThreadTerminate(Sender: TObject);
public
{ Public declarations }
FsMsg: string;
FiPos: Integer;
FVar: Pointer;
FbTerminate: Boolean;
constructor Create(AVar: Pointer; RunEvent: TProgressRunEvent;
iMaxProgress: Integer; sCaption, sSubCaption: string; bHaveVCL: Boolean);
end;
//外部过程运行线程
TProgressRunEventThread = class(TThread)
private
FProgressForm: Tfrm_SimpleProgress;
FRunEvent: TProgressRunEvent;
FbHaveVCL: Boolean;
procedure RunHaveVCL;
protected
procedure Execute;override;
public
constructor Create(Sender: Tfrm_SimpleProgress; RunEvent: TProgressRunEvent;
bHaveVCL: Boolean);
end;
//进度信息显示线程
TProgressDisPlayThread = class(TThread)
private
FProgressForm: Tfrm_SimpleProgress;
procedure Display;
protected
procedure Execute;override;
public
constructor Create(Sender: Tfrm_SimpleProgress);
end;
var
frm_SimpleProgress: Tfrm_SimpleProgress;
procedure DoProgress(AVar: Pointer; RunEvent: TProgressRunEvent;
iMaxPos: Integer; sCaption, sSunCaption: string; bHaveVCL: Boolean = False);
implementation
uses f_GlobalSet;
procedure DoProgress(AVar: Pointer; RunEvent: TProgressRunEvent;
iMaxPos: Integer; sCaption, sSunCaption: string; bHaveVCL: Boolean = False);
begin
with Tfrm_SimpleProgress.Create(AVar, RunEvent, iMaxPos,
sCaption, sSunCaption, bHaveVCL) do
try
ShowModal;
finally
Free;
end;
end;
{$R *.dfm}
{ TProgressRunEventThread }
constructor TProgressRunEventThread.Create(Sender: Tfrm_SimpleProgress;
RunEvent: TProgressRunEvent; bHaveVCL: Boolean);
begin
FProgressForm := Sender;
FRunEvent := RunEvent;
FbHaveVCL := bHaveVCL;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TProgressRunEventThread.Execute;
begin
inherited;
//if not FbHaveVCL then RunHaveVCL
//else Synchronize(RunHaveVCL);
RunHaveVCL;
end;
procedure TProgressRunEventThread.RunHaveVCL;
begin
FRunEvent(FProgressForm.FVar, FProgressForm.FsMsg, FProgressForm.FiPos);
end;
{ TProgressDisPlayThread }
constructor TProgressDisPlayThread.Create(Sender: Tfrm_SimpleProgress);
begin
FProgressForm := Sender;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TProgressDisPlayThread.Display;
begin
if not FProgressForm.FbTerminate then
begin
FProgressForm.lblMsg.Caption := FProgressForm.FsMsg;
FProgressForm.GaugeMain.Progress := FProgressForm.FiPos;
Application.ProcessMessages;
//FProgressForm.Refresh;
end;
end;
procedure TProgressDisPlayThread.Execute;
begin
inherited;
while not FProgressForm.FbTerminate do Synchronize(Display);
end;
{ Tfrm_SimpleProgress }
constructor Tfrm_SimpleProgress.Create(AVar: Pointer;
RunEvent: TProgressRunEvent; iMaxProgress: Integer; sCaption,
sSubCaption: string; bHaveVCL: Boolean);
begin
inherited Create(nil);
Caption := sCaption;
lbBusinessName.Caption := sSubCaption;
Application.ProcessMessages;
//FVar := AVar;
//CopyMemory(FVar, AVar, size(AVar));
FVar := AVar;
GaugeMain.MaxValue := iMaxProgress;
FbTerminate := False;
FRunThread := TProgressRunEventThread.Create(Self, RunEvent, bHaveVCL);
FRunThread.OnTerminate := OnThreadTerminate;
FDisplayThread := TProgressDisPlayThread.Create(Self);
end;
procedure Tfrm_SimpleProgress.OnThreadTerminate(Sender: TObject);
begin
FbTerminate := True;
ModalResult := mrOk;
end;
procedure Tfrm_SimpleProgress.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if not FbTerminate then
begin
if not FRunThread.Suspended then
FRunThread.Suspend;
if not FDisplayThread.Suspended then
FRunThread.Suspend;
FbTerminate := True;
end;
end;
procedure Tfrm_SimpleProgress.FormCreate(Sender: TObject);
begin
if gclFrameBackColor <> clBlack then
Color := gclFrameBackColor;
if gclTopBarColor <> clBlack then
begin
GaugeMain.ForeColor := gclTopBarColor;
end;
if gclTopBarColor <> clBlack then
pnlCaption.Color := gclTopBarColor;
FbTerminate := False;
lblMsg.Caption := '';
end;
end.
...全文
相关推荐
进度条显示导出文件进度
为了解决这个问题,我们可以使用异步编程模型,将文件导出的操作放在一个单独的线程中执行,而通过委托和事件来更新进度条。以下是实现步骤:1. 定义一个委托类型,它代表更新进度条的方法。
Qt 使用多线程QThread实现进度条
更好的做法是使用信号和槽机制,通过启动线程并在其中执行任务。实现进度条的步骤如下:1.
演示多线程计算和进度条
在IT领域,多线程和进度条是两个关键概念,特别是在优化程序性能和提供良好的用户体验方面。本项目“演示多线程计算和进度条”旨在教你如何在C#的Windows Forms应用程序中有效地实现这两个功能。
多线程进度条(真正的多线程实现)
为了保证线程安全,还需要注意同步问题。例如,当多个线程尝试同时访问和修改进度条对象时,可能需要使用互斥量(`CMutex`)或临界区(`CCriticalSection`)等同步机制来防止数据竞争。
C#实现多线程与进度条
在C#中实现多线程时,还需要考虑线程同步和互斥,以防止数据竞争问题。`Mutex`、`Semaphore`、`Monitor`等工具可以用来控制对共享资源的访问。


Windows SDK/API
