⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 formmain.~pas

📁 企业通comicq是一个通讯工具软件,一个通讯工具软件
💻 ~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 + -