以前准备写一个关于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方法,使用起来非常简单,只不过是针对具体的内容加以灵活运用而已,数据接受按照不同调制解调器的通讯协议接收并解析就可以了,有什么问题,大家可以跟贴讨论!