{$R *.dfm} function OnLineEvent(hCom: HCOMM; dwEvent, dwState, dwUser: DWORD): BOOL; cdecl; begin with TForm1(dwUser), CommEntry do mem.Lines.Add(Format('Event: %d State: %d', [dwEvent, dwState])); end;
function OnData(hCom:HCOMM;const lpData:Pointer;ulLen:ULONG;dwUser:DWORD):BOOL;cdecl; var s:string; n:integer; begin result := true; if dwUser=0 then exit;
with TForm1(dwUser), CommEntry do begin if ulLen = 0 then ulLen := StreamGetLen(); setlength(s, ulLen); StreamRead(@s[1], ulLen, RO_READ); mem.Lines.Add(s); inc(FRX, ulLen); Form1.LBRX.Caption := IntToStr(FRX); end; end;
procedure TForm1.BtnOpenClick(Sender: TObject); var ip: INITPARAM; begin with CommEntry do begin ip.pCallBack := @OnData; ip.nLenForRead := StrToInt(EdtLen.Text); ip.lpszSetting := PChar(EdtConf.Text); ip.dwUser := DWORD(Self); Open(@ip);
procedure TForm1.BtnWriteClick(Sender: TObject); begin with CommEntry do Write(PChar(mem.Text), Length(mem.Text)); end;
procedure TForm1.Button1Click(Sender: TObject); begin FRX:=0; mem.clear end;
procedure TForm1.BtnCloseClick(Sender: TObject); var bRet: boolean; begin mem.Clear; with CommEntry do begin bRet := CommEntry.Close(); BtnOpen.Enabled := not IsOpen(); BtnClose.Enabled := IsOpen(); end; end;
procedure TForm1.FormDestroy(Sender: TObject); begin CommEntry.Free; end;
procedure TForm1.BtnSetClick(Sender: TObject); begin if not CommEntry.SetCallbackParam(StrToInt(EdtLen.Text), nil, DWORD(Self))then Application.MessageBox('Set ERROR', 'Error', MB_OK or MB_ICONERROR); end;
end. ////////// ///////DFM //////DFM object Form1: TForm1 Left = 293 Top = 206 AutoScroll = False Caption = '串口库测试' ClientHeight = 610 ClientWidth = 877 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate OnDestroy = FormDestroy DesignSize = ( 877 610) PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 673 Top = 16 Width = 33 Height = 13 Anchors = [akTop, akRight] Caption = 'Setting' end object LBRX: TLabel Left = 736 Top = 400 Width = 6 Height = 13 Caption = '0' end object BtnOpen: TButton Left = 737 Top = 88 Width = 103 Height = 36 Anchors = [akTop, akRight] Caption = 'Open' TabOrder = 0 OnClick = BtnOpenClick end object BtnClose: TButton Left = 737 Top = 144 Width = 103 Height = 36 Anchors = [akTop, akRight] Caption = 'Close' Enabled = False TabOrder = 1 OnClick = BtnCloseClick end object mem: TMemo Left = 0 Top = 0 Width = 619 Height = 610 Align = alLeft Anchors = [akLeft, akTop, akRight] Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -12 Font.Name = 'Arial' Font.Style = [] ParentFont = False ScrollBars = ssVertical TabOrder = 2 end object BtnWrite: TButton Left = 737 Top = 208 Width = 103 Height = 36 Anchors = [akTop, akRight] Caption = 'Write' TabOrder = 3 OnClick = BtnWriteClick end object Button1: TButton Left = 737 Top = 280 Width = 103 Height = 36 Anchors = [akTop, akRight] Caption = 'Clear' TabOrder = 4 OnClick = Button1Click end object EdtConf: TEdit Left = 713 Top = 16 Width = 121 Height = 21 Anchors = [akTop, akRight] TabOrder = 5 Text = 'COM1:9600,N,8,1' end object EdtLen: TEdit Left = 745 Top = 56 Width = 89 Height = 21 Anchors = [akTop, akRight] TabOrder = 6 Text = '0' end object BtnSet: TButton Left = 739 Top = 344 Width = 97 Height = 41 Anchors = [akTop, akRight] Caption = 'Set' TabOrder = 7 OnClick = BtnSetClick end end
