怎么写一个多线程程序?

Question

怎么写一个多线程程序?

Answer 1

unit Pg1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, Pg2;const
  WM_ThreadDoneMsg = WM_User + 8;type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Label1: TLabel;    Label2: TLabel;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);  private
    { Private declarations }
    MyThread1 : TMyThread; // thread number 1
    MyThread2 : TMyThread; // thread number 2
    Thread1Active : boolean; // used to test if thread 1 is active
    Thread2Active : boolean; // used to test if thread 2 is active
    procedure ThreadDone(var AMessage : TMessage); message WM_ThreadDoneMsg; // Message to be sent back from thread when its done
  public
    { Public declarations }  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject); // Create Thread 1
{ The thread will destroy iteself when it is done executing because FreeOnTerminate is set to true.
The first paramter is the priority, and the second is the progressbar to update.
}
begin
   if (MyThread1 = nil) or (Thread1Active = false) then // make sure its not already running   begin
     MyThread1 := TMyThread.CreateIt(TrackBar1.Position, ProgressBar1);
     Thread1Active := true;
   end
   else
     ShowMessage('Thread still executing');
end;procedure TForm1.Button2Click(Sender: TObject); // Create Thread 2
begin
   if (MyThread2 = nil) or (Thread2Active = false) then  // make sure its not already running
   begin
     MyThread2 := TMyThread.CreateIt(TrackBar2.Position, ProgressBar2);     Thread2Active := 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
    MyThread1.Terminate
  else
   ShowMessage('Thread not started');
end;procedure TForm1.Button4Click(Sender: TObject); // Terminate Thread 2begin
  if (MyThread2 <> nil) and (Thread2Active = true) then  // check to see if it is running
    MyThread2.Terminate
  else
    ShowMessage('Thread not started');
end;procedure TForm1.ThreadDone(var AMessage: TMessage); // keep track of when and which thread is done executing
begin
  if ((MyThread1 <> nil) and (MyThread1.ThreadID = cardinal(AMessage.WParam))) then  begin
      Thread1Active := false;
  end;
  if ((MyThread2 <> nil) and (MyThread2.ThreadID = cardinal(AMessage.WParam))) then
  begin
      Thread2Active := false;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject); // initialize to zero
begin
  Thread1Active := false;
  Thread2Active := false;
end;
procedure TForm1.TrackBar1Change(Sender: TObject); // set Thread 1 Prioritybegin
  if (MyThread1 <> nil) and (Thread1Active = true) then
     MyThread1.priority := TThreadPriority(TrackBar1.Position);
end;procedure TForm1.TrackBar2Change(Sender: TObject); // set Thread 2 Priority
begin
  if (MyThread2 <> nil) and (Thread2Active = true) then
    MyThread2.priority := TThreadPriority(TrackBar2.Position);
end;
procedure TForm1.FormDestroy(Sender: TObject); // Terminate any threads still runningbegin
   if (MyThread1 <> nil) and (Thread1Active = true) then
   begin
     MyThread1.Terminate;
     MyThread1.WaitFor;  // wait for it to terminate
   end;
   if (MyThread2 <> nil) and (Thread2Active = true) then
   begin
     MyThread2.Terminate;
     MyThread2.WaitFor;
   end;
end;end.

Answer 2

<WINDOWS核心编程> 一书仔细看看.

Answer 3

创建线程类type
    TReadThread = class( TThread )   //读线程
    protected
      procedure Execute; override;
    public
      hCommFile:          THandle;
      hCloseEvent:        THandle;
      hComm32Window:      THandle;      function SetupCommEvent( lpOverlappedCommEvent: POverlapped;
                               var lpfdwEvtMask: DWORD ): Boolean;
      function SetupReadEvent( lpOverlappedRead: POverlapped;
                               lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
                               var lpnNumberOfBytesRead: DWORD ): Boolean;
      function HandleCommEvent( lpOverlappedCommEvent: POverlapped;
                                var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ): Boolean;
      function HandleReadEvent( lpOverlappedRead: POverlapped;
                                lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
                                var lpnNumberOfBytesRead: DWORD ): Boolean;
      function HandleReadData( lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
      function ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
      function ReceiveError( EvtMask : DWORD ): BOOL;
      function ModemStateChange( ModemEvent : DWORD ) : BOOL;
      procedure PostHangupCall;
    end;    TWriteThread = class( TThread )   //写线程
    protected
      procedure Execute; override;
      function HandleWriteData( lpOverlappedWrite: POverlapped;
                                pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean;
    public
      hCommFile:          THandle;
      hCloseEvent:        THandle;
      hComm32Window:      THandle;
      pFSendDataEmpty:    ^Boolean;
      procedure PostHangupCall;
    end;
TComm = class( TComponent )
    private
      { Private declarations }
........
后面implementation部分写读线程和写线程的具体实现
其中在TComm 中是这样用到线程的，
  try
        WriteThread := TWriteThread.Create( True {suspended} );
     except
           CloseReadThread;
           WriteThread := nil;
           CloseHandle( hCloseEvent );
           CloseHandle( hCommFile );
           hCommFile := 0;
           raise ECommsError.Create( 'Unable to create write thread' )
     end;
     WriteThread.hCommFile := hCommFile;
     WriteThread.hCloseEvent := hCloseEvent;
     WriteThread.hComm32Window := FHWnd;
     WriteThread.pFSendDataEmpty := @FSendDataEmpty;     WriteThread.Priority := tpHigher;     ReadThread.Resume;
     WriteThread.Resume
其中有个函数是通过线程ID来区分是用的：
function TComm.WriteCommData( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
var
   Buffer: Pointer;
begin
     if (WriteThread <> nil) and (dwSizeofDataToWrite <> 0) then
     begin
          Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
          Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
          if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
                                WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
          begin
               FSendDataEmpty := False;
               Result := True;
               Exit
          end
     end;     Result := False
end; {TComm.WriteCommData}
注意PostThreadMessage函数参数。
刚接触，希望对你有所帮助。