AKI-RS232C ラインモニターキット用モニタソフト 2018/02/23
2018/03/04 Delphi ソースコードを追加
2018/03/03 キット＋USB 変換モジュールの画像を追加
秋月電子通商のラインモニタキット （￥3,600）（http://akizukidenshi.com/catalog/g/gK-00045/）用のツールです。
■ FT232RL USB/RS232C 変換モジュール（￥1,400.）（http://akizukidenshi.com/catalog/g/gK-01798/）を合体。パソコンへの接続を USB に変更。
赤色の配線は、+5V の電源供給です。
■ 専用のモニタソフト (Winodws98/95用 )が付属されていますが、自分用に作ってみました。
付属のモニタソフトと同様に、モニタ表示はリアルタイムではありません。
「モニタ開始」→「モニタ終了」または1024バイト受信→モニタ結果表示 になります。
Windows 8.1 (64bit) にて、動作を確認しています。
■ソースコード
※シリアル通信には、CPortLib コンポーネントを使っています。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, CPort, Vcl.StdCtrls, Vcl.Grids, CPortCtl,
IniFiles;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
ComPort1: TComPort;
Button2: TButton;
Label1: TLabel;
Button3: TButton;
StringGrid1: TStringGrid;
Button4: TButton;
ComboBox1: TComboBox;
Label2: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
Label3: TLabel;
ComComboBox1: TComComboBox;
Label4: TLabel;
ComboBox2: TComboBox;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
procedure ComPort1RxChar(Sender: TObject; Count: Integer);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
TRxData = record
RxTime : Cardinal;
RxChar : AnsiChar;
end;
var
Form1: TForm1;
RxDataAry : array of TRxData;
RxDataCount : integer;
GTicks : Cardinal;
GCmdMode : integer;
GStr : string;
SeigyoCode : array of string = [
'NUL', 'SOH', 'STX', 'ETX', 'EOT', 'ENQ', 'ACK', 'BEL', 'BS', 'HT',
'LF', 'VT', 'FF', 'CR', 'SO', 'SI', 'DLE', 'DC1', 'DC2', 'DC3',
'DC4', 'NAK', 'SYN', 'ETB', 'CAN', 'EM', 'SUB', 'ESC', 'FS', 'GS',
'RS', 'US'];
const
DEL = $7E;
implementation
{$R *.dfm}
function Ratemesure: string;
var
DataCount : integer;
Baud : array [0..99] of integer;
m, n : integer;
BaudRate : integer;
bps : string;
begin
result := '';
if GStr.Length > 100 then begin
DataCount := GStr.Length;
m :=0;
for n := 0 to DataCount div 2 - 1 do begin
Baud[m] := Ord(GStr[n * 2 + 2]);
Baud[m] := Baud[m] * 256;
Baud[m] := Baud[m] + Ord(GStr[n * 2 + 1]) + 15;
Baud[m] := Trunc(Baud[m] * 108.459); // nsec 108.459=1/9.22MHz
Inc(m);
if m = 100 then Break;
end;
BaudRate := 5000000; // nsec
for n := 0 to 50 -1 do begin
if Baud[n] <> 0 then begin
if Baud[n] < BaudRate then BaudRate := Baud[n];
end;
end;
if (3333332 * 0.85 < BaudRate) and (BaudRate < 3333332 * 1.15) then bps := '300bps'
else if (1666666 * 0.85 < BaudRate) and (BaudRate < 1666666 * 1.15) then bps := '600bps'
else if ( 833333 * 0.85 < BaudRate) and (BaudRate < 833333 * 1.15) then bps := '1200bps'
else if ( 416666 * 0.85 < BaudRate) and (BaudRate < 416666 * 1.15) then bps := '2400bps'
else if ( 208332 * 0.85 < BaudRate) and (BaudRate < 208332 * 1.15) then bps := '4800bps'
else if ( 104166 * 0.85 < BaudRate) and (BaudRate < 104166 * 1.15) then bps := '9600bps'
else if ( 69444 * 0.85 < BaudRate) and (BaudRate < 69444 * 1.15) then bps := '14400bps'
else if ( 52083 * 0.85 < BaudRate) and (BaudRate < 52083 * 1.15) then bps := '19200bps'
else if ( 34722 * 0.85 < BaudRate) and (BaudRate < 34722 * 1.15) then bps := '28800ps'
else if ( 26041 * 0.85 < BaudRate) and (BaudRate < 26041 * 1.15) then bps := '38400bps'
else if ( 17361 * 0.85 < BaudRate) and (BaudRate < 17361 * 1.15) then bps := '57600bps'
else if ( 8680 * 0.85 < BaudRate) and (BaudRate < 8680 * 1.15) then bps := '115200bps'
else if ( 4340 * 0.85 < BaudRate) and (BaudRate < 4340 * 1.15) then bps := '230400bps'
else if ( 2170 * 0.85 < BaudRate) and (BaudRate < 2170 * 1.15) then bps := '460800bps'
else if ( 1085 * 0.85 < BaudRate) and (BaudRate < 1085 * 1.15) then bps := '921600bps';
result := bps;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
str : string;
i, j :integer;
begin
with ComPort1 do begin
BaudRate:= br115200;
DataBits := dbEight;
StopBits := sbOneStopBit;
Open;
if Connected then begin
if ComboBox1.ItemIndex >= 0 then begin
Button1.Enabled := False;
Button2.Enabled := True;
Button3.Enabled := False;
WriteStr(ComboBox1.ItemIndex.Tostring); // 9600bps
Sleep(100);
WriteStr('V');
Sleep(100);
ReadStr(str, 1024);
Edit1.Text := str;
if CheckBox1.Checked then
WriteStr('d')
else
WriteStr('D');
Sleep(100);
case ComboBox2.ItemIndex of
0 : WriteStr('G'); // 双方向
1 : WriteStr('A');
2 : WriteStr('B');
end;
with StringGrid1 do begin
for i := 1 to ColCount -1 do begin
for j := 0 to RowCount - 1 do begin
Cells[i, j] := '';
end;
end;
end;
RxDataCount := 0;
GTicks := GetTickCount;
end;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if ComPort1.Connected then begin
Button1.Enabled := True;
Button2.Enabled := False;
Button3.Enabled := True;
ComPort1.WriteStr('E');
if GCmdMode = 0 then
Button3Click(self);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
i : integer;
n, m : integer;
c : AnsiChar;
j : integer;
k : integer;
begin
j := 1;
for i := 0 to RxDataCount div 2 -1 do begin
if RxDataAry[i*2].RxTime - GTicks >= 200 then begin
StringGrid1.Cells[j, 1] := IntToStr(RxDataAry[i*2].RxTime - GTicks);
GTicks := RxDataAry[i*2].RxTime;
StringGrid1.ColCount := StringGrid1.ColCount + 1;
Inc(j);
end;
n := Ord(RxDataAry[i * 2].RxChar);
m := Ord(RxDataAry[i * 2 + 1].RxChar);
if (n shr 4 = $A) and (m shr 4 = $B) then begin
c := AnsiChar(n shl 4 + m and $0F);
k := Ord(c);
with StringGrid1 do begin
Cells[j, 2] := IntToHex(Ord(c), 2);
if k < $20 then
Cells[j, 3] := SeigyoCode[Ord(c)]
else if k = DEL then
Cells[j, 3] := 'DEL'
else if k < DEL then
Cells[j, 3] := string(c)
else
Cells[j, 3] := '.';
Cells[j, 0] := IntToStr(i+1);
end;
Inc(j);
end
else if (n shr 4 = $8) and (m shr 4 = $9) then begin
c := AnsiChar(n shl 4 + m and $0F);
k := Ord(c);
with StringGrid1 do begin
Cells[j, 4] := IntToHex(Ord(c), 2);
if k < $20 then
Cells[j, 5] := SeigyoCode[Ord(c)]
else if k = DEL then
Cells[j, 5] := 'DEL'
else if k < DEL then
Cells[j, 5] := string(c)
else
Cells[j, 5] := '.';
Cells[j, 0] := IntToStr(i+1);
end;
Inc(j);
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
str : string;
begin
with ComPort1 do begin
if Button4.Caption <> '計測中止' then begin
if Button1.Enabled then begin
BaudRate := br115200;
DataBits := dbEight;
StopBits := sbOneStopBit;
Open;
if Connected then begin
Button1.Enabled := False;
Label1.Caption := 'ボーレート計測中...';
Button4.Caption := '計測中止';
WriteStr('V');
Sleep(100);
ReadStr(str, 1024);
Edit1.Text := str;
RxDataCount := 0;
GStr := '';
WriteStr('M'); //
GCmdMode := 101;
end;
end;
end
else begin
if Connected then begin
WriteStr('E');
GCmdMode := 0;
Label1.Caption := 'ボーレート計測中止';
Button4.Caption := 'ボーレート計測';
Button1.Enabled := True;
end;
end;
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
CheckBox2.Checked := not CheckBox1.Checked;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
CheckBox1.Checked := not CheckBox2.Checked;
end;
procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
var
str : string;
i : integer;
Ticks : Cardinal;
begin
ComPort1.ReadStr(str, Count);
if GCmdMode = 101 then begin
GStr := GStr + str;
Label1.Caption := IntToStr(RxDataCount);
RxDataCount := RxDataCount + str.Length;
if RxDataCount > 100 then begin
Label1.Caption := IntToStr(RxDataCount);
ComPort1.WriteStr('E');
GCmdMode := 0;
ShowMessage(Ratemesure);
Label1.Caption := Ratemesure;
Button4.Caption := 'ボーレート計測';
Button1.Enabled := True;
end;
end
else begin
Ticks := GetTickCount;
if RxDataCount < 1024 then begin
Label1.Caption := IntToStr(RxDataCount);
for i := 1 to str.Length do begin
RxDataAry[RxDataCount].RxTime := Ticks;
RxDataAry[RxDataCount].RxChar := AnsiChar(str[i]);
Inc(RxDataCount);
if RxDataCount >= 1024 then begin
Label1.Caption := IntToStr(RxDataCount);
Button3.Enabled := True;
Button2Click(self);
Break;
end;
end;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
ini : TIniFile;
begin
Comport1.StoreSettings(TStoreType.stIniFile, ChangeFileExt(ParamStr(0), '.ini'));
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
with StringGrid1 do begin
ini.WriteInteger('StringGrid', 'ColWidth', DefaultColWidth);
ini.WriteInteger('StringGrid', 'RowHeight', DefaultRowHeight);
end;
ini.WriteBool('CheckBox', '8Bit', CheckBox1.Checked);
ini.WriteBool('CheckBox', '8+1Bit', CheckBox2.Checked);
ini.WriteInteger('ComboBox', 'MoniBaudRate', ComboBox1.ItemIndex);
ini.WriteInteger('ComboBox', 'MoniHoukou', ComboBox2.ItemIndex);
finally
ini.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ini : TIniFile;
begin
Setlength(RxDataAry, 1024);
RxDataCount := 0;
Edit1.Text := '';
Label1.Caption := '';
Comport1.LoadSettings(TStoreType.stIniFile, ChangeFileExt(ParamStr(0), '.ini'));
ComComboBox1.Text := ComPort1.Port;
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
with StringGrid1 do begin
DefaultColWidth := ini.ReadInteger('StringGrid', 'ColWidth', DefaultColWidth);
DefaultRowHeight := ini.ReadInteger('StringGrid', 'RowHeight', DefaultRowHeight);
end;
CheckBox1.Checked := ini.ReadBool('CheckBox', '8Bit',True);
CheckBox2.Checked := ini.ReadBool('CheckBox', '8+1Bit',False);
ComboBox1.ItemIndex := ini.ReadInteger('ComboBox', 'MoniBaudRate', 4);
ComboBox2.ItemIndex := ini.ReadInteger('ComboBox', 'MoniHoukou', 0);
finally
ini.Free;
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
ARect,BRect : TRect;
s : string;
n : integer;
begin
ARect := Rect;
BRect := Rect;
ARect.Top := Rect.Top + 1;
ARect.Bottom := Rect.Bottom - 1;
ARect.Left := Rect.Left;
ARect.Right := Rect.Right - 1;
BRect.Top := Rect.Top + 5;
BRect.Bottom := Rect.Bottom - 1;
BRect.Left := Rect.Left+1;
BRect.Right := Rect.Right - 1;
with StringGrid1 do begin
if (ARow = 0) or (ACol = 0) then begin
if ((ARow = 2) or (ARow = 3)) and (ACol = 0) then begin
Canvas.Brush.Color := clLime;//$00D6D6D6;
Canvas.Pen.Color := clWhite;//Green;//Black;
Canvas.RoundRect(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom,8,8);
Canvas.Font.Height := 16;
Canvas.Font.Color := clBlack;
end
else if ((ARow = 4) or (ARow = 5)) and (ACol = 0) then begin
Canvas.Brush.Color := clSkyBlue;//Aqua;//$00D6D6D6;
Canvas.Pen.Color := clWhite;//Blue;//Black;
Canvas.RoundRect(ARect.Left,ARect.Top,ARect.Right,AREct.Bottom,8,8);
Canvas.Font.Height := 16;
Canvas.Font.Color := clBlack;
end
else if (ARow = 1) and (ACol = 0) then begin
Canvas.Brush.Color := clBtnFace;
Canvas.Pen.Color := clWhite;//Blue;//Black;
Canvas.RoundRect(ARect.Left,ARect.Top,ARect.Right,AREct.Bottom,8,8);
Canvas.Font.Height := 16;
Canvas.Font.Color := clBlack;
end
else begin
Canvas.Brush.Color := clBtnFace;//$00D6D6D6;
Canvas.FillRect(Rect);
Canvas.Font.Height := 13;
Canvas.Font.Color := clGray;
end;
DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]),
Length(Cells[ACol,ARow]),
BRect, DT_CENTER); // DT_CENTERがセンタリング指定
end
else begin
if (ARow = 1) and (ACol > 0) then begin
s := Cells[ACol, ARow];
if s <> '' then begin
Canvas.Brush.Color := clSilver;
Canvas.FillRect(ARect);
Canvas.Font.Height := 13;
Canvas.Font.Color := clBlack;
Canvas.TextOut(ARect.Left+1,ARect.Top+3, Cells[ACol,ARow]);
end;
end
else if (ARow = 3) and (ACol > 0) then begin
s := Cells[ACol, 2];
if s <> '' then begin
n := StrToInt('$'+ s);
if (n < $20) or (n = DEL) then begin
Canvas.Brush.Color := clRed;
Canvas.FillRect(ARect);
Canvas.Font.Color := clWhite;
end
else if (n > DEL) then begin
Canvas.Brush.Color := clYellow;
Canvas.FillRect(ARect);
end
else begin
Canvas.Brush.Color := $0000FF80;//clGreen;//clMoneyGreen;//Lime;
Canvas.FillRect(ARect);
end;
DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]),
Length(Cells[ACol,ARow]),
BRect, DT_CENTER); // DT_CENTERがセンタリング指定
end;
end
else if (ARow = 5) and (ACol > 0) then begin
s := Cells[ACol, 4];
if s <> '' then begin
n := StrToInt('$'+ s);
if (n < $20) or (n = DEL) then begin
Canvas.Brush.Color := clRed;
Canvas.FillRect(ARect);
Canvas.Font.Color := clWhite;
end
else if (n > DEL) then begin
Canvas.Brush.Color := clYellow;
Canvas.FillRect(ARect);
end
else begin
Canvas.Brush.Color := clSkyBlue;//Aqua;
Canvas.FillRect(ARect);
end;
DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]),
Length(Cells[ACol,ARow]),
BRect, DT_CENTER); // DT_CENTERがセンタリング指定
end;
end;
end;
end;
end;
end.
■開発環境
Delphi 10.1 Professional / Windows 8.1 (64bit)
■ダウンロード
ダウンロード（EXE本体のみ）
※アイコンは、作成していません。Delphi デフォルトのままです。