mainunt.pas

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

//------------------------------------------------------------------------------
procedure tmainfrm.refresh_user_status;
var i:integer;params,firendid:string;
    tmp:userinfo;
begin
if expandmemo.Count>0 then
   begin
    for i:=expandmemo.Count downto 1 do
       begin
       params:=expandmemo.Strings[i-1];
       if getparamitem(params,'msgid')=inttostr(xy_user) then
       if (getparamitem(params,'funid')=inttostr(xy_status))or
          (getparamitem(params,'funid')=inttostr(xy_search)) then
          begin
          expandmemo.Delete(i-1);
          firendid:=getparamitem(params,'md5name');
          if udpcore.user.checkuser(firendid) then
              begin
              tmp:=udpcore.user.getuserinfoex(firendid);
              createheader(tmp.groupid,tmp.gname);
              createbutton(tmp.groupid,tmp.md5name);
              end;
          end;
       end;
   refresh_sort_userbar;
   end;
end;

//------------------------------------------------------------------------------
// 显示最近的用户列表 限十人
//------------------------------------------------------------------------------
procedure Tmainfrm.refresh_latelylist;
var tmplist:tstringlist;
    i:integer; firendid:string;
begin
try
tmplist:=tstringlist.create;
udpcore.chat.getlatelylist(tmplist);
userbar.HeaderByName('latelylist').ClearButtons;
if tmplist.count>0 then
for i:=1 to tmplist.count do
  begin
  firendid:=tmplist.Strings[i-1];
  if udpcore.user.checkuser(firendid) then
     createbutton('latelylist',firendid);
  end;

finally
freeandnil(tmplist);
end;

end;

//------------------------------------------------------------------------------
// 初始化窗口
//------------------------------------------------------------------------------
procedure Tmainfrm.initclientfrom;
begin
show_myinfor;
refreshlist_userbar;
udpcore.query_firend_status(0);
if Left>screen.Width-20 then left:=screen.Width-20;
trayicon1.Hint:='絮语 '+loginuser;
udpcore.plug.addpluglist(userbar_left_popup.Items.Items[7]);
udpcore.SysHotKey.Active:=true;
udpcore.recreate_hotkey;
end;

//------------------------------------------------------------------------------
// 建立
//------------------------------------------------------------------------------
procedure Tmainfrm.FormCreate(Sender: TObject);
begin
main_hwnd:=handle;
udpcore.changeLayered(handle);
inituserbar;
initclientfrom;
udpcore.hook.starthook;
if not starting_mini then
   postmessage(handle,refresh_status,xy_showmainfrm,0);
Timer1.Enabled:=true;
end;

//------------------------------------------------------------------------------
// 缩放
//------------------------------------------------------------------------------
procedure Tmainfrm.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
if newwidth<136 then newwidth:=136;
if newwidth>170 then newwidth:=170;
if newheight<300 then newheight:=300;
end;

//------------------------------------------------------------------------------
// 打开保存路径
//------------------------------------------------------------------------------
procedure Tmainfrm.N32Click(Sender: TObject);
begin
end;

//------------------------------------------------------------------------------
// 退出应用
//------------------------------------------------------------------------------
procedure Tmainfrm.N11Click(Sender: TObject);
begin
allow_application_quit:=true;
close;
end;

//------------------------------------------------------------------------------
// 注销
//------------------------------------------------------------------------------
procedure Tmainfrm.N6Click(Sender: TObject);
begin
loginpass:='';
allow_application_quit:=true;
application.Terminate;
opencmd(application_name);
end;

//------------------------------------------------------------------------------
// 个性化设置
//------------------------------------------------------------------------------
procedure Tmainfrm.N34Click(Sender: TObject);
begin
with tmyinfor_set.Create(application) do
  try
  showmodal;
  finally
  free;
  end;
show_myinfor;
end;

//------------------------------------------------------------------------------
// 状态设置
//------------------------------------------------------------------------------
procedure Tmainfrm.N38Click(Sender: TObject);
begin
n38.checked:=not n38.Checked;
showupdownhint:=n38.checked;
end;

procedure Tmainfrm.N35Click(Sender: TObject);
begin
n35.Checked:=not n35.Checked;
showmyicon:=n35.checked;
refreshlist_userbar;
end;

procedure Tmainfrm.N59Click(Sender: TObject);
begin
n59.Checked:=not n59.Checked;
showonline:=n59.checked;
refreshlist_userbar;
end;

//------------------------------------------------------------------------------
//  初始化 状态设置
//------------------------------------------------------------------------------
procedure Tmainfrm.userbar_right_popupPopup(Sender: TObject);
begin
n35.checked:=showmyicon;
n38.Checked:=showupdownhint;
n59.Checked:=showonline;
end;
//------------------------------------------------------------------------------
// 自述文档
//------------------------------------------------------------------------------
procedure Tmainfrm.N61Click(Sender: TObject);
begin
opencmd(extractfilepath(application_name)+'readme.txt');
end;

//------------------------------------------------------------------------------
// 打开帮助
//------------------------------------------------------------------------------
procedure Tmainfrm.N3Click(Sender: TObject);
begin
opencmd(extractfilepath(application_name)+'xychat.chm');
end;

//------------------------------------------------------------------------------
// 关于
//------------------------------------------------------------------------------
procedure Tmainfrm.N17Click(Sender: TObject);
begin
with taboutbox.create(application) do
  try
  showmodal;
  finally
  free;
  end;
end;

//------------------------------------------------------------------------------
// 右键菜单
//------------------------------------------------------------------------------
procedure Tmainfrm.userbar_left_popupPopup(Sender: TObject);
begin
n53.visible:=false;
n7.visible:=false;
n40.visible:=false;
if userbar.ActiveHeader=userbar.header[0] then
   begin
   n53.visible:=true;
   n7.visible:=true;
   end;
if userbar.activeheader=userbar.header[1] then
   begin
   n53.visible:=true;
   n7.visible:=true;
   n40.visible:=true;
   end;
if userbar.activeheader=userbar.header[2] then
   begin
   n7.visible:=true;
   n40.visible:=true;
   end;
end;

procedure Tmainfrm.clear_status_item;
begin
online.Checked:=false;
outline.Checked:=false;
hideline.Checked:=false;
downline.Checked:=false;
end;

//------------------------------------------------------------------------------
//  检查是否状态超时
//------------------------------------------------------------------------------
procedure Tmainfrm.checkstatusouttime;
var tmp:userinfo;
begin
if allow_auto_status then
   begin
   tmp:=udpcore.user.getuserinfoex(0);
    if udpcore.hook.getstatusout then
       begin
       if tmp.status=0 then  // 开始转换状态
          begin
          cur_status_auto:=true;
          tmp.status:=auto_status;
          udpcore.user.modifyuser(tmp.md5name,tmp);
          show_myinfor;
          udpcore.query_firend_status(auto_status);
          end;
       end else begin
       if cur_status_auto then
          begin
          cur_status_auto:=false;
          tmp.status:=0;
          udpcore.user.modifyuser(tmp.md5name,tmp);
          show_myinfor;
          udpcore.query_firend_status(auto_status);
          end;
       end;
   end;
end;

function Tmainfrm.checkgetnewmsg:string;
var i:integer;
    params:string;
begin
result:='';
if expandmemo.Count>0 then
for i:=expandmemo.Count downto 1 do
   begin
   params:=expandmemo.Strings[i-1];
   if getparamitem(params,'msgid')=inttostr(xy_message) then
   if (getparamitem(params,'funid')=inttostr(xy_usertext))or
      (getparamitem(params,'funid')=inttostr(xy_usertext_ex)) then
      begin
      expandmemo.Delete(i-1);
      result:=params;
      break;
      end;
   end;
end;

procedure Tmainfrm.deletefirendnewmsg(firendid:String);
var i:integer;
    params:string;
begin
if expandmemo.Count>0 then
for i:=expandmemo.Count downto 1 do
   begin
   params:=expandmemo.Strings[i-1];
   if getparamitem(params,'msgid')=inttostr(xy_message) then
   if (getparamitem(params,'funid')=inttostr(xy_usertext))or
      (getparamitem(params,'funid')=inttostr(xy_usertext_ex)) then
   if getparamitem(params,'firendid')=firendid then;
      expandmemo.Delete(i-1);
   end;
end;
//------------------------------------------------------------------------------
//  userbar trayicon 闪烁过程
//------------------------------------------------------------------------------
procedure Tmainfrm.flashtoicon(firendid:string;bool:boolean);
var tempbutton:tmxbutton;
    tmp:userinfo;
begin
if udpcore.user.checkuser(firendid) then
  begin
  tmp:=udpcore.user.getuserinfoex(firendid);
  if userbar.Headerbyname(tmp.groupid).buttonindexbyuser(firendid)+1>0 then
     begin
     tempbutton:=userbar.Headerbyname(tmp.groupid).buttonbyuser(firendid);
     if bool then
        begin
        trayicon1.CycleIcons:=true;
        trayicon1.md5name:=firendid;
        tempbutton.Alert;
        end else begin
        tempbutton.StopAlert;
        trayicon1.CycleIcons:=false;
        trayicon1.IconIndex:=0;
        trayicon1.md5name:='';
        end;
     end;
   end;
end;

//------------------------------------------------------------------------------
//  停止flash 闪烁过程
//------------------------------------------------------------------------------
procedure Tmainfrm.stopflash;
var firendid:string;
begin
if trayicon1.CycleIcons then
   begin
   firendid:=trayicon1.md5name;
   deletefirendnewmsg(firendid);
   flashtoicon(firendid,false);
   udpcore.createdlgform(firendid);
   end;
end;

//------------------------------------------------------------------------------
//  检查flash 闪烁过程
//------------------------------------------------------------------------------
procedure Tmainfrm.checkflashicon;
var params,firendid:string;
begin
if not trayicon1.CycleIcons then
   begin
   params:=checkgetnewmsg;
   if length(params)>0 then
      begin
      firendid:=getparamitem(params,'firendid');
      flashtoicon(firendid,true);
      end;
   end;
end;

//------------------------------------------------------------------------------
//  自动隐藏
//------------------------------------------------------------------------------
procedure Tmainfrm.Timer1Timer(Sender: TObject);
var mouse:tpoint;
    hide_main:boolean;
    sx:string;
begin
sx:='00000';
hide_main:=true;
getcursorpos(mouse);
checkstatusouttime;
checkflashicon;
checktasklist;
if main_oldz=0 then //不靠边状态...
 begin
 
  if (left>=(screen.width-width+5))then            sx[1]:='1';  //right
  if top<=-5 then                                  sx[2]:='1';  //top
  if not trayicon1.mini then                      sx[3]:='1';  //base..
  if (left<=-5) then                               sx[4]:='1';  //left
  if (mouse.x<left)or(mouse.x>(left+width)) then   sx[5]:='1';  // not x..
  if (mouse.y<top)or(mouse.y>(top+height)) then    sx[5]:='1';  // not y..

  if sx='01101' then  main_oldz:=1;  // top
  if sx='10101' then   main_oldz:=2; //right
  if sx='00111' then    main_oldz:=3; //left
  if main_oldz>0 then
   begin
    if main_oldz=1 then  top:=2-height;   //top
    if main_oldz=2 then  left:=screen.width-2; //right
    if main_oldz=3 then  left:=2-width;  //left
   end;

 end else begin //靠边状态...
 if (mouse.x>=left)and(mouse.x<=(left+width))and
    (mouse.y>=top)and(mouse.y<=(top+height)) then  sx:='11111';

 if (main_oldz=1)and(top>=0) then hide_main:=false;
 if (main_oldz=2)and(left<=screen.width-width) then hide_main:=false;
 if (main_oldz=3)and(left>=0) then hide_main:=false;

 if sx='11111' then
   begin
   if hide_main then
    begin
    if main_oldz=1 then  top:=0;   //top
    if main_oldz=2 then  left:=screen.width-width; //right
    if main_oldz=3 then  left:=0; //left
    end;
   end else begin
   if not hide_main then
    begin
    if main_oldz=1 then  top:=1-height;   //top
    if main_oldz=2 then  left:=screen.width-1; //right
    if main_oldz=3 then  left:=1-width;  //left
    end;
   end;

 if (main_oldz=1) and (top>=5) then main_oldz:=0;   //top
 if (main_oldz=2) and (left<=(screen.width-width-5))then main_oldz:=0;  //right
 if (main_oldz=3) and (left>=5) then  main_oldz:=0; //left
 end;
end;

//------------------------------------------------------------------------------
// 任务栏图标处理过程
//------------------------------------------------------------------------------
procedure Tmainfrm.trayicon1DblClick(Sender: TObject);
begin
if not trayicon1.CycleIcons then
   begin
    if main_oldz>0 then
      begin
      if main_oldz=1 then top:=0;
      if main_oldz=2 then left:=screen.width-width;
      if main_oldz=3 then left:=0;
      main_oldz:=0;
      end;
    trayicon1.ShowMainForm;
    Application.BringToFront;
   end else stopflash;
end;

//------------------------------------------------------------------------------
// 查找好友
//------------------------------------------------------------------------------
procedure Tmainfrm.btn_findClick(Sender: TObject);
begin
with Tsearch_user.create(application) do
   try
   showmodal;
   finally
   free;
   end;
end;

//------------------------------------------------------------------------------
// 主菜单
//------------------------------------------------------------------------------
procedure Tmainfrm.btn_menuClick(Sender: TObject);
begin
PopupAtCursor(mainmenu);
end;