unit SerialDebug;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, MSCommLib_TLB;

type
  TMainForm = class(TForm)
    mmReceive: TMemo;
    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;
    mmSend: tmemo;
    chckbxHexSend: TCheckBox;
    chckbxTimer: TCheckBox;
    edtTime: TEdit;
    Label7: TLabel;
    MSComm: TMSComm;
    tmrSend: TTimer;
    chckbxHexShow: TCheckBox;
    Panel3: TPanel;
    chckbxRTS: TCheckBox;
    chckbxDTR: TCheckBox;
    Label5: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    shpDSR: TShape;
    shpCTS: TShape;
    shpCD: TShape;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button4: TButton;
    Button3: TButton;
    Button5: TButton;
    Memo1: TMemo;
    Button6: TButton;
    btnSend: TButton;
    btnClear: TButton;
    Label10: TLabel;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    procedure FormCreate(Sender: TObject);
    procedure btnSerialClick(Sender: TObject);
    procedure chckbxDTRClick(Sender: TObject);
    procedure chckbxRTSClick(Sender: TObject);
    procedure chckbxTimerClick(Sender: TObject);
    procedure MSCommComm(Sender: TObject);
    procedure chckbxHexShowClick(Sender: TObject);
    procedure chckbxHexSendClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure tmrSendTimer(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Label11Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
    HexShow:Boolean;
    HexSend:Boolean;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}
//該函數接收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;

//該函數接收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;

//程序的初始化
procedure TMainForm.FormCreate(Sender: TObject);
begin
    HexShow:=False;
    cmbbxComNum.ItemIndex:=0;
    shpSerial.Brush.Color:=clWhite;
    shpCD.Brush.Color:=clWhite;
    shpCTS.Brush.Color:=clWhite;
    shpDSR.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 :='關閉串口';
        chckbxHexShow.Enabled:=False;
    end
    else  begin
        //關閉串口
        //變換各個組件的狀態
        MSComm.PortOpen:=False;
        shpSerial.Brush.Color:=clWhite;//指示燈變白
        Panel1.Enabled:=True;
        btnSerial.Caption :='打開串口';
        chckbxHexShow.Enabled:=True;        
    end;
end;

//設置DTR線狀態
procedure TMainForm.chckbxDTRClick(Sender: TObject);
begin
        MSComm.DTREnable :=chckbxDTR.Checked
end;

//設置RTS線狀態
procedure TMainForm.chckbxRTSClick(Sender: TObject);
begin
        MSComm.RTSEnable :=chckbxRTS.Checked
end;

//開啟定時器，定時發送數據
procedure TMainForm.chckbxTimerClick(Sender: TObject);
begin
    if chckbxTimer.Checked then
    begin
        tmrSend.Interval:=StrToInt(edtTime.Text);
        tmrSend.Enabled:=True;        
    end
    else begin
        tmrSend.Enabled:=False;
    end;
end;

//處理控件的該事件，獲取底層交換的數據和連線的狀態
procedure TMainForm.MSCommComm(Sender: TObject);
var
    i,InputLen:Integer;
    tmpInt:Integer;
    tmpvar:Variant;
    InputString,s:String;
    m, x,x1,x2,z,z1,z2,z3,z4,z5,z6,z7:string;y,y1,y2:integer;
begin
    if MSComm.CommEvent=ComEvReceive then
    begin
        InputLen:=MSComm.InBufferCount;

        //接收二進制數據，轉換為十六進制顯示
        if HexShow then
        begin
          tmpvar:=MSComm.Input;
          InputString:='';
          for i:= 0 to InputLen-1 do
          begin
            tmpInt:=tmpvar[i];
            InputString:=InputString+''+LowerCase(IntToHex(tmpInt,2));
          end;
        end
        //直接接收字符
        else begin
            InputString:=MSComm.Input;
        end;
        MainForm.mmReceive.Text :=MainForm.mmReceive.Text+inputstring;

          s:=mainform.mmReceive.Text;


       if length(s) >1  then  m:=copy(s,1,18);
        x1:=copy( m,2,1); x2:=copy(m,3,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z:=chr(y);
         x1:=copy( m,4,1); x2:=copy(m,5,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z1:=chr(y);
          x1:=copy( m,6,1); x2:=copy(m,7,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z2:=chr(y);
          x1:=copy( m,8,1); x2:=copy(m,9,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z3:=chr(y);
          x1:=copy( m,10,1); x2:=copy(m,11,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z4:=chr(y);
         x1:=copy( m,12,1); x2:=copy(m,13,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z5:=chr(y);
          x1:=copy( m,14,1); x2:=copy(m,15,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z6:=chr(y);
          x1:=copy( m,16,1); x2:=copy(m,17,1);
       trystrtoint(x1,y1); trystrtoint(x2,y2);
y:=y1*16+y2;
z7:=chr(y);
      memo1.text:=z+z1+z2+z3+z4+z5+z6+z7;
  end
    //顯示CD線的狀態
    else if MSComm.CommEvent=ComEvCD then
    begin
        if MSComm.CDHolding then
            shpCD.Brush.Color:=clRed
        else
            shpCD.Brush.Color:=clWhite;
    end
    //顯示CTS線的狀態
    else if MSComm.CommEvent=ComEvCTS then
    begin
        if MSComm.CTSHolding then
            shpCTS.Brush.Color:=clRed
        else
            shpCTS.Brush.Color:=clWhite;
    end
    //顯示DSR線的狀態
    else if MSComm.CommEvent=ComEvDSR then
    begin
        if MSComm.DSRHolding then
            shpDSR.Brush.Color:=clRed
        else
            shpDSR.Brush.Color:=clWhite;
    end;
end;

//設置MSComm控件的數據接收的方式
procedure TMainForm.chckbxHexShowClick(Sender: TObject);
begin
    if chckbxHexShow.Checked then
    begin
        MSComm.InputMode:=1;
        HexShow:=True;
    end
    else begin
        MSComm.InputMode:=0;
        HexShow:=False;
    end;
end;

//設置參數HexSend的值，以告訴程序如何發送數據
procedure TMainForm.chckbxHexSendClick(Sender: TObject);
begin
    HexSend:=chckbxHexSend.Checked;
end;


//發送數據
procedure TMainForm.btnSendClick(Sender: TObject);
var
    Len:Integer;
    i,count,tmpInt:Integer;
    tmpVar:Variant;
    tmpStr,Output:String;

begin
    if not MSComm.PortOpen then
    begin
        showmessage('沒有打開串口！');
        Exit;
    end
    else begin
        //發送二進制數，需要使用Variant變量矩陣，矩陣大小自動調節
        if HexSend then
        begin
            Output:=mmSend.Text;
            Len:=Length(Output);
            if Len>0 then
            begin
               i:=1;
               count:=1;
               //創建一個Variant數組
               tmpVar:=VarArrayCreate([1,1],varByte);
               while(i<Len) do
               begin
                  //每3個字符串中截取2個字符，轉換為16進制
                  tmpStr:=Copy(Output,i,2);
                  tmpStr:=LowerCase(tmpStr);
                  tmpInt:=HexToInt(tmpStr);
                  if tmpInt=-1 then
                  begin
                      showmessage('發送的數據格式有問題！');
                      exit;
                  end
                  else begin
                      tmpVar[Count]:=tmpInt;
                      Inc(count);
                     //增大Variant數組
                      VarArrayRedim(tmpVar,count);
                  end;
                  i:=i+3;
               end;
               MSComm.Output :=tmpVar;
            end;
        end
        else begin
            MSComm.Output :=mmSend.Text;