⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 serialdebug.pas

📁 GPS对讲机接收
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit SerialDebug;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, MSCommLib_TLB, dxExEdtr, dxTL,
  dxDBCtrl, dxDBGrid, dxCntner, CheckLst;

type
  TMainForm = class(TForm)
    Panel2: TPanel;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    cmbbxComNum: TComboBox;
    cmbbxBaud: TComboBox;
    cmbbxDataNum: TComboBox;
    cmbbxStopBit: TComboBox;
    cmbbxCheckBit: TComboBox;
    btnSerial: TButton;
    shpSerial: TShape;
    MSComm: TMSComm;
    btnClear: TButton;
    Button3: TButton;
    Button1: TButton;
    mmReceive: TMemo;
    Label5: TLabel;
    Button2: TButton;
    Timer1: TTimer;
    GroupBox1: TGroupBox;
    CheckListBox1: TCheckListBox;
    GroupBox2: TGroupBox;
    Edit2: TEdit;
    Button5: TButton;
    Label7: TLabel;
    Button6: TButton;
    Label8: TLabel;
    Button8: TButton;
    Button9: TButton;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnSerialClick(Sender: TObject);
    procedure MSCommComm(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    
  private
    { Private declarations }
    HexShow:Boolean;
    HexSend:Boolean;
  public
  zz:string;
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses Undatamodule1;

{$R *.dfm}
//四舍五入保留两位
function SSWR(s: real): real; 
var 
r1, r2: real; 
s1, s2: string; 
begin 
r1 := int(s); 
r2 := frac(s); 
s1 := copy(floattostr(r1), 1, length(floattostr(r1))); 
if length(floattostr(r2)) >= 5 then 
begin 
if strtoint(copy((floattostr(r2)), 5, 1)) >= 5 then 
if strtoint(copy((floattostr(r2)), 4, 1)) = 9 then 
if strtoint(copy((floattostr(r2)), 3, 1)) = 9 then 
begin 
s1 := inttostr(strtoint(s1) + 1); 
s2 :=''; 
end 
else 
S2 := inttostr(strtoint(copy((floattostr(r2)), 3, 1)) + 1) 
else if copy((floattostr(r2)), 3, 1) = '0' then 
S2 := '0' + inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) 
else s2 := inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) 
else s2 := copy(floattostr(r2), 3, 2); 
end 
else s2 := copy(floattostr(r2), 3, 2); 
result := strtofloat(s1 + '.' + s2); 
end; 

//十进制转十六进制
function Int1ToHex(Const Value: Integer): string;
const
  HexChars: array[0..15] of Char = '0123456789ABCDEF';
var
  iTemp: Integer;
  i: Integer;
begin
  Result := '';
  i := 0;
  while i<4 do
  begin
    case i of
      0: iTemp := Value shr 24 and $FF;
      1: iTemp := Value shr 16 and $FF;
      2: iTemp := Value shr 8 and $FF;
      3: iTemp := Value and $FF;
    end;
    Result := Result + HexChars[iTemp div 16];
    Result := Result + HexChars[iTemp mod 16];
    Inc(i);
  end;
end;

//将单个字符的串转换成字符 参数说明:Str:被转换的串 
Function Str_StrToChar(Str: String): Char; 
Begin 
Result := #0; 
If Length(Str) = 0 Then exit; 
If Length(Str) > 1 Then exit; 
Result := Str[1]; 
End; 

//该函数接收1个
//转换成功.输出字符对应的数
//转换失败.输出-1
function hex(c:char):Integer ;
var
      x:integer;
begin
     if c=' ' then
        x:=0
     else if (Ord(c)>=ord('0')) and (Ord(c)<=ord('9')) then
        x:=Ord(c)-Ord('0')
     else if (Ord(c)>=ord('a')) and (Ord(c)<=ord('f')) then
        x:=Ord(c)-Ord('a')+10
     else if (Ord(c)>=ord('A')) and (Ord(c)<=ord('F')) then
        x:=Ord(c)-Ord('A')+10
     else
        //输入错误
        x:=-1;        
      Result:=x;
end;
//将一个十六进制的值转换成整型 参数说明:Hex:被转换的十六进制值
Function Str_HexToInt(Hex: String): integer;
Var
HexDigital: Set Of char;
i: integer;
Digital: String;
Begin
Result := 0;
HexDigital := ['1', '2', '3', '4', '5', '6', '7', '8', '9', '0', 'A', 'B',
'C','D', 'E', 'F', 'a', 'b', 'c', 'd', 'e', 'f'];
If Length(Hex) = 0 Then Exit;
For i := 1 To Length(Hex) Do
Begin
Digital := Copy(Hex, i, 1);
If (i = 1) And (digital = '$') Then Continue;
If Not (Str_StrToChar(Digital) In HexDigital) Then Exit;
End;
Digital := Copy(Hex, 1, 1);
If Digital <> '$' Then Hex := '$' + Hex;
Result := StrToInt(Hex);
End;
//将一个十进制整型转换成二进制值 参数说明:Int:被转换的整型值 
//Size:转换后的宽度:4位 8位 或更大 
Function Str_IntToBin(Int: LongInt; Size: Integer): String; 
Var 
i: Integer; 
Begin 
If Size < 1 Then Exit; 
For i := Size Downto 1 Do 
Begin 
If Int And (1 Shl (Size - i)) <> 0 Then 
Result := '1' + Result 
Else 
Result := '0' + Result; 
End; 
End;


//该函数接收1个至2个字符
//转换成功.输出对应16进制数的值
//转换失败.输出-1。
function HexToInt(S:String): Integer;
var
    tmpInt1,tmpInt2:Integer ;
begin
   if Length(S)=1 then
   begin
      Result:=hex(S[1]);
   end
   else if Length(S)=2 then
   begin
      tmpInt1:=hex(S[1]);
      tmpInt2:=hex(S[2]);
      if (tmpInt1=-1) or (tmpInt2=-1) then
          Result:=-1
      else
          Result:= tmpInt1*16+tmpInt2;
      end
    else
        //输入错误,转换失败    
        Result:=-1;
end;

//十六进制异或
function hexxorstr(const s:string; skey:string):string;
var
ppp3:string;
ppp,ppp1,ppp2,len,i:integer;
begin
ppp1:=Str_HexToInt(s);
ppp2:=Str_HexToInt(skey);
ppp:=ppp1 xor ppp2;
result:=inttohex(ppp,2);
end;

//程序的初始化
procedure TMainForm.FormCreate(Sender: TObject);
begin
    cmbbxComNum.ItemIndex:=0;
    shpSerial.Brush.Color:=clWhite;
    Panel1.Enabled:=True;
end;

//打开或者关闭串口,并变换指示灯的状态
procedure TMainForm.btnSerialClick(Sender: TObject);
var
    ComSetting:String;
    
begin
    if not MSComm.PortOpen then
    begin
        //打开串口
        MSComm.CommPort :=cmbbxComNum.ItemIndex +1;
        //默认值为 '9600,N,8,1'
        ComSetting:=cmbbxBaud.Text;
        ComSetting:=ComSetting+','+cmbbxCheckBit.Text;
        ComSetting:=ComSetting+','+cmbbxDataNum.Text;
        ComSetting:=ComSetting+','+cmbbxStopBit.Text;
        MSComm.Settings:=ComSetting;
        MSComm.PortOpen:=True;

        //变换各个组件的状态
        shpSerial.Brush.Color:=clRed; //指示灯变红
        Panel1.Enabled:=False;
        btnSerial.Caption :='关闭串口';
      
    end
    else  begin
        //关闭串口
        //变换各个组件的状态
        MSComm.PortOpen:=False;
        shpSerial.Brush.Color:=clWhite;//指示灯变白
        Panel1.Enabled:=True;
        btnSerial.Caption :='打开串口';

    end;
end;

//处理控件的该事件,获取底层交换的数据和连线的状态
procedure TMainForm.MSCommComm(Sender: TObject);
var
    i,InputLen,zzlen,j,npos:Integer;
    tmpInt,tempint1,tempint2:Integer;
    tempint3,tempint4,jingdu,weidu:real;
    tmpvar:Variant;
    InputString,var1,var2,var3,jd,wd,temp,bh,sd:String;

begin
    if MSComm.CommEvent=ComEvReceive then
    begin
        InputLen:=MSComm.InBufferCount;
        MSComm.InputMode:=1;
          tmpvar:=MSComm.Input;
          InputString:='';
          for i:= 0 to InputLen-1 do
          begin
            tmpInt:=tmpvar[i];
            InputString:=InputString+' '+LowerCase(IntToHex(tmpInt,2));
          end;
      // edit1.Text :='';
       zz:=zz+InputString;
     //  edit1.Text :=zz;
       if  (length(trim(zz))=47) and (copy(zz,20,2)='80') then
        begin
         bh:=copy(zz,14,2)+copy(zz,17,2);
          //经度
         var1:=copy(zz,32,3);
          var2:=copy(zz,35,3);
          var3:=copy(zz,38,3);
          jd:=trim(var3)+trim(var2)+trim(var1)+'00';
          var1:=copy(jd,1,29);
          var2:=copy(jd,30,3);
          jd:=var2+var1;
          jd:=inttostr(Str_HexToInt(copy(jd,1,8)) shr 3);
          tempint1:=strtoint(jd)*9  div 15707950;
          tempint3:=((strtoint(jd)*9)/15707950-tempint1)*60;
          tempint4:=((((strtoint(jd)*9)/15707950-tempint1)*60)-trunc(tempint3))*60;
          npos:=pos('.',floattostr(tempint4));
          jd:='经度:东经'+inttostr(tempint1)+'度'+inttostr(trunc(tempint3))+'分'+copy(floattostr(tempint4),1,npos+1)+'秒';
          //经纬度从度分秒格式转换为小数格式只需要:(度*60*60+分*60+秒)/60/60 即可
           jingdu:=(tempint1*60*60+tempint3*60+tempint4)/60/60;
          jingdu:=SSWR(jingdu);
          tempint1:=0;
          tempint2:=0;
          tempint3:=0;
          tempint4:=0;
          npos:=0;
        //维度
         var1:=copy(zz,23,3);
         var2:=copy(zz,26,3);
          var3:=copy(zz,29,3);
          wd:=trim(var3)+trim(var2)+trim(var1)+'00';
          var1:=copy(wd,1,29);
          var2:=copy(wd,30,3);
          wd:=var2+var1;
          wd:=inttostr(Str_HexToInt(copy(wd,1,8)) shr 3);
          tempint1:=strtoint(wd)*9  div 15707950;
          tempint3:=((strtoint(wd)*9)/15707950-tempint1)*60;
          tempint4:=((((strtoint(wd)*9)/15707950-tempint1)*60)-trunc(tempint3))*60;
          npos:=pos('.',floattostr(tempint4));
          wd:='纬度:北纬'+inttostr(tempint1)+'度'+inttostr(trunc(tempint3))+'分'+copy(floattostr(tempint4),1,npos+1)+'秒';
         //经纬度从度分秒格式转换为小数格式只需要:(度*60*60+分*60+秒)/60/60 即可
          weidu:=(tempint1*60*60+tempint3*60+tempint4)/60/60;
         weidu:=SSWR(weidu);
         // edit1.Text:='编号:'+bh+';'+jd+';'+wd;
         MainForm.mmReceive.Text:='';
          MainForm.mmReceive.Text :='编号:'+bh+';'+jd+';'+wd;;

          //速度
           var1:=copy(zz,41,2);
           sd:=trim(var1)+'00';
         //jd:=trim(var1)+trim(var2)+trim(var3)+'00';
          var1:=copy(sd,1,13);
          var2:=copy(sd,14,3);
          sd:=var2+var1;
          sd:=inttostr(Str_HexToInt(copy(sd,1,4)) shr 3);

           //方向

          //zz:=copy(Inputstring,23,9);
       //   showmessage('2='+zz);
        //  edit2.Text:=zz;
        //  edit1.Text:=trim(copy(zz,23,9));//wd;
          zz:='';
         // zz:=InputString;
        //  showmessage('1='+zz);
        //zz:='';
        with datamodule1 do
        begin
        t_query.Close;
        t_query.SQL.Clear;
        t_query.SQL.add('insert into gpsdata(id,gpdjingdu,gpsweidu,shijian) values(:var00,:var01,:var02,:var03)');
        t_query.Params[0].Value:=bh;
        t_query.Params[1].Value:=jingdu;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -