?? commmain.pas
字號:
//*********************************************************
// Kaersoft 卡爾軟件
// *************************************
// http://www.kaer.cn/default.aspx
// Email:Sdwhxyr@YEAH.NET
// QQ:54076683
// Delphi 7.0 PASS
//**********************************************************
unit commmain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OoMisc, AdPort, StdCtrls, ExtCtrls, ComCtrls, AdStatLt,IniFiles,
Menus;
type
TMainForm = class(TForm)
ComPort1: TApdComPort;
Panel1: TPanel;
SendMemo: TMemo;
Panel2: TPanel;
Panel3: TPanel;
Btn_Send: TButton;
Btn_ClearView: TButton;
StatusBar: TStatusBar;
Btn_SaveView: TButton;
Panel4: TPanel;
CB_StopBits: TComboBox;
Label3: TLabel;
Label5: TLabel;
CB_DataBits: TComboBox;
CB_Parity: TComboBox;
Label4: TLabel;
Label2: TLabel;
CB_Baud: TComboBox;
CB_ComNum: TComboBox;
Label1: TLabel;
Btn_Reset: TButton;
SaveDialog1: TSaveDialog;
CB_hexSend: TCheckBox;
Btn_ClearMome: TButton;
CB_AutoSend: TCheckBox;
Edt_Interval: TEdit;
Label6: TLabel;
Label7: TLabel;
Btn_OpenFile: TButton;
OpenDialog1: TOpenDialog;
Timer_AutoSend: TTimer;
CB_Clear: TCheckBox;
CB_Show: TCheckBox;
CB_HexGet: TCheckBox;
Btn_About: TButton;
CB_StopShow: TCheckBox;
Btn_CountReset: TButton;
Timer_WatchState: TTimer;
Shape_ComState: TShape;
Memo_Show: TRichEdit;
FindDialog1: TFindDialog;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
procedure ComPort1Trigger(CP: TObject; Msg, TriggerHandle,
Data: Word);
procedure diff(s:string);
procedure Btn_ResetClick(Sender: TObject);
procedure SendHex(S: String);
procedure Btn_SendClick(Sender: TObject);
procedure Btn_ClearViewClick(Sender: TObject);
procedure CB_ComNumSelect(Sender: TObject);
procedure Btn_SaveViewClick(Sender: TObject);
procedure Btn_OpenFileClick(Sender: TObject);
procedure Btn_ClearMomeClick(Sender: TObject);
procedure CB_AutoSendClick(Sender: TObject);
procedure Edt_IntervalKeyPress(Sender: TObject; var Key: Char);
procedure Timer_AutoSendTimer(Sender: TObject);
procedure Memo_ShowChange(Sender: TObject);
procedure leijia(s:string);
procedure zhuhang(s:string);
procedure Btn_AboutClick(Sender: TObject);
procedure ComPortInit;
procedure InitDate;
procedure FormShow(Sender: TObject);
procedure Btn_CountResetClick(Sender: TObject);
procedure Timer_WatchStateTimer(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N6Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure FindDialog1Find(Sender: TObject);
procedure Memo_ShowKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
procedure myMemoAddText(strAdd : string);
public
{ Public declarations }
end;
const
version='版本號：V1.16';
SoftName='串口通訊控制器';
Verinfo='原創：jpyc'+#13+'山東威海'#13'OICQ：54076683'#13'主頁：http://www.kaer.cn/default.aspx'#13'E_mail:SDWHXYR@YEAH.NET '#13'軟件版本升級記錄:'#13
+'1.10:增加窗口定位記憶功能；保存相應設置 ；'#13+
'1.12:消除累加顯示時的閃爍感'#13+
'1.14:也是為了消除累加顯示時的閃爍感，原來用memo,改為richedit；'#13+
'1.16:增加了ctrl+F,F3鍵組合使用，搜索字符串功能;'#13;
var
MainForm : TMainForm;
JSdate,FSdate : integer;
implementation
uses about;
{$R *.dfm}
procedure TMainForm.myMemoAddText(strAdd : string);
var
str : string;
begin
str := Memo_Show.Lines[Memo_Show.Lines.Count-1];
if Memo_Show.Lines.Count=0 then
Memo_Show.Lines[0] := str + strAdd
else
Memo_Show.Lines[Memo_Show.Lines.Count-1] := str + strAdd;
end;
//累加顯示
procedure TMainForm.leijia(s:string);
begin
myMemoAddText(s);
end;
//逐行顯示
procedure TMainForm.zhuhang(s:string);
begin
Memo_Show.Lines.Add(s);
end;
procedure TMainForm.diff(s:string);
begin
if not CB_StopShow.Checked then
if CB_Show.Checked then
zhuhang(s)
else
Leijia(s);
end;
//接收數據
procedure TMainForm.ComPort1Trigger(CP: TObject; Msg, TriggerHandle,
Data: Word);
var
I : Word;
C : Char;
s : String;
begin
try
case Msg of
APW_TRIGGERDATA :
{got 'login', send response}
;
APW_TRIGGERAVAIL :
{extract and display/process the data}
begin
s:='';
for I:= 1 to Data do
begin
C := ComPort1.GetChar;
if CB_hexGet.Checked then
begin
s:=s+inttohex(byte(c),2)+' ';
end else
s:=s+c;
inc(JSdate);
end;
StatusBar.Panels.Items[2].Text:='接收：'+inttostr(JSdate);
Diff(s);
end;
APW_TRIGGERTIMER :
{timed out waiting for login prompt, handle error}
;
end;
except
end;
end;
//發送16進制數據
procedure TMainForm.SendHex(S: String);
var
s2:string;
buf1:array[0..50000] of byte;
i:integer;
begin
s2:='';
for i:=1 to length(s) do
begin
if ((copy(s,i,1)>='0') and (copy(s,i,1)<='9'))or((copy(s,i,1)>='a') and (copy(s,i,1)<='f'))
or((copy(s,i,1)>='A') and (copy(s,i,1)<='F')) then
begin
s2:=s2+copy(s,i,1);
end;
end;
for i:=0 to (length(s2) div 2-1) do
begin
buf1[i]:=strtoint('$'+copy(s2,i*2+1,2));
end;
MainForm.ComPort1.PutBlock(buf1,(length(s2) div 2));
end;
//等待串口發送完畢
procedure waitcommEmpty;
var
t:integer;
begin
t:=0;
while (MainForm.ComPort1.OutBuffUsed>0) or (t>100) do
begin
sleep(200);
inc(t);
end;
sleep(200);
end;
// 設置串口
procedure TMainForm.ComPortInit;
begin
try
ComPort1.Open:=false;
Shape_ComState.Brush.Color:=clRed;
sleep(50);
ComPort1.ComNumber:=CB_ComNum.ItemIndex+1;
ComPort1.Baud:=strtoint(CB_Baud.Text);
case CB_Parity.ItemIndex of
0:
ComPort1.Parity:=pEven;
1:
ComPort1.Parity:=pMark;
2:
ComPort1.Parity:=pNone;
3:
ComPort1.Parity:=pOdd;
4:
ComPort1.Parity:=pSpace;
else
ComPort1.Parity:=pNone;
end;
ComPort1.DataBits:=strtoint(CB_DataBits.Text);
ComPort1.StopBits:=strtoint(CB_StopBits.Text);
ComPort1.Open:=true;
except
showmessage('串口不存在或被占用。');
end;
end;
//設置計數器
procedure TMainForm.InitDate;
begin
JSdate:=0;
FSdate:=0;
StatusBar.Panels.Items[1].Text:='發送：0';
StatusBar.Panels.Items[2].Text:='接收：0';
end;
procedure TMainForm.Btn_ResetClick(Sender: TObject);
begin
ComPortInit;
end;
procedure TMainForm.Btn_SendClick(Sender: TObject);
var
s:string;
begin
s:=SendMemo.Text;
if ComPort1.Open then
begin
if CB_hexSend.Checked then
SendHex(S)
else
ComPort1.PutString(s);
FSdate:=FSdate+length(s);
StatusBar.Panels.Items[1].Text:='發送：'+inttostr(FSdate);
waitcommEmpty;
end else
showmessage('串口未打開。');
end;
procedure TMainForm.Btn_ClearViewClick(Sender: TObject);
begin
Memo_Show.Clear;
end;
procedure TMainForm.CB_ComNumSelect(Sender: TObject);
begin
ComPortInit;
end;
procedure TMainForm.Btn_SaveViewClick(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
Memo_Show.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
procedure TMainForm.Btn_OpenFileClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
SendMemo.Lines.LoadFromFile(OpenDialog1.FileName);
end;
end;
procedure TMainForm.Btn_ClearMomeClick(Sender: TObject);
begin
SendMemo.Clear;
end;
procedure TMainForm.CB_AutoSendClick(Sender: TObject);
begin
if CB_AutoSend.Checked then
begin
Timer_AutoSend.Interval:=strtoint(Edt_Interval.Text);
Timer_AutoSend.Enabled:=true;
end else
Timer_AutoSend.Enabled:=false;
end;
procedure TMainForm.Edt_IntervalKeyPress(Sender: TObject; var Key: Char);
begin
if key=#8 then exit;
if (key>'9') or (key<'0') then
key:=#0;
end;
procedure TMainForm.Timer_AutoSendTimer(Sender: TObject);
begin
Btn_SendClick(Sender);
end;
procedure TMainForm.Memo_ShowChange(Sender: TObject);
begin
if CB_Clear.Checked then
if length(Memo_Show.Text)>10000 then
Memo_Show.Clear;
end;
procedure TMainForm.Btn_AboutClick(Sender: TObject);
begin
AboutBox.ShowModal;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
MainForm.Caption:=Application.Title;
CB_ComNum.ItemIndex:=0;
InitDate;
ComPortInit;
end;
procedure TMainForm.Btn_CountResetClick(Sender: TObject);
begin
InitDate;
end;
procedure TMainForm.Timer_WatchStateTimer(Sender: TObject);
begin
if ComPort1.Open then
Shape_ComState.Brush.Color:=clLime
else
Shape_ComState.Brush.Color:=clRed;
StatusBar.Panels.Items[0].Text:=datetimetostr(now);
StatusBar.Panels.Items[3].Text:=version;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
if MainForm.Width<670 then MainForm.Width:=670;
if MainForm.Height<490 then MainForm.Height:=490;
end;
//通過INI文件，記憶設置和窗口位置
procedure TMainForm.FormCreate(Sender: TObject);
var
Ini: TIniFile;
begin
Ini := TIniFile.Create( ChangeFileExt( Application.ExeName, '.INI' ) );
try
Top := Ini.ReadInteger( 'Form', 'Top', 100 );
Left := Ini.ReadInteger( 'Form', 'Left', 100 );
Width := Ini.ReadInteger( 'Form', 'Width', 500 );
Height := Ini.ReadInteger( 'Form', 'Height', 300 );
Caption := Ini.ReadString( 'Form', 'Caption', SoftName );
CB_HexGet.Checked:=Ini.ReadBool('Form', 'HexGet', false );
CB_StopShow.Checked:=Ini.ReadBool('Form', 'StopShow', false);
CB_Clear.Checked:=Ini.ReadBool('Form', 'Clear', true );
CB_Show.Checked:=Ini.ReadBool('Form', 'Show', false );
CB_hexSend.Checked:=Ini.ReadBool('Form', 'hexSend', false );
Edt_Interval.Text:= inttostr(Ini.ReadInteger( 'Form', 'Interval', 1000 ));
if Ini.ReadBool( 'Form', 'InitMax', false ) then
WindowState := wsMaximized
else
WindowState := wsNormal;
finally
Ini.Free;
end;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
Ini: TIniFile;
begin
Ini := TIniFile.Create( ChangeFileExt( Application.ExeName, '.INI' ) );
try
Ini.WriteInteger( 'Form', 'Top', Top);
Ini.WriteInteger( 'Form', 'Left', Left);
Ini.WriteInteger( 'Form', 'Width',Width);
Ini.WriteInteger( 'Form', 'Height',Height);
Ini.WriteString( 'Form', 'Caption', Caption );
Ini.WriteBool( 'Form', 'InitMax', WindowState = wsMaximized );
Ini.WriteBool('Form', 'HexGet',CB_HexGet.Checked);
Ini.WriteBool('Form', 'StopShow',CB_StopShow.Checked);
Ini.WriteBool('Form', 'Clear',CB_Clear.Checked);
Ini.WriteBool('Form', 'Show',CB_Show.Checked);
Ini.WriteBool('Form', 'hexSend',CB_hexSend.Checked);
Ini.WriteInteger( 'Form', 'Interval', strtoint(Edt_Interval.Text));
finally
Ini.Free;
end;
end;
procedure TMainForm.N6Click(Sender: TObject);
begin
Memo_Show.Undo;
end;
procedure TMainForm.N2Click(Sender: TObject);
begin
Memo_Show.CutToClipboard;
end;
procedure TMainForm.N1Click(Sender: TObject);
begin
Memo_Show.CopyToClipboard;
end;
procedure TMainForm.N3Click(Sender: TObject);
begin
Memo_Show.PasteFromClipboard;
end;
procedure TMainForm.N4Click(Sender: TObject);
begin
Memo_Show.SelectAll;
end;
procedure TMainForm.FindDialog1Find(Sender: TObject);
var
FoundAt: LongInt;
StartPos, ToEnd: Integer;
begin
with Memo_Show do
begin
if SelLength <> 0 then
StartPos := SelStart + SelLength
else
StartPos := 0;
ToEnd := Length(Text) - StartPos;
FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, [stMatchCase]);
if FoundAt <> -1 then
begin
SetFocus;
SelStart := FoundAt;
SelLength := Length(FindDialog1.FindText);
end else
begin
showmessage('沒有查到相應數據。');
SelStart := 0;
end;
end;
end;
procedure TMainForm.Memo_ShowKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=114 then //f3
begin
FindDialog1Find(Sender);
exit;
end;
if (key=70) and (Shift=[ssCtrl]) then //ctrl+f
FindDialog1.Execute;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -