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

📄 unit1.pas

📁 求是科技出版的《Delphi串口通信工程开发实例导航》所有的源代码。是一本很好的书。拿出来与大家共享。
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart,
  OleCtrls, MSCommLib_TLB;

type
  TForm1 = class(TForm)
    tbshtSignalChart: TPageControl;
    tbshtDebug: TTabSheet;
    rchdtSerialIn: TRichEdit;
    cmbbxSerialIn: TComboBox;
    Label7: TLabel;
    btRecStart: TButton;
    btRecStop: TButton;
    cmbbxBaudIn: TComboBox;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    btRecSave: TButton;
    cmbbxTypeIn: TComboBox;
    cmbbxSerialOut: TComboBox;
    Label13: TLabel;
    cmbbxBaudOut: TComboBox;
    rchdtSerialOut: TRichEdit;
    btSendOut: TButton;
    dtCode1: TEdit;
    lbCode1: TLabel;
    lbCode2: TLabel;
    dtCode3: TEdit;
    cmbbxTypeOut: TComboBox;
    Label16: TLabel;
    Label51: TLabel;
    tmrSerialIn: TTimer;
    MSCommOut: TMSComm;
    MSCommIn: TMSComm;
    dtCode2: TEdit;
    dtCode4: TEdit;
    lbCode3: TLabel;
    lbCode4: TLabel;
    ImgTrace: TImage;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    lbShowAd0: TLabel;
    lbShowAd1: TLabel;
    lbShowAd4: TLabel;
    lbShowAd5: TLabel;
    lbShowAd2: TLabel;
    lbShowGps5: TLabel;
    lbShowGps1: TLabel;
    lbShowAd7: TLabel;
    lbShowAd6: TLabel;
    lbShowAd3: TLabel;
    Label37: TLabel;
    lbShowGps6: TLabel;
    lbShowGps4: TLabel;
    Label53: TLabel;
    Label54: TLabel;
    Label55: TLabel;
    lbShowGps0: TLabel;
    btSaveTrace: TButton;
    btLoadTrace: TButton;
    btSaveData: TButton;
    Label1: TLabel;
    lbShowModel: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label39: TLabel;
    Label40: TLabel;
    lbShowPara0: TLabel;
    lbShowPara1: TLabel;
    lbShowPara2: TLabel;
    lbShowPara3: TLabel;
    lbShowPara4: TLabel;
    lbShowPara5: TLabel;
    lbShowPara6: TLabel;
    lbShowPara7: TLabel;
    Label49: TLabel;
    lbShowGps2: TLabel;
    Label57: TLabel;
    lbShowGps3: TLabel;
    Label59: TLabel;
    cmbbxModel: TComboBox;
    btSetModel: TButton;
    cmbbxParaNo: TComboBox;
    Label38: TLabel;
    Label60: TLabel;
    Label61: TLabel;
    dtParaValue: TEdit;
    btADInit: TButton;
    btSetPara: TButton;
    Label62: TLabel;
    rdgrpDataCode: TRadioGroup;
    dlgSaveData: TSaveDialog;
    dlgLoadTrace: TOpenDialog;
    dlgSaveTrace: TSaveDialog;
    rchdtTmp: TRichEdit;
    Label2: TLabel;
    TabSheet1: TTabSheet;
    chrtAcc: TChart;
    chrtGyro: TChart;
    srsGyroY: TFastLineSeries;
    srsGyroX: TFastLineSeries;
    srsGyroZ: TFastLineSeries;
    srsAcc1: TFastLineSeries;
    srsAcc2: TFastLineSeries;
    chrtHeight: TChart;
    srsHeight: TFastLineSeries;
    Label12: TLabel;
    btCharClear: TButton;
    tbshtSignal: TTabSheet;
    procedure FormCreate(Sender: TObject);
    procedure btRecStartClick(Sender: TObject);
    procedure btRecStopClick(Sender: TObject);
    procedure btRecSaveClick(Sender: TObject);
    procedure btSendOutClick(Sender: TObject);
    procedure tmrSerialInTimer(Sender: TObject);
    procedure btSetModelClick(Sender: TObject);
    procedure btSetParaClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btSaveTraceClick(Sender: TObject);
    procedure btLoadTraceClick(Sender: TObject);
    procedure btADInitClick(Sender: TObject);
    procedure btSaveDataClick(Sender: TObject);
    procedure btCharClearClick(Sender: TObject);
    procedure dtCode1Change(Sender: TObject);
    procedure dtCode2Change(Sender: TObject);
    procedure dtCode3Change(Sender: TObject);
    procedure dtCode4Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    InitADDataFlag:Boolean;    
  end;
 /////////////////////////////////////////////////////////////////
{
串口接受线程
}
  TSerialInThread =class(TThread)
  private
        SerialInput:Variant;           //保存该线程从串口获取得到的数据矩阵
        Seriallength : integer;        //该线程需要处理的数据的个数
        SerialStr:String;              //用于保存处理后数据的字符串变量

  protected
        procedure Execute; override;    //需要重载
        procedure GetData;              //从串口获取数据的过程
        procedure TransToStr;              //转换为适合显示的字符串的过程
        procedure PostData ;            //显示在用户界面的过程
  end;
  /////////////////////////////////////////////////////////////////
  { 
  串口发送线程
  }
  TSerialOutThread =class(TThread)
  private
        DataOrCode:Boolean;             //是否要求输出指令,False表明输出数据
        SerialOutput:String;            //发送数据时的数据矩阵
        Seriallength : integer;         //发送数据时,数据长度
        tmpVar:Variant;                 //发送指令时的数据矩阵
        CheckOk:Boolean;                //用户确定的数据或是指令是否有错误

  protected
        procedure Execute; override;    //需要重载
        procedure GetData;              //从用户界面获取需要输出的数据或是指令代码
        procedure PackData;             //根据协议打包数据
        procedure PackCode;             //根据协议打包指令
        procedure PostData;             //发送给串口控件,实现数据的发送                
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
const
        GpsDataCountMax : integer = 20;         //GPS数据包中数据的个数
        ParaDataCountMax: integer = 9;          //参数数据包中数据的个数
        ADDataCountMax:integer =16;             //传感器数据包中数据的个数

var
        {
        实现线程互斥的句柄。
        }
        hMutex:THandle =0;                      //串口接受数据的线程使用的互斥句柄
        hMutex2:THandle =0;                      //串口发送数据的线程使用的互斥句柄
        {
        用于指令上下传的全局变量
        }
        ReceiveCharFlag:Boolean;                 //是否以字符接受串口,False表示以数据接受
        ParaDataFlag:Boolean;                  //正在截取参数数据包的标志
        GPSDataFlag:Boolean;                    //正在截取GPS数据包的标志
        ADDataFlag:Boolean;                     //正在截取传感器数据包的标志

        ParaNewDataFlag:Boolean;                //截取完参数的标志
        GPSNewDataFlag:Boolean;                 //截取完GPS数据包的标志
        ADNewDataFlag:Boolean;                  //截取完传感器数据包的标志

        ParaDataCount:Integer;                  //截取参数数据包的计数器
        ADDataCount:Integer;                    //截取传感器数据包的计数器
        GpsDataCount:Integer;                   //截取GPS数据包的计数器
        
        DownStr:String;                         //用于保存串口下传的所有数据
        GpsStr:String;                          //保存GPS数据包的数据
        ADStr:String;                           //保存传感器数据包的数据

        ParaDataArray:array[0..8] of Byte;      //接受参数数据包的数组
        GpsDataArray:array[0..19] of Byte;      //接受GPS数据包的数组
        ADDataArray:array[0..15] of Byte;       //接受传感器数据包的数组
        ADDataDblArray:array[0..7] of double;   //传感器实际的采样值        
        ADDataArrayMean:array[0..13] of Byte;   //保存传感器静态均值的数组。
                            //不考虑系统电压。 

        ParaStrArray:array[0..3] of String;     //显示参数数据的字符串数组
        GpsStrArray:array[0..6] of String;      //显示GPS数据的字符串数组
        ADStrArray:array[0..7] of String;       //显示传感器的字符串数组
        {
        用于指令上下传的全局变量
        }
        CodeOutStr:array[1..4] of String;       //当前上传的指令代码
        CodeInStr:array[0..3] of String;        //下传返回的指令代码      
        {
        用于绘图的全局变量
        }
        gpsMeta: TMetaFile;                             //用于保存轨迹图像的对象
        posXArray,posYArray: array of double;           //保存当前飞行轨迹点的数组
        posXArrayLoad,posYArrayLoad: array of double;   //保存载入的轨迹点的数组
        posLength: Integer;                             //当前飞行轨迹点的总数
        posLengthLoad: Integer;                         //当前飞行轨迹点的总数

      {
      函数hex()是将0~f字符转换为0~15的整数。
      }
      function hex(c:String):Integer ;
       var
         x:integer;
       begin
          if (c='0') or (c=' ') then
            x:=0
          else if c='1' then
            x:=1
          else if c = '2' then
            x:=2
          else if c='3' then
            x:=3
          else if c='4' then
            x:=4
          else if c='5' then
            x:=5
          else if c='6' then
            x:=6
          else if c='7' then
            x:=7
          else if c='8' then
            x:=8
          else if c='9' then
            x:=9
         else if ((c='a') or (c='A')) then
            x:=10
         else if (c='b') or (c='B') then
            x:=11
         else if (c='c') or (c='C') then
            x:=12
         else if (c='d') or (c='D') then
            x:=13
         else if (c='e') or (c='E') then
            x:=14
         else if (c='f') or (c='F') then
            x:=15
         else
            x:=-1;
          Result:=x;
       end;

       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 GetMaxValue(x,y,x1,y1: Array of Double;len,len1: Integer): double;
var
  i: Integer;
begin
  result := 0;
  for i:=0 to len-1 do
  begin
    if abs(x[i])>result then
      result := abs(x[i]);
    if abs(y[i]) > result then
      result := abs(y[i]);
  end;
  for i:=0 to len1-1 do
  begin
    if abs(x1[i])>result then
      result := abs(x1[i]);
    if abs(y1[i]) > result then
      result := abs(y1[i]);
  end;
end;
/////////////////////////////////////////////////////////////////
{   绘制飞行轨迹的函数

     红色轨迹是载入的,
     蓝色的轨迹是当前轨迹点
     
 1.  posXArray,posYArray 是当前轨迹点的坐标,
     posLength是当前轨迹点的个数
 2.  posXArrayLoad,posYArrayLoad 是载入的轨迹点的坐标,
     posLengthLoad是载入的轨迹点的个数
     
}
procedure DrawAxis;
var
  i,x,y,wid,h: Integer;
  pstep,ratio,maxV : double;
  can: TMetaFileCanvas;
begin
  can := TMetaFileCanvas.Create(gpsMeta,0);             //建立一个画布对象
  gpsMeta.Width := Form1.ImgTrace.Width;                //确定画布对应图像的大小
  gpsMeta.Height := Form1.ImgTrace.Height;
  wid := gpsMeta.Width;
  h := gpsMeta.Height;
  {
  确定直角坐标的最大值,取10,100,200,500,1000,2000,5000,10000,50000,100000 的最小值
  缺省状态取 100
  }
  maxV := GetMaxValue(posXArray,posYArray,posXArrayLoad,posYArrayLoad,posLength,posLengthLoad);
  if maxV = 0 then
    maxV := 100;
  if maxV <= 10 then
  begin
    maxV := 10;
  end
  else if maxV <= 100 then
  begin
    maxV := 100;
  end
  else if maxV <= 200 then
    maxV := 200
  else if maxV<= 500 then
    maxV := 500
  else if maxV <= 1000 then
  begin
    maxV := 1000;
  end
  else if maxV<= 2000 then
    maxV := 2000
  else if maxV<= 5000 then
    maxV := 5000
  else if maxV <= 10000 then
  begin
    maxV := 10000;
  end
  else if maxV<= 50000 then
    maxV := 50000
  else if maxV <=100000 then
  begin
    maxV := 100000;
  end
  else
  begin
    maxV := 1000000;
  end;

⌨️ 快捷键说明

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