Hej
Jeg er ved at prøve at lave en rutine i en tråd.
Ret banalt set, skal der ske det, at når tråden aktiveres, skal et
vindue komme op med en progress bar, som stille og roligt bevæger sig
ud til enden, for så at starte forfra.
Dette lige indtil jeg terminerer tråden.
Jeg har pt. lave en ganske lille test appl. som består af:
1.
Min hovedform.
unit Pg1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, ComCtrls, ExtCtrls, Pg2;
type
TForm1 = class(TForm)
Button1: TButton;
Bevel1: TBevel;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
MyThread1 : TMyThread; // thread number 1
Thread1Active : boolean; // used to test if thread 1 is active
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject); // Create Thread 1
begin
if (MyThread1 = nil) or (Thread1Active = false) then // make sure
its not already running
begin
MyThread1 := TMyThread.CreateIt;
Thread1Active := true;
end
else
ShowMessage('Thread still executing');
end;
procedure TForm1.Button3Click(Sender: TObject); // Terminate Thread 1
begin
if (MyThread1 <> nil) and (Thread1Active = true) then // check to
see if it is running
begin
MyThread1.Terminate;
end
else
ShowMessage('Thread not started');
end;
procedure TForm1.FormCreate(Sender: TObject); // initialize to zero
begin
Thread1Active := false;
end;
end.
Dette er bare en form med 2 knapper.
Den ene skulle gerne starte tråden, den anden afslutte den.
2.
Tråden:
unit Pg2;
interface
uses
Classes, comctrls;
type
TMyThread = class(TThread)
private
protected
procedure Execute; override; // Main thread execution
published
constructor CreateIt;
destructor Destroy; override;
procedure ss;
end;
implementation
uses
windows, UVent2;
constructor TMyThread.CreateIt;
begin
inherited Create(true); // Create thread suspended
FreeOnTerminate := true; // Thread Free Itself when terminated
Suspended := false; // Continue the thread
frmVent2 := TfrmVent2.Create(nil);
end;
destructor TMyThread.Destroy;
begin
frmVent2.Release;
inherited destroy;
end;
procedure TMyThread.ss;
begin
frmVent2.Close;
end;
procedure TMyThread.Execute; // Main execution for thread
begin
frmVent2.ShowModal;
end;
end.
Som det ses, henviser den til en form, som har 2 paneller på og en
progressbar og en timer.
Timeren kører hvert 200 ms, og "flytter" progressbaren.
Selve koden under ser sådan ud:
unit UVent2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ComCtrls, ExtCtrls;
type
TfrmVent2 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
pBar: TProgressBar;
ti: TTimer;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure tiTimer(Sender: TObject);
procedure FormHide(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmVent2: TfrmVent2;
implementation
var
Teller : INteger;
{$R *.DFM}
procedure TfrmVent2.FormShow(Sender: TObject);
begin
Teller := 1;
pBar.Max := 500;
pBar.Min := 0;
pBar.Position := 0;
ti.Enabled := TRUE;
Panel1.Update;
Panel2.Update;
self.Update;
end;
procedure TfrmVent2.FormCreate(Sender: TObject);
begin
ti.Enabled := FALSE;
end;
procedure TfrmVent2.tiTimer(Sender: TObject);
begin
INC(Teller);
if (Teller>pBar.Max) then
Teller := 0;
pBar.Position := Teller;
self.Update;
end;
procedure TfrmVent2.FormHide(Sender: TObject);
begin
ti.Enabled := FALSE;
end;
end.
Alt i alt, kan jeg få formen til at komme frem.
Progressbaren flytter sig stille og roligt, og når den når enden,
starter den forfra.
MEN - når jeg vil terminate tråden,sker der intet.
Jeg kan så lukke programmet, og det er så det.
Jeg har prøvet at ændre frmvent2.showmodal til frmvent2.show, men så
terminere tråden med det samme med en fejl.
Jeg kan ikke rigtig finde ud af, hvor jeg gør det forkert henne.
Hvis nogen skulle lige inde med et lille eksempel på en program, som
kan vise en form via en tråd, og afslutte den igen, vil jeg da gerne se
det....
Gerne på mail..
Michael
--
This is an automatic signature of MesNews.
Site :
http://mesnews.no-ip.com
---
avast! Antivirus: Outbound message clean.
Virus Database (VPS): 0551-2, 20-12-2005
Tested on: 21-12-2005 20:44:52
avast! - copyright (c) 1988-2005 ALWIL Software.
http://www.avast.com