unit1.pas

Delphi下串口通讯源代码(本人用的测试程序)

          edit6.Text :='16';
          edit7.Text :='38';
          edit8.Text :='4B';
          edit9.Text :='00';
          edit10.Text :='00';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='D3';
          edit14.Text :='45';
        end;
      2:                   //控制设置
        begin
          edit1.Text :='53';
          edit2.Text :='0A';
          edit3.Text :='C2';
          edit4.Text :='04';
          edit5.Text :='38';
          edit6.Text :='19';
          edit7.Text :='C8';
          edit8.Text :='04';
          edit9.Text :='D8';
          edit10.Text :='60';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='DB';
          edit14.Text :='45';
        end;
      3:                  //无线广州台
        begin
          edit1.Text :='53';
          edit2.Text :='0A';
          edit3.Text :='C2';
          edit4.Text :='04';
          edit5.Text :='38';
          edit6.Text :='19';
          edit7.Text :='C8';
          edit8.Text :='04';
          edit9.Text :='D8';
          edit10.Text :='06';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='35';
          edit14.Text :='45';
        end;
      4:                    //调台
        begin
          edit1.Text :='53';
          edit2.Text :='0A';
          edit3.Text :='C2';
          edit4.Text :='02';
          edit5.Text :='38';
          edit6.Text :='19';
          edit7.Text :='00';
          edit8.Text :='00';
          edit9.Text :='00';
          edit10.Text :='00';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='E1';
          edit14.Text :='45';
          end;
      5:                 //B
        begin
          edit1.Text :='53';
          edit2.Text :='0A';
          edit3.Text :='86';
          edit4.Text :='02';
          edit5.Text :='00';
          edit6.Text :='D6';
          edit7.Text :='00';
          edit8.Text :='00';
          edit9.Text :='00';
          edit10.Text :='00';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='1F';
          edit14.Text :='45';
          end;
      6:                    //C
        begin
          edit1.Text :='53';
          edit2.Text :='0A';
          edit3.Text :='86';
          edit4.Text :='02';
          edit5.Text :='01';
          edit6.Text :='70';
          edit7.Text :='00';
          edit8.Text :='00';
          edit9.Text :='00';
          edit10.Text :='00';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='84';
          edit14.Text :='45';
          end;
      7:                     //E
        begin
          edit1.Text :='53';
          edit2.Text :='0A';
          edit3.Text :='86';
          edit4.Text :='02';
          edit5.Text :='02';
          edit6.Text :='4B';
          edit7.Text :='00';
          edit8.Text :='00';
          edit9.Text :='00';
          edit10.Text :='00';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='A8';
          edit14.Text :='45';
        end;
        else         //读状态
          begin
          edit1.Text :='53';
          edit2.Text :='08';
          edit3.Text :='00';
          edit4.Text :='00';
          edit5.Text :='00';
          edit6.Text :='00';
          edit7.Text :='00';
          edit8.Text :='00';
          edit9.Text :='00';
          edit10.Text :='00';
          edit11.Text :='00';
          edit12.Text :='00';
          edit13.Text :='F8';
          edit14.Text :='45';
         end;
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
    case  combobox3.ItemIndex of
        1:
        begin
            checkbox1.Enabled :=false;
            checkbox2.Enabled :=false;
            label9.Caption :='Sub';label9.Font.Color :=clred;
            label10.Caption :='B';label10.Font.Color :=clred;
            label16.Caption :='C';label16.Font.Color :=clred;
            label15.Caption :='E';label15.Font.Color :=clred;
        end;
        2:
        begin
            checkbox1.Enabled :=true;
            checkbox2.Enabled :=true;
            label9.Caption :='Db1';label9.Font.Color :=clred;
            label10.Caption :='Db2';label10.Font.Color :=clred;
            label16.Caption :='Cb';label16.Font.Color :=clred;
            label15.Caption :='Pb';label15.Font.Color :=clred;
            edit16.Text :=inttostr(strtoint('$'+edit5.Text)*256 +strtoint('$'+edit6.Text ));
        end;
        3:
        begin
            checkbox1.Enabled :=true;
            checkbox2.Enabled :=true;
            label9.Caption :='Db1';label9.Font.Color :=clred;
            label10.Caption :='Db2';label10.Font.Color :=clred;
            label16.Caption :='Cb';label16.Font.Color :=clred;
            label15.Caption :='Pb';label15.Font.Color :=clred;
            edit16.Text :=inttostr(strtoint('$'+edit5.Text)*256 +strtoint('$'+edit6.Text ));
        end;
        4:
        begin
            checkbox1.Enabled :=true;
            checkbox2.Enabled :=true;
            label9.Caption :='Db1';label9.Font.Color :=clred;
            label10.Caption :='Db2';label10.Font.Color :=clred;
            label16.Caption :='D8';label16.Font.Color :=clwindowtext;
            label15.Caption :='D7';label15.Font.Color :=clwindowtext;
            edit16.Text :=inttostr(strtoint('$'+edit5.Text)*256 +strtoint('$'+edit6.Text ));
        end;
        5:
        begin
            checkbox1.Enabled :=false;
            checkbox2.Enabled :=false;
            label9.Caption :='Sub';label9.Font.Color :=clred;
            label10.Caption :='B';label10.Font.Color :=clred;
            label16.Caption :='D8';label16.Font.Color :=clwindowtext;
            label15.Caption :='D7';label15.Font.Color :=clwindowtext;
        end;
        6:
        begin
            checkbox1.Enabled :=false;
            checkbox2.Enabled :=false;
            label9.Caption :='Sub';label9.Font.Color :=clred;
            label10.Caption :='C';label10.Font.Color :=clred;
            label16.Caption :='D8';label16.Font.Color :=clwindowtext;
            label15.Caption :='D7';label15.Font.Color :=clwindowtext;
        end;
        7:
        begin
            checkbox1.Enabled :=false;
            checkbox2.Enabled :=false;
            label9.Caption :='Sub';label9.Font.Color :=clred;
            label10.Caption :='E';label10.Font.Color :=clred;
            label16.Caption :='D8';label16.Font.Color :=clwindowtext;
            label15.Caption :='D7';label15.Font.Color :=clwindowtext;
        end
        else
        begin
            checkbox1.Enabled :=false;
            checkbox2.Enabled :=false;
            label9.Caption :='D10';label9.Font.Color :=clwindowtext;
            label10.Caption :='D9';label10.Font.Color :=clwindowtext;
            label16.Caption :='D8';label16.Font.Color :=clwindowtext;
            label15.Caption :='D7';label15.Font.Color :=clwindowtext;
        end;
    end;
    if checkbox3.Checked  and mscomm1.PortOpen and ((combobox3.ItemIndex =2) or (combobox3.ItemIndex =4))then
    begin
        button1.Click ;

    end;
    if(strtoint(edit16.Text)>18143)then
    begin
       timer1.Enabled :=false;
       checkbox3.Checked :=false;   
    end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if checkbox1.Checked  then checkbox2.Checked  :=false;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  if checkbox2.Checked  then checkbox1.Checked  :=false;

end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  if checkbox3.Checked   then
  begin
    button1.Enabled :=false;
    button5.Enabled :=false;
    button4.Enabled :=false;
    chlcount:=0;
    bcheckstart:=true;
  end
  else  if mscomm1.PortOpen then
  begin
    button1.Enabled :=true;
    button5.Enabled :=true;
    button4.Enabled :=true;

  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  ByteArray:array[0..13] of byte;
  i,j:integer;
    ovTmp:OleVariant;
    vTmp:Variant;
    ADDR:BYTE;
    bTmp,bTmp1:byte;
    bflagsuccess:boolean;
    FL,strrec:string;

begin
    SendBuffer[0]:=$53;
    SendBuffer[1]:=$0B;
    SendBuffer[2]:=$C3;
    SendBuffer[3]:=$00;
    SendBuffer[4]:=$00;
    SendBuffer[5]:=$00;
    SendBuffer[6]:=$00;
    SendBuffer[7]:=$00;
    SendBuffer[8]:=$00;
    SendBuffer[9]:=$00;
    SendBuffer[10]:=$00;
    SendBuffer[11]:=$00;
    SendBuffer[12]:=$32;
    SendBuffer[13]:=$45;

     vTmp:=VarArrayCreate([0,13],VarByte);
     for i:=0 to 13 do
     begin
          vTmp[i]:=SendBuffer[i];
     end;
     ovTmp:=vTmp;
     MSCOMM1.InputMode:=1;
     MSCOMM1.InBufferCount :=0;
     mscomm1.Output :=ovTmp;
     SLEEP(50);
     if(mscomm1.InBufferCount >=14)then
     BEGIN
        MSCOMM1.InputMode :=comInputModeBinary;
        ovTmp:=MSCOMM1.Input ;
        vTmp:=VarArrayCreate([0,13],varByte);
        vTmp:=ovTmp;
        strrec:='';
        for i:=0 to 13 do
        begin
           bTmp:=vTmp[i];
           ByteArray[I]:=bTmp;
           strrec:=strrec+format('%2.2x',[bTmp])+' ';
           if (i=3)then
           begin
              bTmp1:=bTmp;
              label22.Caption :='Sh='+format('%2.2X',[bTmp1])+'H';
              btmp1:=bTmp1 and $07;
              label26.Caption :='A2..0='+format('%2.2X',[bTmp1])+'H';
              btmp1:=btmp and $40;
              btmp1:=btmp1 shr 6;
              if(btmp1>0)then FL:='1'
              else FL:='0';

              strMidHighFreq:=strMidHighFreq+'__'+inttostr(bTmp)+ '  '+FL;
              btmp1:= btmp and $07;
              strMidHighFreq:=strMidHighFreq+' '+format('%2.2x',[bTmp1]);
              memo4.Lines.Add(strMidHighFreq);
           end;

        end;
        memo1.Lines.Add(strrec);
     END
     ELSE
     begin
        bflagsuccess:=false;
        showmessage('无返回数据，请检查线路和端口设置后重试。');
        exit;
     end;

end;

procedure TForm1.Edit16Change(Sender: TObject);
var
  tmp:byte;
  tmp1:integer;
begin
  if (strtoint(edit16.Text ) <65536)  and (edit16.Text<>'')then 
  begin
      tmp:=hi(strtoint(edit16.Text ));
      edit5.Text :=format('%2.2X',[tmp]);
      tmp:=lo(strtoint(edit16.Text ));
      edit6.Text :=format('%2.2X',[tmp]);
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  if  savedialog1.Execute then
  begin
      memo2.Lines.SaveToFile(savedialog1.Files.CommaText);
  end;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  if  savedialog1.Execute then
  begin
      memo3.Lines.SaveToFile(savedialog1.Files.CommaText);
  end;end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  memo2.Clear ;
  memo3.Clear ;
  memo4.Clear ;
end;

procedure TForm1.Edit16Click(Sender: TObject);
begin
  edit16.SelectAll ;
end;

end.