apdcomport操作串口实例

以前准备写一个关于adpcommport的使用实例，后来由于时间太少么有写，看了baidu的统计，感觉不少同学比较关注这个东西，我给最新我写的一个软件的部分代码给贴上来，并做一些必要的说明，如果有什么不妥的地方希望大家给扔块转头！

unit commmain;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, OoMisc, AdPort, StdCtrls, ExtCtrls, ComCtrls, AdStatLt,IniFiles;

type
    Tdig=record
    util:string;
    id:string;
    end;
   TMainForm = class(TForm)
     ComPort1: TApdComPort;
     Panel3: TPanel;
     Btn_ClearView: TButton;
     StatusBar: TStatusBar;
     Btn_SaveView: TButton;
     Panel4: TPanel;
     CB_StopBits: TComboBox;
     Label3: TLabel;
     Label5: TLabel;
     CB_DataBits: TComboBox;
     CB_Parity: TComboBox;
     Label4: TLabel;
     Label2: TLabel;
     CB_Baud: TComboBox;
     CB_ComNum: TComboBox;
     Label1: TLabel;
     Btn_Reset: TButton;
     SaveDialog1: TSaveDialog;
     OpenDialog1: TOpenDialog;
     Timer_AutoSend: TTimer;
     CB_Clear: TCheckBox;
     CB_HexGet: TCheckBox;
     CB_StopShow: TCheckBox;
     Timer_WatchState: TTimer;
     Shape_ComState: TShape;
     GroupBox2: TGroupBox;
     DW_ComBox: TComboBox;
     Button1: TButton;
     Button2: TButton;
     Label9: TLabel;
     Label10: TLabel;
     Label11: TLabel;
     GroupBox4: TGroupBox;
     ManyMemo: TMemo;
     CB_many: TCheckBox;
     CB_hexSend: TCheckBox;
     GroupBox7: TGroupBox;
     Label14: TLabel;
     Edit2: TEdit;
     Label15: TLabel;
     Edit3: TEdit;
     Label16: TLabel;
     Edit4: TEdit;
     Label17: TLabel;
     Panel5: TPanel;
     GroupBox1: TGroupBox;
     GroupBox3: TGroupBox;
     Label12: TLabel;
     CheckBox2: TCheckBox;
     Label13: TLabel;
     dbbl: TEdit;
     Label18: TLabel;
     dbys: TComboBox;
     GroupBox5: TGroupBox;
     Label20: TLabel;
     ComboBox2: TComboBox;
     Label21: TLabel;
     Edit6: TEdit;
     GroupBox6: TGroupBox;
     Label8: TLabel;
     z: TLabel;
     DW_Id: TEdit;
     DW_Edit: TEdit;
     DW_Add: TButton;
     ComboBox3: TComboBox;
     Label23: TLabel;
     Label24: TLabel;
     Edit7: TEdit;
     GroupBox8: TGroupBox;
     Label25: TLabel;
     Edit8: TEdit;
     Label26: TLabel;
     Edit9: TEdit;
     Label27: TLabel;
     Edit10: TEdit;
     Edit11: TEdit;
     Label28: TLabel;
     Edit12: TEdit;
     Label29: TLabel;
     Btn_Send: TButton;
     Btn_CountReset: TButton;
     SendMemo: TMemo;
     CB_AutoSend: TCheckBox;
     Label6: TLabel;
     Edt_Interval: TEdit;
     Label7: TLabel;
     GroupBox9: TGroupBox;
     Memo1: TMemo;
     CheckBox4: TCheckBox;
     GroupBox10: TGroupBox;
     Label22: TLabel;
     ComboBox4: TComboBox;
     Label30: TLabel;
     kjkd: TEdit;
     CheckBox5: TCheckBox;
     Label31: TLabel;
     CheckBox3: TCheckBox;
     CheckBox6: TCheckBox;
     CheckBox7: TCheckBox;
     Label19: TLabel;
     Edit1: TEdit;
     Label32: TLabel;
     CheckBox8: TCheckBox;
     sd: TCheckBox;
     CheckBox10: TCheckBox;
     Label33: TLabel;
     zsw: TCheckBox;
     zsj: TCheckBox;
     yxw: TCheckBox;
     yxj: TCheckBox;
     mutilsend: TTimer;
     Button4: TButton;
     Memo_Show: TMemo;
     Memojx: TMemo;
     editCombox: TComboBox;
     procedure ComPort1Trigger(CP: TObject; Msg, TriggerHandle,
       Data: Word);
     procedure diff(s:string);
     procedure Btn_ResetClick(Sender: TObject);
     procedure SendHex(S: String);
     procedure Btn_SendClick(Sender: TObject);
     procedure Btn_ClearViewClick(Sender: TObject);
     procedure CB_ComNumSelect(Sender: TObject);
     procedure Btn_SaveViewClick(Sender: TObject);
     procedure CB_AutoSendClick(Sender: TObject);
     procedure Edt_IntervalKeyPress(Sender: TObject; var Key: Char);
     procedure Timer_AutoSendTimer(Sender: TObject);
     procedure Memo_ShowChange(Sender: TObject);
     procedure leijia(s:string);
     procedure zhuhang(s:string);
     procedure ComPortInit;
     procedure InitDate;
     procedure FormShow(Sender: TObject);
     procedure Btn_CountResetClick(Sender: TObject);
     procedure Timer_WatchStateTimer(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure Label9Click(Sender: TObject);
     procedure Label10Click(Sender: TObject);
     procedure DW_AddClick(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
     procedure DW_ComBoxChange(Sender: TObject);
     procedure CB_manyClick(Sender: TObject);
     procedure CheckBox1Click(Sender: TObject);
     procedure CheckBox3Click(Sender: TObject);
     procedure CheckBox6Click(Sender: TObject);
     procedure Edit7Click(Sender: TObject);
     procedure CheckBox10Click(Sender: TObject);
     procedure Button4Click(Sender: TObject);
     procedure ManyMemoChange(Sender: TObject);
     procedure mutilsendTimer(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     procedure StatusBarClick(Sender: TObject);
     procedure StatusBarDblClick(Sender: TObject);
   private
     { Private declarations }
   diglist: array[0..30] of Tdig;
     procedure myMemoAddText(strAdd : string);
     procedure init();
   public
     { Public declarations }
   end;

const
   version='定位控制器 1.0版';
   SoftName='定位控制器';

var
   MainForm   : TMainForm;
   JSdate,FSdate : integer;

var dbkmlList:TStringList;
     gjkmlList:TStringList;
     num:integer;

implementation
{$R *.dfm}
//显示隐藏
procedure TMainForm.myMemoAddText(strAdd : string);
var
   str : string;
begin
   str := Memo_Show.Lines[Memo_Show.Lines.Count-1];
   Memo_Show.Lines[Memo_Show.Lines.Count-1] := str+strAdd
end;

//累加显示
procedure TMainForm.leijia(s:string);
begin
   myMemoAddText(s);
end;

//逐行显示
procedure TMainForm.zhuhang(s:string);
begin
   Memo_Show.Lines.Add(s);
end;

procedure TMainForm.diff(s:string);
begin
   if not CB_StopShow.Checked then
         Leijia(s);
end;

//接收数据
procedure TMainForm.ComPort1Trigger(CP: TObject; Msg, TriggerHandle,
   Data: Word);
var
   I : Word;
   C : Char;
   s : String;
begin
   try
   case Msg of
     APW_TRIGGERDATA :
       {got 'login', send response}
       ;
     APW_TRIGGERAVAIL :
       {extract and display/process the data}
       begin
         s:='';
         for I:= 1 to Data do
         begin
           C := ComPort1.GetChar;
           if CB_hexGet.Checked then
           begin
             s:=s+inttohex(byte(c),2)+' ';
           end else
             s:=s+c;
           inc(JSdate);
         end;
         StatusBar.Panels.Items[2].Text:='接收：'+inttostr(JSdate);
       // str:=copy(s,8,4)+'号目标,'+'当前纬度：' +copy(s,12,7)+'，经度：'+copy(s,19,8)+',速度：'+copy(s,27,3)+'，高度：'+copy(s,34,6);
          Diff(s);
       end;
     APW_TRIGGERTIMER :
       {timed out waiting for login prompt, handle error}
       ;
   end;
   except
   end;
end;

//发送16进制数据
procedure TMainForm.SendHex(S: String);
var
   s2:string;
   buf1:array[0..50000] of byte;
   i:integer;
begin
   s2:='';
     for i:=1 to   length(s) do
     begin
       if ((copy(s,i,1)>='0') and (copy(s,i,1)<='9'))or((copy(s,i,1)>='a') and (copy(s,i,1)<='f'))
         or((copy(s,i,1)>='A') and (copy(s,i,1)<='F')) then
       begin
         s2:=s2+copy(s,i,1);
       end;
     end;
     for i:=0 to (length(s2) div 2-1) do
     begin
       buf1[i]:=strtoint('$'+copy(s2,i*2+1,2));
     end;
     MainForm.ComPort1.PutBlock(buf1,(length(s2) div 2));
end;

//等待串口发送完毕
procedure waitcommEmpty;
var
   t:integer;
begin
   t:=0;
   while (MainForm.ComPort1.OutBuffUsed>0) or (t>100) do
   begin
     sleep(200);
     inc(t);
   end;
     sleep(200);
end;

// 设置串口
procedure TMainForm.ComPortInit;
begin
   try
     ComPort1.Open:=false;
     Shape_ComState.Brush.Color:=clRed;
     sleep(50);
     ComPort1.ComNumber:=CB_ComNum.ItemIndex+1;
     ComPort1.Baud:=strtoint(CB_Baud.Text);
     case CB_Parity.ItemIndex of
     0:
       ComPort1.Parity:=pEven;
     1:
       ComPort1.Parity:=pMark;
     2:
       ComPort1.Parity:=pNone;
     3:
       ComPort1.Parity:=pOdd;
     4:
       ComPort1.Parity:=pSpace;
     else
       ComPort1.Parity:=pNone;
     end;
     ComPort1.DataBits:=strtoint(CB_DataBits.Text);
     ComPort1.StopBits:=strtoint(CB_StopBits.Text);
     ComPort1.Open:=true;
   except
     showmessage('串口不存在或被占用。');
   end;
end;

//设置计数器
procedure TMainForm.InitDate;
begin
   JSdate:=0;
   FSdate:=0;
   StatusBar.Panels.Items[1].Text:='发送：0';
   StatusBar.Panels.Items[2].Text:='接收：0';
end;

procedure TMainForm.Btn_ResetClick(Sender: TObject);
begin
ComPortInit;
end;

procedure TMainForm.Btn_SendClick(Sender: TObject);
var
   s:string;
begin
    s:=SendMemo.Text;
    if   ComPort1.Open then
    begin
       if CB_hexSend.Checked then
        SendHex(S)
      else
        ComPort1.PutString(s);
        FSdate:=FSdate+length(s);
       StatusBar.Panels.Items[1].Text:='发送：'+inttostr(FSdate);
       waitcommEmpty;
     end else
     showmessage('串口未打开。');
end;

procedure TMainForm.Btn_ClearViewClick(Sender: TObject);
begin
   Memo_Show.Clear;
end;

procedure TMainForm.CB_ComNumSelect(Sender: TObject);
begin
   ComPortInit;
end;

procedure TMainForm.Btn_SaveViewClick(Sender: TObject);
var s:string;
begin
if not DirectoryExists(S) then
begin
   CreateDir(S);
   S:='gps.txt';
   Memo_show.Lines.Delete(0);
   Memo_Show.Lines.SaveToFile(S);
end;
end;

procedure TMainForm.CB_AutoSendClick(Sender: TObject);
begin
   if CB_AutoSend.Checked then
   begin
   if (CB_AutoSend.Checked=true)then
if ((strtoint(Edt_Interval.Text)/1000)<2) then
begin
   showmessage('你选择的周期太短，可能会造成数据丢失，请输入大于2秒的周期！');
   CB_AutoSend.Checked:=false;
end else
   begin
     Edt_Interval.Enabled:=false;
     Timer_AutoSend.Interval:=strtoint(Edt_Interval.Text);
     Timer_AutoSend.Enabled:=true;
   end
        end else   begin
     Timer_AutoSend.Enabled:=false;
     Edt_interval.Enabled:=true;
     end;
end;

procedure TMainForm.Edt_IntervalKeyPress(Sender: TObject; var Key: Char);
begin
   if key=#8 then exit;
   if (key>'9') or (key<'0') then
     key:=#0;
end;

procedure TMainForm.Timer_AutoSendTimer(Sender: TObject);
begin
   Btn_SendClick(Sender);
end;

procedure TMainForm.Btn_CountResetClick(Sender: TObject);
begin
   InitDate;
end;

procedure TMainForm.Timer_WatchStateTimer(Sender: TObject);
begin
   if   ComPort1.Open then
     Shape_ComState.Brush.Color:=clLime
   else
     Shape_ComState.Brush.Color:=clRed;
   StatusBar.Panels.Items[0].Text:=datetimetostr(now);
   StatusBar.Panels.Items[3].Text:=version;
end;

procedure TMainForm.Label9Click(Sender: TObject);
begin
MainForm.Width:=792;
label10.Visible:=true;
label9.Visible:=false;
end;

 

procedure TMainForm.CB_manyClick(Sender: TObject);
begin
    manymemo.Clear;
if(CB_many.Checked) then
     mutilsend.Interval:=strtoint(Edt_Interval.Text)
   end;

procedure TMainForm.CheckBox3Click(Sender: TObject);
begin
if checkbox3.Checked then
   groupbox5.Enabled:=true
   else
   groupbox5.Enabled:=false;
end;

procedure TMainForm.CheckBox6Click(Sender: TObject);
begin
if checkbox6.Checked=true then
    groupbox7.Enabled:=true else
    groupbox7.Enabled:=false;
end;

procedure TMainForm.Edit7Click(Sender: TObject);
begin
if OpenDialog1.Execute then
   Edit7.Text:=OpenDialog1.FileName;
end;

procedure TMainForm.CheckBox10Click(Sender: TObject);
begin
if(checkbox10.Checked)then
    groupbox10.Enabled:=true;
end;

procedure TMainForm.Button4Click(Sender: TObject);
begin
   editcombox.Items.Delete(editcombox.ItemIndex);
   dw_combox.Items:=editcombox.Items;
   showmessage('成功删除一条数据');
end;

procedure TMainForm.ManyMemoChange(Sender: TObject);
var i:integer;
begin
for i:=0 to manymemo.Lines.Count-1 do
begin
   diglist[i].util:=copy(manymemo.Lines[i],0,pos('(',manymemo.Lines[i])-1);
   diglist[i].id:=copy(manymemo.Lines[i],pos('(',manymemo.Lines[i])+1,4);
end;
end;

procedure TMainForm.mutilsendTimer(Sender: TObject);
begin
     sendmemo.Clear;
     sendmemo.Text:='$GPCMD,'+copy(manymemo.Lines[num],pos('(',manymemo.Lines[num])+1,4)+',01,000,000,00'+#13+#10;;
     num:=num+1;
   if(num>=manymemo.Lines.Count)then
      num:=0;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
   Ini: TIniFile;
var i:integer;
begin
Ini := TIniFile.Create( ChangeFileExt( Application.ExeName, '.INI' ) );
try
for i:=0 to editComBox.Items.Count-1 do
begin
    Ini.WriteString('单位','Id'+inttostr(i),DW_ComBox.Items[i]);
end;
finally
Ini.Free;
end;
end;
procedure TMainForm.StatusBarClick(Sender: TObject);
begin
groupbox2.Visible:=false;
mainform.ClientHeight:=20;
end;

procedure TMainForm.StatusBarDblClick(Sender: TObject);
begin
groupbox2.Visible:=true;
mainform.ClientHeight:=424;
end;

end.
adpcommport组件是一个操作串口很方便的组件，不需要依赖任何ocx控件，而且适用于很多编程平台，它接收数据主要就是用Trigger方法，使用起来非常简单，只不过是针对具体的内容加以灵活运用而已，数据接受按照不同调制解调器的通讯协议接收并解析就可以了，有什么问题，大家可以跟贴讨论！