圖2 3構件源程序 ......





圖　2
3　構件源程序
unit comm32;
interface
uses
　 Windows,Messages,SysUtils,Classes, Graphics, Controls, Forms, Dialogs;
const
　　 WMCOMMNOTIFY = WMUSER + 1;
Type{定義屬性用梅舉類型}
　　 TParity = ( None, Odd, Even, Mark, Space );
　　 TStopBits = (1, 15, 2 );
　　 TOncommMode = (evchar,evflag);
　　 TComPorts=( com1,com2,com3,com4);
　 ECommsError = class( Exception );
　 TOncommEvent = procedure(Sender: TObject;Buffer:Pointer;BufferLength: Word) of
object;{觸發事件對像}
　　 Type{創建監視線程類}
　 TMyCommWacth = class(TThread)
　 private
　　 PostEvent: Integer;
　　 ｛ Private declarations ｝
本文有[www.0574-laser.com]提供，請及時關注[www.0574-laser.com]提供的內容
　 protected
　　 procedure Execute; override;
　 Public
　 hCommFile: THandle;｛串口句柄｝
　 hCloseEvent: THandle; ｛事件句柄｝
　 hComm32Window:THandle;｛消息窗句柄｝
　　 Lpoverlapped:TOVERLAPPED;
　　 ConStructor Create;｛構造函數｝
　 end;
type｛創建構件對象｝
　 Tcomm32 = class(TComponent)
　 Private{定義屬性的私有變量}
　　 MyComThread: TMyCommWacth;
　　 BaudRates:　　　Integer;
　　 comName: TComPorts;
　　 parity: TParity ;
　　 Stopbits : TStopBits ;
　　 DataBits : Byte;
　　 InPutbuffers: Integer;
　　 OutPutbuffers: Integer;
commMode: TOncommMode;
OnCommMsg: TOnCommEvent;
procedure CommWndProc( var msg: TMessage );message WMCOMMNOTIFY;
　　 ｛ Private declarations ｝
　 protected
　　 procedure OnCommData(Buffer: PChar; BufferLength: Word);
　　 ｛ Protected declarations ｝
　 public｛運行屬性｝
　　 hCommFile:　　　THandle;
hCloseEvent: THandle;
　　 hComm32Window:THandle;
Function ComPortOpen : Thandle;
Function ComPortClose : Boolean;
procedure CloseMyComThread;
　　 Constructor
Create(Aowner:TComponent);override;
　　 destructor Destroy; override;
　　 ｛ Public declarations ｝
published{可視屬性及事件}
property comParity: TParity read Parity Write Parity default None;
property ComPortName:TComPorts read comName Write comName default com2;
property BaudRate:Integer read BaudRates Write BaudRates default 9600 ;
property Stopbit:TStopBits read Stopbits Write Stopbits default1;
property ByteDataBit:Byte read DataBits Write DataBits default 8;
property InBuffersize: Integer read InPutbuffers Write InPutbuffers default 1024;
property OutBuffersize:Integer read OutPutbuffers Write OutPutbuffers default 1024;
property SetComMode:TOncommMode read commMode Write commMode default evChar;
property OnComm:TOnCommEvent read OnCommMsg write OnCommMsg;
end;
procedure Register;
implementation
TMyCommWacth.Create();{監視線程創建}
begin
　　 inherited Create(False);
　　 FreeOnTerminate:=True;
end;
｛監視線程執行｝
procedure TMyCommWacth.Execute;
Var DwTransfer,DwEvtMask:Integer;
begin
　 if Comm32.SetComMode = Evchar then
　 begin
　　 if not SetCommMask(hCommFile,
　　 EVRXCHAR) then Exit;
　　 While( true) do
　　 begin
　　　 DwEvtMask:=0;
　　　 WaitCommEvent(hCommFile,
　　　 DwEvtMask,@Lpoverlapped);
　　　 if((DwEvtMaskandEVRXCHAR)
　　　 =EVRXCHAR) then
　　 begin
　　　 WaitForSingleObject(PostEvent, 1000000);
　　　 ResetEVent(PostEvent);
　　　 PostMessage(hComm32Window ,WMCOMMNOTIFY,hcommfile,0);
　　　 end;
　　 end;
　 end else
　 begin
　　 if not setCommMask(hCommFile,
EVRXFLAG) then Exit;
　　 While( true) do
　　 begin
　　　 DwEvtMask:=0;
　　　 WaitCommEvent(hCommFile,DwEvtMask,@comm32.Lpoverlapped);
　　　 if ((DwEvtMask and EVRXFLAG)
　　　 =EVRXFLAG) then
　　　 begin
　　　　 WaitForSingleObject(comm32.PostEvent,1000000);
　　　 ResetEVent(comm32.PostEvent);
　　　 PostMessage(hComm32Window,WMCOMMNOTIFY,hCommFile,NULL);
　　　 end;
　　　 end;
　 end;
end; ｛監視線程結束｝
｛建立通信構件｝
Tcomm32.Create(Aowner:Tcomponent);
begin
　　 inherited Create(aOwner);
　　 MyComThread:= nil;
　　 hCommFile := 0;
　　 hCloseEvent := 0;
　　 Parity:=None;
　　 ComName:=com2;
　　 BaudRates:=9600;
　　 Stopbits:=1;
　　 DataBits:=8;
　　 InPutBuffers:=1024;
　　 OutPutBuffers:=1024;
　　 CommMode:=Evchar;
end;
destructor TComm32.Destroy;{構件析構函數}
begin
　　 if not(csDesigning in ComponentState)then
　　 DeallocateHWnd(hComm32Window);
　　 inherited Destroy;
end;
procedure Register;{構件注冊}
begin
本文有[www.0574-laser.com]提供，請及時關注[www.0574-laser.com]提供的內容
　 RegisterComponents(’Sample’, ［Tcomm32］);
end;
procedure TComm32.OnCommData(Buffer: PChar; BufferLength: Word);
begin
　　 if Assigned(OnCommMsg) then
　　　　 OnCommMsg( self , Buffer, BufferLength);
end;
｛構件端口打開方法｝
Function TComm32.comPortOpen : Thandle;
var dcbPort:TDCB;
　　 ComBuff:BOOlean;
　　 StrCom:string;