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

📄 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, 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 + -