📄 formmain.~pas
字号:
unit FormMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AppEvnts, ImgList, Menus, NMUDP, StdCtrls, ExtCtrls,shellapi,
ScktComp, ComCtrls,UnitMessage, WinSkinData;
const
ghy_tray=wm_user+2;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
NMUDP1: TNMUDP;
PopupMenu1: TPopupMenu;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
ImageList1: TImageList;
ApplicationEvents1: TApplicationEvents;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
UserListBox: TListBox;
StatusBar: TStatusBar;
ServerSocket1: TServerSocket;
SkinData1: TSkinData;
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Btn_CloseClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure N21Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
procedure WMSysCommand(var msg: TMessage);message wm_syscommand;
public
{ Public declarations }
COMICQ:TTYICQ;
procedure mytray(var Msg: TMessage); message ghy_tray;
end;
var
MainForm: TMainForm;
implementation
uses FormSetting;
{$R *.dfm}
var
tray1,tray2:TNotifyIconData;
ico1,ico2:ticon;
tags:boolean;
procedure TMainForm.WMSysCommand(var msg: TMessage);
begin
if msg.WParam = SC_MINIMIZE then
begin
showwindow(application.handle,sw_hide);
inherited;
end
else
inherited;
end;
procedure TMainForm.mytray(var Msg: TMessage);
var
pt:tpoint;
begin
GetCursorPos(pt);
case msg.lParam of
WM_LBUTTONDOWN:
begin
//鼠标左键被按下
{if tags=true then
begin
application.Minimize;
MainForm.Hide;
end
else
begin
application.Restore;
end;}
SetForegroundWindow(MainForm.Handle);
MainForm.PopupMenu1.Popup(pt.x,pt.y);
end;
WM_LBUTTONUP:
begin
//释放鼠标左键
end;
wm_rbuttondown:
begin
//鼠标右键被按下
SetForegroundWindow(MainForm.Handle);
MainForm.PopupMenu1.Popup(pt.x,pt.y);
end
else//调用父类的WndProc方法处理其它消息
inherited;
end;
end;
procedure TMainForm.ApplicationEvents1Minimize(Sender: TObject);
begin
tags := false;
ShowWindow(Application.Handle,SW_HIDE);
tray2.cbSize := sizeof(tray2);
tray2.Wnd := MainForm.Handle;
tray2.uID := 0;
tray2.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
tray2.uCallbackMessage := ghy_tray;
tray2.hIcon := ico2.Handle;
tray2.szTip := '通用通讯工具-服务器';
if not Shell_NotifyIcon(NIM_modify,@tray2) then
begin
ShowMessage('no');
end;
end;
procedure TMainForm.ApplicationEvents1Restore(Sender: TObject);
begin
tags := true;
//ShowWindow(Application.Handle,SW_SHOWNORMAL);
Application.Run;
ico1 := ticon.Create;
ico2 := ticon.create;
imagelist1.GetIcon(0,ico1);
imagelist1.geticon(1,ico2);
tray1.cbSize := sizeof(tray1);
tray1.Wnd := MainForm.Handle;
tray1.uID := 0;
tray1.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
tray1.uCallbackMessage := ghy_tray;
tray1.hIcon := ico1.Handle;
tray1.szTip := '通用通讯工具-服务器';
if not Shell_NotifyIcon(NIM_modify,@tray1) then
begin
ShowMessage('no');
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
COMICQ := TTYICQ.Create(NMUDP1,ServerSocket1);
Application.HintShortPause:=0;
StatusBar.Panels[0].Text := COMICQ.ComputerName+'[等待连接]';
tags := true;
ShowWindow(Application.Handle,SW_HIDE);
ico1 := ticon.Create;
ico2 := ticon.create;
imagelist1.GetIcon(0,ico1);
imagelist1.geticon(1,ico2);
tray1.cbSize := sizeof(tray1);
tray1.Wnd := MainForm.Handle;
tray1.uID := 0;
tray1.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
tray1.uCallbackMessage := ghy_tray;
tray1.hIcon := ico1.Handle;
tray1.szTip := '通用通讯工具-服务器';
if not Shell_NotifyIcon(NIM_ADD,@tray1) then
begin
ShowMessage('no');
end;
end;
procedure TMainForm.Btn_CloseClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.N2Click(Sender: TObject);
begin
SettingForm := TSettingForm.Create(nil);
SettingForm.ShowModal;
end;
procedure TMainForm.N4Click(Sender: TObject);
begin
imagelist1.GetIcon(0,ico1);
imagelist1.geticon(1,ico2);
tray1.cbSize := sizeof(tray1);
tray1.Wnd := MainForm.Handle;
tray1.uID := 0;
tray1.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
tray1.uCallbackMessage := ghy_tray;
tray1.hIcon := ico1.Handle;
tray1.szTip := '通用通讯工具-服务器';
if not Shell_NotifyIcon(NIM_delete,@tray1) then
begin
ShowMessage('no');
end;
ico1.Destroy;
ico2.Destroy;
Application.Terminate;
end;
procedure TMainForm.N7Click(Sender: TObject);
begin
ico1 := ticon.Create;
ico2 := ticon.create;
imagelist1.GetIcon(0,ico1);
imagelist1.geticon(1,ico2);
tray1.cbSize := sizeof(tray1);
tray1.Wnd := MainForm.Handle;
tray1.uID := 0;
tray1.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
tray1.uCallbackMessage := ghy_tray;
tray1.hIcon := ico1.Handle;
tray1.szTip := '通用通讯工具-服务器';
if not Shell_NotifyIcon(NIM_delete,@tray1) then
begin
ShowMessage('no');
end;
ico1.Destroy;
ico2.Destroy;
Application.Terminate;
end;
procedure TMainForm.N5Click(Sender: TObject);
begin
application.Restore;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
tags := false;
//ShowWindow(Application.Handle,SW_HIDE);
Application.Minimize;
tray2.cbSize := sizeof(tray2);
tray2.Wnd := MainForm.Handle;
tray2.uID := 0;
tray2.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
tray2.uCallbackMessage := ghy_tray;
tray2.hIcon := ico2.Handle;
tray2.szTip := '通用通讯工具-服务器';
if not Shell_NotifyIcon(NIM_modify,@tray2) then
begin
ShowMessage('no');
end;
CanClose := false;
end;
procedure TMainForm.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
Msg,TrueFromIP,Header:String;
begin
if not COMICQ.Login then exit;
COMICQ.IniMsgStream;
NMUDP1.ReadStream(COMICQ.MsgStream);
SetLength(Msg,NumberBytes);
COMICQ.MsgStream.Read(Msg[1],NumberBytes);
TrueFromIP := Trim(Copy(Msg,1,IPLen));
Header := Trim(Copy(Msg,IPLen+1,HeaderLen));
Msg := Copy(Msg,IPLen+HeaderLen+1,Length(Msg)-IPLen-HeaderLen);
if (Header='Login')then
begin
COMICQ.ReceivedLoginMsg(TrueFromIP,Msg);
UserListBox.Items.Clear;
UserListBox.Items := COMICQ.UserNameList;
end;
if (Header='Logout') then
COMICQ.ReceivedLogoutMsg(TrueFromIP);
if (Header='Broad') then
COMICQ.ReceivedBroadCastMsg(TrueFromIP,Msg);
if (Header='Chat') then
COMICQ.ReceivedChatMsg(TrueFromIP,Msg);
end;
procedure TMainForm.N21Click(Sender: TObject);
var
Icon:Integer;
Title,Msg:String;
begin
Icon := LoadIcon(hinstance,'mainicon');
Title := 'COMICQ V1.0 Release';
Msg := '程晓卫 于 2003.12.26'#13#10'http://www.icesharp.net';
ShellAbout(Handle,PChar(Title),PChar(Msg),Icon);
end;
procedure TMainForm.N9Click(Sender: TObject);
var
Icon:Integer;
Title,Msg:String;
begin
Icon := LoadIcon(hinstance,'mainicon');
Title := 'COMICQ V1.0 Release';
Msg := '程晓卫 于 2003.12.26'#13#10'http://www.icesharp.net';
ShellAbout(Handle,PChar(Title),PChar(Msg),Icon);
end;
procedure TMainForm.N14Click(Sender: TObject);
begin
COMICQ.SendLoginMsg(COMICQ.ServerIP);
end;
procedure TMainForm.N15Click(Sender: TObject);
begin
COMICQ.SendLogoutMsg;
end;
procedure TMainForm.N11Click(Sender: TObject);
begin
COMICQ.SendLogoutMsg;
end;
procedure TMainForm.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
Msg,TrueFromIP,Header:String;
begin
COMICQ.ReceiveData(Socket);
UserListBox.Items := COMICQ.UserNameList;
end;
procedure TMainForm.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Case ErrorEvent Of
eeGeneral:
Showmessage('The socket received an error message that does not fit into any of the following categories.');
eeSend:
Showmessage('An error occurred when trying to write to the socket connection.');
eeReceive:
Showmessage('An error occurred when trying to read from the socket connection.');
eeConnect:
//A connection request that was already accepted could not be completed.
Showmessage('连接服务器失败!');
eeDisconnect:
Showmessage('An error occurred when trying to close a connection.');
eeAccept:
Showmessage('A problem occurred when trying to accept a client connection request.');
End;
end;
procedure TMainForm.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar.Panels[2].Text := inttostr(ServerSocket1.Socket.ActiveConnections);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -