ucomtest.pas

此串口调试程序加入了三菱PLC通讯调试

 Exit;
End;
N:=Length(S);
B:=nil;
StrG2.RowCount:=2;
StrG2.Rows[1].Clear;
SetLength(B,N);
CopyMemory(@B[0],@S[1],N);
R:=1;C:=1;
StrG2.Cells[0,1]:='0000';
For I:=0 To N-1 do
  Begin
    StrG2.Cells[C,R]:=IntToHex(B[I],2);
    if C mod 16=0 Then
    Begin
     StrG2.Rows[R+1].Clear;    
     StrG2.Cells[0,R+1]:=IntToHex(R*16,4);
     Inc(R);
     C:=1;
     StrG2.RowCount:=R+1;
    End Else Inc(C);
  End;

end;

procedure TForm1.Chb1Click(Sender: TObject);
begin
if Chb1.Checked Then
Begin
MSComm1.RThreshold:=1;
MSComm1.OnComm:=MSComm1Comm;
End Else
Begin
 MSComm1.RThreshold:=0;
 MSComm1.OnComm:=nil;
End;
B3.Enabled:=Not ChB1.Checked;
end;

procedure TForm1.StrG2KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#8 Then Exit;
if ((Key>='0')and(Key<='9'))
 or((Key>='A')and(Key<='F'))
 or((Key>='a')and(Key<='f'))
 Then Exit Else Key:=#0;
end;

procedure TForm1.MSComm1Comm(Sender: TObject);
begin
M1.Text:=M1.Text+MSComm1.Input;
end;

procedure TForm1.M1Change(Sender: TObject);
Var
    B:Array of Byte;
    S:String;
    I,N,R,C:Integer;
begin
S:=M1.Text;
if S='' Then
Begin
  StrG1.RowCount:=2;
  StrG1.Rows[1].Clear;
  Exit;
End;
N:=Length(S);
SetLength(B,N);
CopyMemory(@B[0],@S[1],N);
R:=1;C:=1;
StrG1.Cells[0,1]:='0000';
For I:=0 To N-1 do
  Begin
    StrG1.Cells[C,R]:=IntToHex(B[I],2);
    if C mod 16=0 Then
    Begin
     StrG1.Rows[R+1].Clear;
     StrG1.Cells[0,R+1]:=IntToHex(R*16,4);
     Inc(R);
     C:=1;
     StrG1.RowCount:=R+1;
    End Else Inc(C);
  End;

end;

procedure TForm1.CPortChange(Sender: TObject);
begin
BOpen.Enabled:=CPort.Text<>'';
BOnLine.Enabled:=BOpen.Enabled;
end;

procedure TForm1.FXB0Click(Sender: TObject);
begin
PanFX.Visible:=Not PanFx.Visible;
end;

procedure TForm1.FXEd2KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#8 Then Exit;
if (Key<'0')or(Key>'9') Then Key:=#0;
end;

procedure TForm1.FXEd1Change(Sender: TObject);
Var S:String;
begin
S:=FxEd1.Text;
FxB1.Enabled:=(Length(S)>1)and(FxEd2.Text<>'')and(FxEd3.Text<>'')and(FxEd4.Text<>'')
              and MSComm1.PortOpen;
FxB2.Enabled:=(Length(S)>1)and(FxEd2.Text<>'')and(FxEd3.Text<>'')and(FxEd4.Text<>'')
              and(Trim(StrG3.Cols[0].Text)<>'') and MSComm1.PortOpen;
if S='' Then Exit;
Case S[1] of
'D':RG1.ItemIndex:=1;
'M','S','X','Y':RG1.ItemIndex:=0;
End;
end;

procedure TForm1.FxB1Click(Sender: TObject);
Var SLDat:SanLingDat;
    S1,S:String;
    L:Integer;
begin
S:=UpperCase(FxEd1.Text);
if S='' Then Exit;
M1.Text:='';
Case S[1] of
'C','D','M','S','T','X','Y':;
Else Begin
      MessageBox(Handle,'设备名非法','错误',16);
      Exit;
     End;
End;
L:=Length(S);
if L<5 Then
Begin
S1:=Copy(S,2,L-1);
Try
  StrToInt(S1);
Except
//raise
      MessageBox(Handle,'设备编号非法','错误',16);
      Exit;
End;
S1:=Copy('0000',1,4-Length(S1))+S1;
S1:=S[1]+S1;
End;

SLDat.Comm:=MSComm1;
SLDat.StationNo:=StrToIntDef(FxEd3.Text,0);//$00
SLDat.PC_No:=StrToIntDef(FxEd4.Text,255);//$FF
SLDat.DeviceName:=S1;
SLDat.Len:=StrToIntDef(FxEd2.Text,1);
SLDat.WaitTime:=SpinE1.Value;
SLDat.DeviceType:=RG1.ItemIndex;
SLDat.ProtocolType:=RG2.ItemIndex;
SLDat.Comm.Input;
ReadPLC(SLDat);
//Sleep(100);
//B3Click(self);
end;

procedure TForm1.FXB2Click(Sender: TObject);
Var SLDat:SanLingDat;
    S1,S:String;
    L,I:Integer;
    WS:String;
begin
S:=UpperCase(FxEd1.Text);
M1.Text:='';
if S='' Then Exit;
Case S[1] of
'C','D','M','S','T','X','Y':;
Else Begin
      MessageBox(Handle,'设备名非法','错误',16);
      Exit;
     End;
End;
L:=Length(S);
if L<5 Then
Begin
S1:=Copy(S,2,L-1);
Try
  StrToInt(S1);
Except
//raise
      MessageBox(Handle,'设备编号非法','错误',16);
      Exit;
End;
S1:=Copy('0000',1,4-Length(S1))+S1;
S1:=S[1]+S1;
End;

SLDat.Comm:=MSComm1;
SLDat.DeviceName:=S1;

SLDat.StationNo:=StrToIntDef(FxEd3.Text,0);//$00
SLDat.PC_No:=StrToIntDef(FxEd4.Text,255);//$FF

SLDat.Len:=StrToIntDef(FxEd2.Text,1);
SLDat.WaitTime:=SpinE1.Value;
SLDat.DeviceType:=RG1.ItemIndex;
SLDat.ProtocolType:=RG2.ItemIndex;

   WS:='';
    For I:=0 To SLDat.Len-1 do
     Begin
      S:=StrG3.Cells[0,I];
      if S='' Then
      Begin
       if MessageBox(Handle,PChar('第 '+IntToStr(I+1)+' 个数据是空白数据!'#13#10#10+
       '继续运行以默认值0处理,'#10'否则将终止此项工作。'#13#10#10'继续吗？'),'警告',36)<>6 Then Exit;
       S:='0';
      End;
      L:=StrToIntDef(S,0);
      if RG1.ItemIndex<>0 Then
       Begin
       if L<0 Then L:=65536+L;
       if L>65535 Then
        Begin

       if MessageBox(Handle,PChar('第 '+IntToStr(I+1)+' 个数据 '+S+' 溢出!'#13#10#10+
       '继续运行以默认值65535处理,'#10'否则将终止此项工作。'#13#10#10'继续吗？'),'警告',36)<>6 Then Exit;

          L:=65535;
        End;
       S:=IntToHex(L,4);
       End;
      WS:=WS+S;
     End;

SLDat.WritData:=WS;

WritePLC(SLDat);
end;

procedure TForm1.StrG3KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#8 Then Exit;
if RG1.ItemIndex=0 Then
Begin
 if (Key<>'0')and(Key<>'1') Then Key:=#0;
End Else
Begin
if Key='-' Then Exit;
 if (Key<'0')or(Key>'9') Then Key:=#0;
End;

end;

procedure TForm1.StrG3SetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: String);
begin
if RG1.ItemIndex=0 Then
Begin
 if Length(Value)>1 Then StrG3.Cells[ACol,ARow]:=Value[1];
End 
Else
 if Length(Value)>5 Then StrG3.Cells[ACol,ARow]:=Copy(Value,1,5);

end;

procedure TForm1.FXEd2Change(Sender: TObject);
begin
StrG3.RowCount:=StrToIntDef(FxEd2.Text,1);
FxB1.Enabled:=(Length(FxEd1.Text)>1)and(FxEd2.Text<>'')and(FxEd3.Text<>'')and(FxEd4.Text<>'')
              and MSComm1.PortOpen;
FxB2.Enabled:=(Length(FxEd1.Text)>1)and(FxEd2.Text<>'')and(FxEd3.Text<>'')and(FxEd4.Text<>'')
              and(Trim(StrG3.Cols[0].Text)<>'') and MSComm1.PortOpen;

end;

procedure TForm1.RG1Click(Sender: TObject);
Var I,N:Integer;
    S:String;
begin
S:=FxEd1.Text;
if S<>'' Then
Case S[1] of
'D':RG1.ItemIndex:=1;
'M','S','X','Y':RG1.ItemIndex:=0;
End;


 if RG1.ItemIndex=0 Then
 Begin
  For I:=0 To StrG3.RowCount-1 do
  Begin
   N:=StrToIntDef(StrG3.Cells[0,I],0);
   if N>1 Then
    Begin
      N:=N and $1;
     StrG3.Cells[0,I]:=IntToStr(N);
    End;
  End;
 End;
end;

procedure TForm1.StrG3DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
FxB2.Enabled:=(FxEd1.Text<>'')and(FxEd2.Text<>'')and
              (Trim(StrG3.Cols[0].Text)<>'') and MSComm1.PortOpen;
end;

procedure TForm1.FXEd1KeyPress(Sender: TObject; var Key: Char);
Var S:String;
begin
if Key=#8 Then Exit;
S:=FxEd1.Text;
if S='' Then S:=Key;
S:=UpperCase(S);
Case S[1] of
 'C','D','M','S','T','X','Y':
 Begin
  if FxEd1.Text='' Then Exit;
  if (Key>='0')and(Key<='9') Then Exit Else Key:=#0;
 End;
 Else Key:=#0;

End;

end;

procedure TForm1.FxEd3Change(Sender: TObject);
begin
FxB1.Enabled:=(FxEd1.Text<>'')and(FxEd2.Text<>'')and(FxEd3.Text<>'')and(FxEd4.Text<>'')
              and MSComm1.PortOpen;
FxB2.Enabled:=(FxEd1.Text<>'')and(FxEd2.Text<>'')and(FxEd3.Text<>'')and(FxEd4.Text<>'')
              and(Trim(StrG3.Cols[0].Text)<>'') and MSComm1.PortOpen;
end;

procedure TForm1.BOnLineClick(Sender: TObject);
begin
Case CommDeviceOnLine(CPort.Text) of
-1:ShowMessage('端口 '+CPort.Text+' 不存在或已被占用');
 0:ShowMessage('端口 '+CPort.Text+' 上连接有设备');
 1:ShowMessage('端口 '+CPort.Text+' 上未连接设备或设备电源未打开');
End;

end;

procedure TForm1.BCLRClick(Sender: TObject);
begin
M1.Text:='';
StrG1.RowCount:=2;
StrG1.Rows[1].Clear;
MSComm1.Input;
end;

end.