unit1.pas

求是科技出版的《Delphi串口通信工程开发实例导航》所有的源代码。是一本很好的书。拿出来与大家共享。

//***********************************************
//云台程序主界面单元
//***********************************************
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, OleCtrls, MSCommLib_TLB,
  Registry,//使用TRegistry需要的单元
  IniFiles;//使用TIniFile需要的单元

//***********************************************
//声明：串口通信参数的记录体
//***********************************************
  Type
     RecSerialPortConfg =Record
        PortNr :String;                      //串口号,从1开始
        BaudRate :String;                 //波特率
        DataBits :String;                 //数据位
        StopBits :String;                    //停止位
        Parity :String;                      //奇偶较验,存对应首字母的Ascii码
  end;

//***********************************************
//声明:主窗体
//***********************************************  

type
  TMainForm = class(TForm)
    StatusBar1: TStatusBar;
    GroupBox1: TGroupBox;
    btConfIO: TButton;
    btConfCode: TButton;
    btExit: TButton;
    GroupBox2: TGroupBox;
    bbtnLeft: TBitBtn;
    bbtnLeftUp: TBitBtn;
    pnlAutoAct: TPanel;
    bbtnUp: TBitBtn;
    bbtnRight: TBitBtn;
    bbtnDown: TBitBtn;
    bbtnLeftDown: TBitBtn;
    bbtnRightUp: TBitBtn;
    bbtnRightDown: TBitBtn;
    btMir0: TButton;
    btMir5: TButton;
    pnlLight: TPanel;
    btMir2: TButton;
    btMir4: TButton;
    btMir3: TButton;
    btMir1: TButton;
    pnlWaterBrush: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    MSComm1: TMSComm;
    procedure btConfIOClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure pnlAutoActClick(Sender: TObject);
    procedure btConfCodeClick(Sender: TObject);
    procedure btExitClick(Sender: TObject);
    procedure btMir0MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btMir0MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btMir1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btMir4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btMir3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btMir5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btMir2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnUpMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnDownMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnLeftMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnRightMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnLeftDownMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnRightDownMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnLeftUpMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnRightUpMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
   //*****************************
   //定义指令集和云台状态集
   //*****************************
    ByteCodeChoose: Array[1..32] of Byte;       //云台选择指令集
    ByteCodeAct: Array[0..4] of Byte;           //动作控制指令集
    ByteCodeMir: Array[0..5] of Byte;           //镜头控制指令集
    ByteCodeStatus: Array[0..2] of Byte;        //状态控制指令集
  //*****************************
  //其它属性
  //*****************************
    bSerial:Boolean;                            //是否使用串口进行通信
    IoPort:Integer;                             //使用IO口时端口号
    conSerialPort:RecSerialPortConfg;           //串口类对象，存储串口设置参数

    bkUpRgb:Integer;                            //上浮按钮的背景色
    bkDownRgb:Integer;                          //下沉按钮的背景色
    curChoose:Integer;                          //当前选中的云台
    ByteStatus: Array[1..32,0..2] of Byte;      //所有云台的状态集合
    AppPath:String;                             //云台程序所在路径
    Panel:Array[1..32] of TPanel;               //用于自动生成32个选择按钮
  //*****************************
  //其它函数
  //*****************************    
    procedure  DrawChooseButtom;                //绘制32个云台选择按钮
    procedure  DownButton(index :Integer);      //使指定按钮浮起
    procedure  UpButton(index :Integer);        //使指定按钮下沉
    procedure  SetSerialPort;                   //设置串口
    procedure  WriteToPort(OutSend:Byte);       //通过底层串口或者并口发送一个数据
    procedure  FileTest;                        //检测WinIO各文件是否在程序相同的目录下
    procedure  WinIoInit;                       //初始化WinIo
    procedure  SystemReboot;                    //重新启动系统，在首次装载WinIo后
    procedure  InitConf;                        //载入指令配置，或是使用默认配置
    procedure  SaveConf;                        //保存当前的指令配置
  end;
  //*****************************
  //全局函数
  //*****************************
  function CByteToBin(DataIn:Byte):String;
  function CBinToByte(BinIn:String):Byte;

var
  MainForm: TMainForm;

implementation

uses Unit2, Unit3, Unit4;

{$R *.dfm}

//***********************************************
//声明常量
//***********************************************
const
   eleWidth: Integer =26;                       //各按钮的宽
   eleHeight: Integer =26;                      //各按钮高度
   eleWSpace :Integer =4;                       //各按钮水平间距
   eleHSpace :Integer =2;                       //各按钮垂直间距
   eleLeft:Integer =15;                         //按钮组距离容器的左边界距离
   eleTop:Integer =32;                          //按钮组距离容器的上边界距离
   iniFileName:String = 'YuntaiConfig.ini';     //配置文件名

//***********************************************
//功能：将一个字节形的数转换为二进制数，以字符串形式返回
//***********************************************
function CByteToBin(DataIn:Byte):String;
var
    tmpByte:Byte;
    tmpStr:String;
begin
    //将1置于一个字节的首位
    tmpByte:=$80;
    tmpStr:='';    
    while(tmpByte>=1) do
    begin
        if (DataIn>=tmpByte)  then              //DataIn在此位为1
        begin
            tmpStr:=tmpStr+'1';
            DataIn:=DataIn-tmpByte;            
        end
        else                                    //DataIn在此位为0
            tmpStr:=tmpStr+'0';
        tmpByte:=tmpByte div 2;                 //表示的1右移
    end;                                        //循环直到1从一个字节右端移出去
    Result:=tmpStr;
end;

//***********************************************
//功能：将一个以字符串形式表示的二进制数转换为十进制数
//***********************************************
function CBinToByte(BinIn:String):Byte;
var
    tmpByte:Byte;
    i,Len:Integer;

begin
    Len:=Length(BinIn);
    tmpByte:=0;
    //逐位计算得到
    for i:=1 to Len do
    begin
        tmpByte:=tmpByte*2+StrToInt(BinIn[i]);
        Result:=tmpByte;
    end;
end;
//******************************************************
//功能：向串口或IO口发一个指令，程序上层界面与底层通信模块交互的唯一函数
//参数: OutSend发送的指令代码
//******************************************************
procedure  TMainForm.WriteToPort(OutSend:Byte);
var
    tmpStr:String;
    bRet:Boolean;
begin
    tmpStr:=CByteToBin(OutSend);
    if bSerial then
    begin
        //设置状态栏消息
        statusBar1.SimpleText :='通过串口'+conSerialPort.PortNr+'发送指令'+tmpStr;
        if MSComm1.PortOpen =False then
             MSComm1.PortOpen :=True;
        MSComm1.OutPut:=tmpStr;                 //通过串口以文本格式发送数据
        MSComm1.PortOpen :=False;
    end
    else
    begin
        statusBar1.SimpleText :='通过并口'+IntToStr(IoPort)+'发送指令'+tmpStr;
        bRet:=SetPortVal(IoPort,OutSend,1);
        //向IO端口发送指令，若失败则在状态栏显示失败消息。
        //注意失败只可能由WinIO库初始化错误引起
        if not bRet then
            statusBar1.SimpleText :=statusBar1.SimpleText+'失败';
    end;    
end;
//******************************************************
//功能：DrawChooseButton用于云台程序运行后动态绘制32个云台选择按钮
//******************************************************
procedure  TMainForm.DrawChooseButtom;
var
    j,i,index:Integer;
begin

    //设置凸起和凹下时按钮的颜色
    bkUpRgb := RGB(215, 215, 215);
    bkDownRgb:= $8000000F;

    //动态生成和显示组件    
    index:=1;
    for  j:=1 to 8 do                                   //计数器，j表示列
    begin
       for i:=1 to 4 do                                // 计数器，i表示行，
       begin
       Panel[index]:=TPanel.Create(MainForm);
       with Panel[index] do
       begin
          Parent:=GroupBox1;                            //必须设置该属性
          Left := (i-1)*(eleWidth+eleWSpace)+eleLeft;   //设置在GroupBox1中的位置
          Top := (j-1)*(eleHeight+eleHSpace)+eleTop;
          Width := eleWidth;                            //设置按钮的大小
          Height := eleHeight;
          BevelInner := bvRaised;                       //默认是未选中状态
          BevelOuter := bvLowered;
          Caption := IntToStr(index);                   //按钮的序号
          Color:=bkUpRgb;                               //按钮的颜色
          tag:=Index;                                   //很重要，标示该按钮的序号
          OnClick:=pnlAutoActClick;                     //设置控件的点击处理过程
       end;
       Inc(Index);                                      //下 一个按钮
       end;
    end;

    //设置另外3个状态按钮的tag属性，
    //便于程序运行时能够识别该控件。
    pnlAutoAct.tag:=33;
    pnlLight.tag:=34;
    pnlWaterBrush.tag:=35;
end;
//*********************************************
//功能：使指定按钮下沉
//参数：index，下沉按钮控件的tag值
//*********************************************
procedure  TMainForm.DownButton(index :Integer);
begin

     //如果是选择云台按钮
     if(index<33) then
     begin
        with Panel[index] do
        begin
           BevelInner := bvNone;
           Color:=bkDownRgb;
        end;
     end;

     //如果是"自动"按钮
     if (index=33) then
     begin
        with pnlAutoAct do
        begin
           BevelInner := bvNone;
           Color:=bkDownRgb;
        end;
     end;

     //如果是"开射灯"按钮
     if (index=34) then
     begin
        with pnlLight do
        begin
           BevelInner := bvNone;
           Color:=bkDownRgb;
        end;
     end;

     //如果是"开雨刷"按钮
     if (index=35) then
     begin
        with pnlWaterBrush do
        begin
           BevelInner := bvNone;
           Color:=bkDownRgb;
        end;
     end;
end;
//*********************************************
//功能：使指定按钮浮起
//参数：index，被沉按钮控件的tag值
//*********************************************
procedure  TMainForm.UpButton(index :Integer);
begin

     //如果是选择云台按钮
     if(index<33) then
     begin
        with Panel[index] do
        begin
           BevelInner := bvRaised;
           Color:=bkUpRgb;
        end;
     end;

     //如果是"自动"按钮
     if (index=33) then
     begin
        with pnlAutoAct do
        begin
           BevelInner := bvRaised;
           Color:=bkUpRgb;
        end;
     end;

     //如果是"开射灯"按钮
     if (index=34) then
     begin