📄 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, RarBar, WinSkinData, MPlayer,
fcOutlookList, fcButton, fcImgBtn, fcShapeBtn, fcClearPanel,
fcButtonGroup, fcOutlookBar, ActnList, WinSkinStore, auHTTP,
auAutoUpgrader;
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;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
StatusBar: TStatusBar;
ClientSocket1: TClientSocket;
PopupMenu2: TPopupMenu;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
MediaPlayer1: TMediaPlayer;
UserListBox: TListView;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
Btn_LonOn: TButton;
Btn_LogOut: TButton;
Btn_Exit: TButton;
ActionList1: TActionList;
LogOn: TAction;
LogOut: TAction;
ExitSys: TAction;
HideMe: TAction;
SkinStore1: TSkinStore;
SkinData1: TSkinData;
Btn_UpdateSkin: TButton;
UpdateSkin: TAction;
SendChatMsg: TAction;
SendFile: TAction;
AutoUpgraderPro1: TauAutoUpgrader;
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Btn_CloseClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure N21Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N14Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
procedure ExitSysExecute(Sender: TObject);
procedure UpdateSkinExecute(Sender: TObject);
procedure LogOutExecute(Sender: TObject);
procedure LogOnExecute(Sender: TObject);
procedure SendChatMsgExecute(Sender: TObject);
procedure AutoUpgraderPro1Aborted(Sender: TObject);
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
,ReceivedUnit
,FormUpdateSkin;
{$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);
var
pComputerName:PChar;
ComputerNameLen:DWORD;
begin
SkinData1.LoadFromCollection(SkinStore1,0);
SkinData1.Active := true;
COMICQ := TTYICQ.Create(NMUDP1,ClientSocket1);
Application.HintShortPause := 0;
ComputerNameLen := 255;
GetMem(pComputerName,ComputerNameLen);
try
if not GetComputerName(pComputerName,ComputerNameLen) then
pComputerName := '无名氏';
COMICQ.ComputerName := String(PComputerName);
finally
FreeMem(pComputerName);
end;
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;
AutoUpgraderPro1.CheckUpdate;
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.N5Click(Sender: TObject);
begin
COMICQ.SendLoginMsg(COMICQ.ServerIP);
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.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.N11Click(Sender: TObject);
begin
COMICQ.SendLogoutMsg;
end;
procedure TMainForm.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
COMICQ.ReceiveData(Socket,UserListBox);
end;
procedure TMainForm.ClientSocket1Error(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.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar.Panels[0].Text := '正在于服务器建立连接...';
end;
procedure TMainForm.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar.Panels[0].Text := '正在与服务器断开连接...';
end;
procedure TMainForm.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar.Panels[0].Text := '和服务器成功建立连接';
end;
procedure TMainForm.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
Msg:string;
Header:string;
i:integer;
IPAddress,ComputerName:string;
bFound:boolean;
begin
// if (not COMICQ.Login) then Exit;
SetLength(Msg, NumberBytes);
NMUDP1.ReadBuffer(Msg[1],NumberBytes);
Header := Trim(Copy(Msg,IPLen,HeaderLen+1));
if Header='Login' then
begin
//接受到用户在线消息
//如果是用户列表中不存在的,则增加到用户列表并且该用户标识为在线
//如果用户列表中存在的,则只是将已存在的用户标识为在线
IPAddress := Copy(Msg,1,IPLen);
ComputerName := Copy(Msg,IPLen+HeaderLen+1,Length(Msg)-IPLen-HeaderLen);
bFound := false;
for i:=0 to COMICQ.IPList.Count-1 do
begin
if trim(COMICQ.IPList[i])=trim(IPAddress) then
begin
//标识用户在线
UserListBox.Items.Item[i].ImageIndex := 3;
UserListBox.ItemIndex := i;
bFound := true;
break;
end;
end;
if bFound=false then
begin
//增加用户
COMICQ.AddUser(trim(IPAddress),ComputerName);
UserListBox.AddItem(trim(ComputerName),UserListBox);
//标识用户在线
UserListBox.ItemIndex := i+1;
UserListBox.Items.Item[i+1].ImageIndex := 3;
end;
MediaPlayer1.FileName := ExtractFilePath(application.exename)+'Msg.wav';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;
if Header='Logout' then
begin
//接受到用户离线消息
//如果用户列表中存在的,则只是将已存在的用户标识为在线
IPAddress := Copy(Msg,1,IPLen);
ComputerName := Copy(Msg,IPLen+HeaderLen+1,Length(Msg)-IPLen-HeaderLen);
for i:=0 to COMICQ.IPList.Count-1 do
begin
if trim(COMICQ.IPList[i])=trim(IPAddress) then
begin
//标识用户离线
UserListBox.Items.Item[i].ImageIndex := 2;
MediaPlayer1.FileName := ExtractFilePath(application.exename)+'Msg.wav';
MediaPlayer1.Open;
MediaPlayer1.Play;
break;
end;
end;
end;
if Header='Chat' then
begin
COMICQ.ReceivedChatMsg(FromIP,Msg);
MediaPlayer1.FileName := ExtractFilePath(application.exename)+'Sound.wav';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;
end;
procedure TMainForm.ExitSysExecute(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.UpdateSkinExecute(Sender: TObject);
begin
UpdateSkinForm := TUpdateSkinForm.Create(nil);
UpdateSkinForm.ShowModal;
end;
procedure TMainForm.LogOutExecute(Sender: TObject);
begin
COMICQ.SendLogoutMsg;
end;
procedure TMainForm.LogOnExecute(Sender: TObject);
begin
//向代理服务器发出登录请求
COMICQ.SendLoginMsg(COMICQ.ServerIP);
Application.Restore;
end;
procedure TMainForm.SendChatMsgExecute(Sender: TObject);
begin
if UserListBox.ItemIndex>=0 then
begin
ReceivedMsgForm := TReceivedMsgForm.Create(nil);
ReceivedMsgForm.FromIP := COMICQ.IPList[UserListBox.ItemIndex];
ReceivedMsgForm.RemoteComputerName := COMICQ.UserNameList[UserListBox.ItemIndex];
ReceivedMsgForm.Show;
end;
end;
procedure TMainForm.AutoUpgraderPro1Aborted(Sender: TObject);
begin
Showmessage('软件更新中途失败,请稍后再试!');
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -