📄 unit1.pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SPComm, ShellAPI, StdCtrls, ExtCtrls, Menus, ImgList, ComCtrls,
ToolWin,Registry;
const
ICON_ID = 1;
MY_ICONMESSAGE = WM_USER + 104;
WM_MYMESSAGE = WM_USER + 105;
type
TForm1 = class(TForm)
Comm1: TComm;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
Edit1: TEdit;
Button1: TButton;
ComboBox2: TComboBox;
Button2: TButton;
Label6: TLabel;
Memo1: TMemo;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
GroupBox4: TGroupBox;
Label1: TLabel;
ComboBox1: TComboBox;
Panel1: TPanel;
Button3: TButton;
Button4: TButton;
Image1: TImage;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure WMMyMessage(var Msg:TMessage);message WM_MYMESSAGE;
procedure IconOnChick(var message:TMessage);message MY_ICONMESSAGE;
procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
procedure Edit1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
comm;
{$R *.dfm}
var
IconData:TNotifyIconData;
isShow:Boolean; //Form1是否显示
isOpen:Boolean; //串口是否打开
is_1_Open: Boolean; //连动1
is_2_Open: Boolean; //连动2
is_3_Open: Boolean; //连动3
is_4_Open: Boolean; //连动4
procedure TForm1.FormCreate(Sender: TObject);
var
strTemp: string;
handleTemp: THandle;
intTemp:integer;
reg:TRegistry;
begin
if ParamCount < 1 then
begin
intTemp := -1;
end
else if (not IsAllNum(ParamStr(1))) then
begin
ShowMessage('参数类型错误');
Application.Terminate;
Exit;
end
else if (StrToInt(ParamStr(1)) >255) or (StrToInt(ParamStr(1)) < -255) then
begin
ShowMessage('参数的值超出预定范围');
Application.Terminate;
Exit;
end
else
begin
intTemp := StrToInt(ParamStr(1));
end;
strTemp := Form1.Caption;
Form1.Caption := 'OnlyOne'+IntToStr(hInstance);
handleTemp := FindWindow(nil,pchar(strTemp));
Form1.Caption := strTemp;
if handleTemp <> 0 then
begin
SendMessage(handleTemp,WM_MYMESSAGE,
intTemp,0);
Application.Terminate;
Exit;
end;
//托盘设置
IconData.cbSize := Sizeof(IconData);
IconData.Wnd := Handle;
IconData.uID := ICON_ID;
IconData.uFlags :=NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallbackMessage := MY_ICONMESSAGE;
IconData.hIcon := Image1.Picture.Icon.Handle;
IconData.szTip := '延华多媒体衔接程序';
Shell_NotifyIcon(NIM_ADD,@IconData);
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
//初始变量设置
ComboBox1.ItemIndex := 0;
isOpen := false;
Button3Click(nil);
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 1');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 2');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 3');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 4');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 5');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 6');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 7');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 8');
ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
+' 9');
ComboBox2.ItemIndex := 0;
//读注册表
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;//指定需要操作的注册表的主键
if reg.OpenKey('\Software\Connect',true) then//如果打开成功则进行以下操作
begin
try
ComboBox1.ItemIndex := reg.ReadInteger('index');//将需要保存的信息写入注册表
finally
reg.CloseKey;//关闭注册表
end;
reg.Free;//释放变量所占内存
is_1_Open := false;
is_2_Open := false;
is_3_Open := false;
is_4_Open := false;
SendMessage(Form1.Handle,WM_MYMESSAGE,
intTemp,0);
end;
end;
procedure TForm1.WMMyMessage(var Msg: TMessage);
begin
if Msg.WPARAM = -1 then
begin
Form1.Show;
Exit;
end;
case Msg.WPARAM of
1:
begin
if not is_1_Open then
comm1.writecommdata('1',1)
else
comm1.writecommdata('6',1);
is_1_Open := not is_1_Open;
end;
2:
begin
if not is_2_Open then
comm1.writecommdata('2',1)
else
comm1.writecommdata('7',1);
is_2_Open := not is_2_Open;
end;
3:
begin
if not is_3_Open then
comm1.writecommdata('3',1)
else
comm1.writecommdata('8',1);
is_3_Open := not is_3_Open;
end;
4:
begin
if not is_4_Open then
comm1.writecommdata('4',1)
else
comm1.writecommdata('9',1);
is_4_Open := not is_4_Open;
end;
end;
{
if not comm1.writecommdata(Pchar(IntToStr(Msg.WPARAM)),1) then
begin
Memo1.lines.append(DateTimeToStr(now));
Memo1.lines.append('发送参数"'
+IntToStr(Msg.WPARAM)+'"失败!');
Memo1.lines.add(' ');
Exit;
end;
}
Memo1.lines.append(DateTimeToStr(now));
Memo1.lines.append(IntToStr(Msg.WPARAM));
Memo1.lines.add(' ');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE,@IconData);
isOpen := true;
Button3Click(nil);
end;
procedure TForm1.IconOnChick(var message: TMessage);
var
pt:TPoint;
begin
if (message.LParam = WM_LBUTTONDBLCLK)
and (isShow = false) then
begin
Form1.Show;
end
else if (message.LParam = WM_RBUTTONDOWN) then
begin
GetCursorPos(pt);
PopupMenu1.Popup(pt.X,pt.Y);
end;
//else if (message.LParam = WM_LBUTTONDBLCLK) then
//begin
// GetCursorPos(pt);
// PopupMenu2.Popup(pt.X,pt.Y);
//end;
end;
procedure TForm1.WMSysCommand(var Message: TMessage);
begin
if Message.WParam = SC_MINIMIZE then
begin
isShow := false;//点击最小化按扭
Form1.Hide;
//ShowWindow(Application.Handle,SW_HIDE);
end
else
inherited;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
if isShow = false then
Form1.Show;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Application.Terminate;
end;
//打开、关闭串口按钮
procedure TForm1.Button3Click(Sender: TObject);
begin
if not isOpen then
//打开串口
begin
Comm1.CommName := ComboBox1.Text;
Comm1.StartComm;
isOpen := true;
Panel1.Color := clLime;
Button3.Caption := '关闭串口';
end
else
//关闭串口
begin
comm1.StopComm;
isOpen := false;
Panel1.Color := clRed;
Button3.Caption := '打开串口';
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
SendMessage(Form1.handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
p:Pchar;
begin
p:= Pchar(Edit1.text);
for i := 0 to length(Edit1.text) do
begin
if not comm1.writecommdata(@p[i],1) then
begin
Memo1.lines.append(DateTimeToStr(now));
Memo1.lines.append('发送"'
+Edit1.text+'"失败!');
Memo1.lines.append('失败原因:第'
+IntToStr(i)+' 位字符"'+p[i]+'"未能发送!');
Memo1.lines.add(' ');
Exit;
end;
Sleep(2);
end;
Memo1.lines.append(DateTimeToStr(now));
Memo1.lines.append(Edit1.text);
Memo1.lines.add(' ');
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
Memo1.clear;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
case ComboBox2.ItemIndex of
0:SendMessage(Form1.handle,WM_MYMESSAGE,1,0);
1:SendMessage(Form1.handle,WM_MYMESSAGE,2,0);
2:SendMessage(Form1.handle,WM_MYMESSAGE,3,0);
3:SendMessage(Form1.handle,WM_MYMESSAGE,4,0);
4:SendMessage(Form1.handle,WM_MYMESSAGE,5,0);
5:SendMessage(Form1.handle,WM_MYMESSAGE,6,0);
6:SendMessage(Form1.handle,WM_MYMESSAGE,7,0);
7:SendMessage(Form1.handle,WM_MYMESSAGE,8,0);
8:SendMessage(Form1.handle,WM_MYMESSAGE,9,0);
end;
end;
procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
strTemp:string;
i:integer;
p:Pchar;
begin
strTemp := '';
p := Pchar(Buffer);
for i := 0 to BufferLength do
strTemp := strTemp + p[i];
memo1.lines.append(DateTimeToStr(now));
memo1.lines.append(strTemp);
//memo1.lines.add('');
end;
procedure TForm1.Edit1Click(Sender: TObject);
begin
Edit1.SelStart := 0;
Edit1.SelLength := Length(Edit1.Text);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
var
reg:TRegistry;
begin
//写注册表
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;//指定需要操作的注册表的主键
if reg.OpenKey('\Software\Connect',true) then//如果打开成功则进行以下操作
begin
reg.WriteInteger('index',ComboBox1.ItemIndex);//将需要保存的信息写入注册表
reg.CloseKey;//关闭注册表
end;
reg.Free;//释放变量所占内存
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -