mainunt.pas

絮语2007视频聊天软件源程序.仅供参考

unit mainunt;

interface

uses Windows, SysUtils,Classes,messages,forms,ComCtrls,Graphics,
     ExtCtrls,Menus, Controls,Dialogs, StdCtrls,Buttons,
     CoolTrayIcon,mxOutlookBarpro,activex,ShlObj,BarMenus,
     constunt,structureunt;

Const
  HDropFormatEtc: TFormatEtc = ( cfFormat: CF_HDROP; ptd: Nil; dwAspect: DVASPECT_CONTENT; lindex: - 1; tymed: TYMED_HGLOBAL );
  
type
  Tmainfrm = class(TForm)
    N53: TMenuItem;
    N63: TMenuItem;
    N64: TMenuItem;
    N7: TMenuItem;
    N40: TMenuItem;
    userbar_userid: TMenuItem;
    Timer1: TTimer;
    Panel2: TPanel;
    N48: TMenuItem;
    status_popup: TPopupMenu;
    online: TMenuItem;
    hideline: TMenuItem;
    N25: TMenuItem;
    N9: TMenuItem;
    N5: TMenuItem;
    N14: TMenuItem;
    userbar_right_popup: TPopupMenu;
    N59: TMenuItem;
    N19: TMenuItem;
    N21: TMenuItem;
    N31: TMenuItem;
    N24: TMenuItem;
    N29: TMenuItem;
    N36: TMenuItem;
    downline: TMenuItem;
    outline: TMenuItem;
    N28: TMenuItem;
    N27: TMenuItem;
    N35: TMenuItem;
    trayicon1: TCoolTrayIcon;
    mainmenu: TBcBarPopupMenu;
    N15: TMenuItem;
    N10: TMenuItem;
    N8: TMenuItem;
    N16: TMenuItem;
    N34: TMenuItem;
    H1: TMenuItem;
    N3: TMenuItem;
    N17: TMenuItem;
    N60: TMenuItem;
    N61: TMenuItem;
    N43: TMenuItem;
    N6: TMenuItem;
    N11: TMenuItem;
    N37: TMenuItem;
    btn_find: TSpeedButton;
    btn_menu: TSpeedButton;
    N38: TMenuItem;
    N39: TMenuItem;
    N41: TMenuItem;
    userbar: TmxOutlookBarPro;
    userbar_left_popup: TPopupMenu;
    btn_msg: TSpeedButton;
    btn_share: TSpeedButton;
    Panel1: TPanel;
    Label1: TLabel;
    myicon: TImage;
    N4: TMenuItem;
    N12: TMenuItem;
    Windows1: TMenuItem;
    N2: TMenuItem;
    claritymenu: TPopupMenu;
    N1: TMenuItem;
    N851: TMenuItem;
    N13: TMenuItem;
    N651: TMenuItem;
    N451: TMenuItem;
    N251: TMenuItem;
    N18: TMenuItem;
    N20: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure N34Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N59Click(Sender: TObject);
    procedure N61Click(Sender: TObject);
    procedure userbar_left_popupPopup(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure trayicon1DblClick(Sender: TObject);
    procedure btn_findClick(Sender: TObject);
    procedure btn_menuClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure N38Click(Sender: TObject);
    procedure userbarResize(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure userbarMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N9Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure status_popupPopup(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure userbar_useridClick(Sender: TObject);
    procedure onlineClick(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure btn_msgClick(Sender: TObject);
    procedure userbar_right_popupPopup(Sender: TObject);
    procedure userbarDragOver(Sender: TmxOutlookBarPro; Source: TObject;
      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TmxDropMode;
      var Effect: Integer; var Accept: Boolean);
    procedure userbarMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N40Click(Sender: TObject);
    procedure N53Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N29Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N36Click(Sender: TObject);
    procedure Windows1Click(Sender: TObject);
    procedure Panel1DblClick(Sender: TObject);
    procedure N37Click(Sender: TObject);
    procedure N63Click(Sender: TObject);
    procedure N48Click(Sender: TObject);
    procedure userbarDragDrop(Sender: TmxOutlookBarPro; Source: TObject;
      DataObject: IDataObject; const Formats: array of Word;
      Shift: TShiftState; Pt: TPoint; var Effect: Integer;
      Mode: TmxDropMode);
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N64Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure claritymenuPopup(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure createparams(var params:tcreateparams);override;
    procedure N20Click(Sender: TObject);
  private
    cur_status_auto,
    allow_application_quit:boolean;
    main_oldz:integer;
    procedure WMQueryEndsession(Var Msg:TMessage);Message WM_QueryEndSession;
    procedure wmmaxmainform(var msg:tmessage);message WM_SYSCOMMAND;
    procedure process_custom_message(var msg:tmessage);message refresh_status;
    { Private declarations }
    procedure inituserbar;
    procedure createheader(headid,headname:string);
    procedure createbutton(headid,md5name:string);
    procedure deletebutton(firendid:string);
    procedure show_myinfor;
    procedure refreshlist_userbar;
    procedure refresh_user_status;
    procedure refresh_sort_userbar;
    procedure refresh_latelylist;
    procedure PopupAtCursor(popupmenu:tpopupmenu);
    procedure initclientfrom;
    procedure checkstatusouttime;
    function  checkgetnewmsg:string;
    procedure deletefirendnewmsg(firendid:String);
    procedure flashtoicon(firendid:string;bool:boolean);
    procedure stopflash;
    procedure checkflashicon;
    procedure clear_status_item;
    procedure checktasklist;
  public
    { Public declarations }

  end;

var
  mainfrm: Tmainfrm;
  
implementation

{$R *.DFM}
uses  udpcores,shareunit,About,myinforset,searchuser,editheaderunt,selectunt;

procedure tmainfrm.createparams(var params:tcreateparams);
begin
inherited ;
Params.winclassname:='xychat';
end;

//------------------------------------------------------------------------------
// 拦截Windows关闭消息
//------------------------------------------------------------------------------
procedure tmainfrm.WMQueryEndsession(var Msg: TMessage);
begin
Msg.Result := 1;
halt;
end;

//------------------------------------------------------------------------------
// 拦截最大化,最小化消息
//------------------------------------------------------------------------------
procedure tmainfrm.wmmaxmainform(var msg:tmessage);
var p:tpoint;
begin
getcursorpos(p);
if (msg.WParam = SC_MAXIMIZE)or
  (msg.WParam = SC_RESTORE) then
   begin
   msg.Result:=1;
   claritymenu.Popup(p.x,p.y);
   end else if msg.WParam = SC_MINIMIZE then
   begin
   trayicon1.HideMainForm;
   end else Inherited;
end;

//------------------------------------------------------------------------------
// 自定义消息处理窗口
//------------------------------------------------------------------------------
procedure Tmainfrm.process_custom_message(var msg:tmessage);
begin
case msg.WParam of
  xy_showmainfrm:trayicon1.OnDblClick(nil);
  xy_refresh_user_status:refresh_user_status;
  xy_refresh_lately:refresh_latelylist;
  xy_showadmsgform:udpcore.showmsgfrm;
  xy_showpromptform:udpcore.showprompt;
  xy_createdlgform:udpcore.createdlgform;
  xy_filetran_starting:udpcore.checkfiletran;
  xy_media_starting:udpcore.checkmedia;
  xy_remote_starting:udpcore.checkremote;
  xy_boss_form:
     begin
      if trayicon1.IconVisible then
       begin
       trayicon1.HideMainForm;
       trayicon1.IconVisible:=false;
       end else begin
       trayicon1.IconVisible:=true;
       trayicon1.ShowMainForm;
       end;
     end;
  end;
end;

//------------------------------------------------------------------------------
// 处理窗口关闭
//------------------------------------------------------------------------------
procedure Tmainfrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (not allow_application_quit)and closetomin then
   begin
   action:=canone;
   postmessage(handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
   end else begin
   sendmsgtohwnd(xy_form_close);
   udpcore.hook.stophook;
   udpcore.query_firend_status(3);
   end;
end;

procedure Tmainfrm.FormPaint(Sender: TObject);
begin
udpcore.formonpaint(self);
end;

//------------------------------------------------------------------------------
// 处理窗口显示
//------------------------------------------------------------------------------
procedure Tmainfrm.FormResize(Sender: TObject);
begin
btn_menu.Width:=panel2.width-72;
btn_find.left:=btn_menu.width+2;
btn_msg.left:=btn_find.width+btn_menu.width+2;
btn_share.left:=btn_msg.width+btn_find.width+btn_menu.width+2;
end;

//------------------------------------------------------------------------------
// 初始化列表...
//------------------------------------------------------------------------------
procedure Tmainfrm.inituserbar;
begin
udpcore.openudport;
udpcore.chat.loadfromfile;
udpcore.task.loadfromfile;
userbar.Settings.buttonstyle:=bssmall;
createheader('myfirends','我的好友');
createheader('blacklist','黑名单');
createheader('latelylist','最近联系人');
userbar.activeheader:=userbar.header[0];
refresh_latelylist;
end;

//------------------------------------------------------------------------------
// 建立 userbar  header
//------------------------------------------------------------------------------
procedure Tmainfrm.createheader(headid,headname:string);
var tmpheader:tmxheader;
begin
if userbar.HeaderIndexByName(headid)+1=0 then
   begin
   tmpheader:=userbar.AddHeader;
   tmpheader.Name:=headid;
   if userbar.HeaderCount>3 then
   if (headid<>'myfirends')and
      (headid<>'blacklist')and
      (headid<>'latelylist') then tmpheader.Index:=1;
   end else tmpheader:=userbar.HeaderByName(headid);

with tmpheader do
 begin
 Caption:=headname;
 PopupMenu:=userbar_right_popup;
 images.Small:=udpcore.main_small_list;
 firstbuttontop:=2;
 Background.Style:=btTransparent;
 end;
end;

//------------------------------------------------------------------------------
// 建立 userbar  指定 header 下的 button
//------------------------------------------------------------------------------
procedure Tmainfrm.createbutton(headid,md5name:string);
var tmpbutton:tmxbutton;
    tmp:userinfo;
begin
if userbar.HeaderByName(headid).ButtonIndexByuser(md5name)+1=0 then
   begin
   tmpbutton:=userbar.HeaderByName(headid).AddButton();
   tmpbutton.userstring:=md5name;
   end else tmpbutton:=userbar.Headerbyname(headid).ButtonByuser(md5name);

if udpcore.user.checkuser(md5name) then
    begin
    tmp:=udpcore.user.getuserinfoex(md5name);
    with tmpbutton do
      begin
      cursor:=crhandpoint;
      OnClick:=userbar_useridClick;
      PopupMenu:=userbar_left_popup;
      buttonview:=bvwindowsxp;
      wordwrap:=true;
      if tmp.status=2 then tmp.status:=3;
      ImageIndex:=tmp.status;
      Caption:=tmp.uname;
      if tmp.userid=loginuser then visible:=showmyicon;
      if tmp.status>1 then visible:=not showonline;
      end;
    end;
end;

//------------------------------------------------------------------------------
// 删除 button
//------------------------------------------------------------------------------
procedure tmainfrm.deletebutton(firendid:string);
var tmp:userinfo;
    n:integer;
begin
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    n:=userbar.HeaderByName(tmp.groupid).ButtonIndexByuser(firendid)+1;
    if n>0 then userbar.headerbyname(tmp.groupid).deletebutton(n-1);
    end;
end;

//------------------------------------------------------------------------------
// 按状态排序.
//------------------------------------------------------------------------------
procedure tmainfrm.refresh_sort_userbar;
var i,n,m,k:integer;
    bool:boolean;
begin
if userbar.HeaderCount>0 then
for i:=1 to userbar.HeaderCount-1 do
with userbar.Headers[i-1] do
 begin
  bool:=true;
  while bool do     //循环 排序
   begin
    bool:=false;
    if ButtonCount>2 then
    for n:=2 to ButtonCount do
      begin
      m:=Buttons[n-2].ImageIndex;
      k:=Buttons[n-1].ImageIndex;
      if m>k then
         begin
         Buttons[n-2].index:=Buttons[n-1].index;
         bool:=true;
         end;
      end;
   end;

  if ButtonCount>0 then  //删除无效的BUTTON
  for n:=ButtonCount downto 1 do
  if Buttons[n-1].UserString='' then DeleteButton(n-1);
  end;
end;

//------------------------------------------------------------------------------
// 显示我的昵称图标,在线状态.
//------------------------------------------------------------------------------
procedure tmainfrm.show_myinfor;
var s:String; icon:ticon;
    tmp:userinfo;
begin
tmp:=udpcore.user.getuserinfoex(0);
s:=udpcore.pic.getmd5tofile(tmp.md5pic);
if fileexists(s) then myicon.Picture.LoadFromFile(s);
Label1.Caption:=tmp.uname+'('+statustostr(tmp.status)+')';
clear_status_item;
if tmp.status=0 then online.Checked:=true;
if tmp.status=1 then outline.Checked:=true;
if tmp.status=2 then hideline.Checked:=true;
if tmp.status=3 then downline.checked:=true;
try
icon:=Ticon.Create;
with udpcore do
  begin
  systray.Delete(0);
  main_small_list.GetIcon(tmp.status,icon);
  systray.InsertIcon(0,icon);
  end;
trayicon1.IconIndex:=0;
finally
freeandnil(icon);
end;
end;

//------------------------------------------------------------------------------
// 显示我的用户列表
//------------------------------------------------------------------------------
procedure tmainfrm.refreshlist_userbar;
var i:integer;
    tmp:userinfo;
begin
try
userbar.BeginUpdate;
with udpcore.user do
 begin
 if getcount>0 then
 for i:=1 to getcount do
   begin
   tmp:=getuserinfoex(i-1);
   if not tmp.nullity then
      begin
      createheader(tmp.groupid,tmp.gname);
      createbutton(tmp.groupid,tmp.md5name);
      end;
   end;
 end;
refresh_sort_userbar;
finally
userbar.EndUpdate;
end;
end;

//------------------------------------------------------------------------------
// 刷新要改变状态的用户