?? co_main.~pas
字號:
unit Co_Main;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, CPort, StdCtrls,
IniFiles, Syncobjs, ComCtrls, ImgList, Buttons, ToolWin, ExtCtrls,
TriggerUtil,Dialogs;
const
sVerInfo = '串口測試程序 Ver1.0';
cmdBuffCapacity = 100;
type
TFrm_Main = class(TForm)
Panel1: TPanel;
ToolBar1: TToolBar;
btn_Open: TToolButton;
btn_Close: TToolButton;
btn_Clear: TToolButton;
btn_Exit: TToolButton;
TitleImageList: TImageList;
btn_Trigger: TToolButton;
ToolButton1: TToolButton;
ToolButton3: TToolButton;
sb: TStatusBar;
Panel2: TPanel;
Panel3: TPanel;
Label1: TLabel;
Label2: TLabel;
Combo_Port: TComboBox;
Combo_BaudRate: TComboBox;
GroupBox1: TGroupBox;
CB_RTS: TCheckBox;
CB_DTR: TCheckBox;
GroupBox2: TGroupBox;
CB_CRLF: TCheckBox;
CB_Hex: TCheckBox;
Panel4: TPanel;
Splitter1: TSplitter;
Pc_Info: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
ComPort: TComPort;
Panel5: TPanel;
btn_Send: TSpeedButton;
Panel6: TPanel;
CB_CMD: TComboBox;
btn_ClearCmd: TToolButton;
Label3: TLabel;
Mem_Hex: TMemo;
Mem_Text: TMemo;
Mem_Info: TMemo;
Label4: TLabel;
Cb_DataBits: TComboBox;
Label5: TLabel;
CB_StopBits: TComboBox;
Label6: TLabel;
Cb_ParityBits: TComboBox;
tbAutoSend: TToolButton;
TimerAutoSend: TTimer;
tbByteSend: TToolButton;
TimerByteSend: TTimer;
procedure Combo_BaudRateChange(Sender: TObject);
procedure Combo_PortChange(Sender: TObject);
procedure CB_RTSClick(Sender: TObject);
procedure CB_DTRClick(Sender: TObject);
procedure Btn_ExitClick(Sender: TObject);
procedure Btn_OpenClick(Sender: TObject);
procedure Btn_CloseClick(Sender: TObject);
procedure Btn_SendClick(Sender: TObject);
procedure Btn_ClearClick(Sender: TObject);
procedure ComPortTxEmpty(Sender: TObject);
procedure ComPortRxChar(Sender: TObject; Count: Integer);
procedure ComPortError(Sender: TObject; Errors: TComErrors);
procedure ComPortDSRChange(Sender: TObject; OnOff: Boolean);
procedure ComPortCTSChange(Sender: TObject; OnOff: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ComPortAfterOpen(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Panel1Resize(Sender: TObject);
procedure btn_ClearCmdClick(Sender: TObject);
procedure CB_CMDKeyPress(Sender: TObject; var Key: Char);
procedure btn_TriggerClick(Sender: TObject);
procedure Cb_DataBitsChange(Sender: TObject);
procedure CB_StopBitsChange(Sender: TObject);
procedure Cb_ParityBitsChange(Sender: TObject);
procedure ComPortAfterClose(Sender: TObject);
procedure tbAutoSendClick(Sender: TObject);
procedure TimerAutoSendTimer(Sender: TObject);
procedure tbByteSendClick(Sender: TObject);
procedure TimerByteSendTimer(Sender: TObject);
private
{ Private declarations }
LineData: string;
TriggerBuff: string;
Inis: TIniFile;
FTrigger: TTrigger;
FTriggerFileName: string;
con: Boolean;
FAutoSend:Boolean;
FAutoIntervel:Cardinal;
procedure SetCommStatus;
procedure LinkToTrigger(var buf: string);
public
{ Public declarations }
end;
var
Frm_Main: TFrm_Main;
implementation
uses Trigger, dlgByteSend, UnitPublic;
{$R *.DFM}
function StrToDataBits(str: string): TDataBits;
begin
str := Trim(Str);
if str = '5' then Result := dbFive
else if str = '6' then Result := dbSix
else if str = '7' then Result := dbSeven
else Result := dbEight;
end;
function DataBitsToStr(Bits: TDataBits): string;
begin
case Bits of
dbFive: Result := '5';
dbSix: Result := '6';
dbSeven: Result := '7';
else Result := '8';
end;
end;
function StrToStopBits(str: string): TStopBits;
begin
str := Trim(Str);
if Str = '1' then Result := sbOneStopBit
else if Str = '1.5' then Result := sbOne5StopBits
else Result := sbTwoStopBits;
end;
function StopBitsToStr(Bits: TStopBits): string;
begin
Case Bits of
sbOneStopBit: Result := '1';
sbOne5StopBits: Result := '1.5';
else Result := '2';
end;
end;
function StrToParityBits(str: string): TParityBits;
begin
str := UpperCase(Trim(str));
if str = 'EVEN' then Result := prEven
else if str = 'MARK' then Result := prMark
else if str = 'SPACE' then Result := prSpace
else if str = 'NONE' then Result := prNone
else Result := prOdd;
end;
function ParityBitsToStr(Bits: TParityBits): string;
begin
case Bits of
prEven: Result := 'EVEN';
prMark: Result := 'MARK';
prSpace: Result := 'SPACE';
prNone: Result := 'NONE';
prOdd: Result := 'ODD';
end;
end;
procedure TFrm_Main.Combo_BaudRateChange(Sender: TObject);
begin
con := ComPort.Connected;
ComPort.Connected := False;
ComPort.BaudRate := TBaudRate(Combo_BaudRate.ItemIndex + 1);
ComPort.Connected := Con;
end;
procedure TFrm_Main.Combo_PortChange(Sender: TObject);
begin
Con := ComPort.Connected;
ComPort.Connected := False;
ComPort.Port := Combo_Port.Text;
ComPort.Connected := Con;
end;
procedure TFrm_Main.CB_RTSClick(Sender: TObject);
begin
if ComPort.Connected then
ComPort.SetRTS(CB_RTS.Checked);
end;
procedure TFrm_Main.CB_DTRClick(Sender: TObject);
begin
if ComPort.Connected then
ComPort.SetDTR(CB_DTR.Checked);
end;
procedure TFrm_Main.Btn_ExitClick(Sender: TObject);
begin
Close;
end;
procedure TFrm_Main.Btn_OpenClick(Sender: TObject);
begin
if ComPort.Connected then Exit;
try
ComPort.Port := Combo_Port.Text;
ComPort.BaudRate := TBaudRate(Combo_BaudRate.ItemIndex + 1);
ComPort.Open;
tbAutoSend.Enabled :=true;
except
MessageBox(Handle, PChar('無法打開端口' + ComPort.Port), '錯誤', MB_OK + MB_ICONError);
end;
SetCommStatus;
end;
procedure TFrm_Main.Btn_CloseClick(Sender: TObject);
begin
if ComPort.Connected then
begin
tbAutoSend.Enabled :=false;
ComPort.Close;
end;
SetCommStatus;
end;
procedure TFrm_Main.Btn_SendClick(Sender: TObject);
var
DataStr: string;
i, Idx: Integer;
cmd: string;
begin
SB.Panels[0].Text := '';
if not ComPort.Connected then Exit;
DataStr := '';
cmd := CB_CMD.Text;
if length(cmd) = 0 then Exit;
if CB_Hex.Checked then
begin
if (Length(cmd) mod 2) <> 0 then
begin
MessageBox(Handle, '要發送的數據長度錯誤。十六進制數據長度必須為雙數', '錯誤', MB_OK + MB_ICONError);
Exit;
end;
for i := 1 to Length(cmd) do
if not (cmd[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
begin
MessageBox(Handle, '數據內容錯誤。十六進制數據必須為0..9, A..F', '錯誤', MB_OK + MB_ICONError);
Exit;
end;
for i := 0 to (Length(cmd) div 2) - 1 do
begin
DataStr := DataStr + Chr(StrToInt('$' + Copy(cmd, i * 2 + 1, 2)));
end;
end
else
DataStr := cmd;
if CB_CRLF.Checked then
DataStr := DataStr + #$0D;
ComPort.WriteStr(DataStr);
Idx := CB_CMD.Items.IndexOf(CMD);
if Idx = -1 then
begin
CB_CMD.Items.Insert(0, CMD);
if CB_CMD.Items.Count > cmdBuffCapacity then
for i := cmdBuffCapacity + 1 to CB_CMD.Items.Count do
CB_CMD.Items.Delete(cmdBuffCapacity);
end
else
Cb_Cmd.Items.Move(Idx, 0);
end;
procedure TFrm_Main.Btn_ClearClick(Sender: TObject);
begin
Mem_Info.Lines.Clear;
Mem_Hex.Clear;
Mem_Text.Clear;
end;
procedure TFrm_Main.ComPortTxEmpty(Sender: TObject);
begin
Sb.Panels[0].Text := '◆ 發送完畢';
end;
function FmtNow: string;
begin
Result := FormatDateTime('hh:nn:ss zzz ', Now);
end;
procedure TFrm_Main.ComPortRxChar(Sender: TObject; Count: Integer);
type
CharBuf = array[0..9999] of Char;
var
Buffer: ^CharBuf;
Bytes, P: Integer;
dats: string;
begin
Sb.Panels[0].Text := '√ 收到數據';
GetMem(Buffer, Count);
try
Fillchar(Buffer^, Count, 0);
Bytes := ComPort.Read(Buffer^, Count);
dats := '';
for P := 0 to Bytes - 1 do
begin
Dats := Dats + IntToHex(Ord(CharBuf(Buffer^)[P]), 2);
TriggerBuff := TriggerBuff + Buffer^[P];
case Buffer^[P] of
#0, #10: ;
#13:
begin
Mem_Text.Lines.Add(FmtNow + LineData);
LineData := '';
end;
else
LineData := LineData + CharBuf(Buffer^)[P];
end;
end;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -