mainunt.pas

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

procedure Tmainfrm.PopupAtCursor(popupmenu:tpopupmenu);
var
  CursorPos: TPoint;
begin
  if Assigned(PopupMenu) then
    if PopupMenu.AutoPopup then
      if GetCursorPos(CursorPos) then
      begin
        Application.ProcessMessages;
        SetForegroundWindow(handle);
        if Owner is TWinControl then
          SetForegroundWindow((Owner as TWinControl).Handle);
        PopupMenu.PopupComponent := Self;
        PopupMenu.Popup(CursorPos.X, CursorPos.Y);
        if Owner is TWinControl then
         PostMessage((Owner as TWinControl).Handle, WM_NULL, 0, 0)
      end;
end;

//------------------------------------------------------------------------------
// 用户列表处理过程
//------------------------------------------------------------------------------

procedure Tmainfrm.userbarResize(Sender: TObject);
begin
userbar.Settings.LargeWidth:=userbar.width;
end;

procedure Tmainfrm.userbarMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var m,n:integer;
begin
if userbar.ActiveHeaderIndex<>-1 then
  begin
  userbar.GetItemAt(x,y,n,m);
   if (not m<0)and(not n<0) then
      cur_seluser:=userbar.Header[n].Buttons[m].UserString;
  end;
end;

//------------------------------------------------------------------------------
//  显示好友资料
//------------------------------------------------------------------------------
procedure Tmainfrm.N9Click(Sender: TObject);
begin
if cur_seluser<>'' then
   udpcore.showfirendinfo(cur_seluser);
end;

//------------------------------------------------------------------------------
// 打开聊天窗口
//------------------------------------------------------------------------------
procedure Tmainfrm.userbar_useridClick(Sender: TObject);
begin
if cur_seluser<>'' then
   begin
   if trayicon1.CycleIcons and (cur_seluser=trayicon1.md5name) then
      stopflash else udpcore.createdlgform(cur_seluser);
   end;
end;

procedure Tmainfrm.Windows1Click(Sender: TObject);
begin
if cur_seluser<>'' then
   udpcore.createbroadcastfrm(cur_seluser);
end;

//------------------------------------------------------------------------------
//  初始化 自动回复语
//------------------------------------------------------------------------------
procedure Tmainfrm.onlineClick(Sender: TObject);
var tmp:userinfo;
begin
clear_status_item;
Tmenuitem(sender).checked:=true;
tmp:=udpcore.user.getuserinfoex(0);
tmp.status:=1;
if sender=online then tmp.status:=0;
if sender=hideline then tmp.status:=2;
if sender=downline then tmp.status:=3;
udpcore.user.modifyuser(tmp.md5name,tmp);
if tmp.status=1 then
   begin
   outline.Checked:=true;
   revertmsg:=Tmenuitem(sender).hint;
   end;
show_myinfor;
udpcore.query_firend_status(tmp.status);
end;

procedure Tmainfrm.status_popupPopup(Sender: TObject);
var tmp:tmenuitem;
    i:integer;
begin
status_popup.Items.Items[1].Clear;
if msgmemo.count>0 then
for i:=msgmemo.count downto 1 do
  begin 
  tmp:=tmenuitem.create(nil);
  tmp.RadioItem:=true;
  tmp.GroupIndex:=1;
  tmp.hint:=msgmemo.Strings[i-1];
  tmp.caption:=msgmemo.Strings[i-1];
  if tmp.Hint=revertmsg then tmp.Checked:=true;
  tmp.OnClick:=onlineclick;
  status_popup.Items.Items[1].add(tmp);
  end;
end;

procedure Tmainfrm.Label1Click(Sender: TObject);
begin
PopupAtCursor(status_popup);
end;

//------------------------------------------------------------------------------
//  刷新在线用户
//------------------------------------------------------------------------------
procedure Tmainfrm.N41Click(Sender: TObject);
begin
udpcore.query_firend_status(0);
refreshlist_userbar;
end;

//------------------------------------------------------------------------------
// 查看所有聊天记录
//------------------------------------------------------------------------------
procedure Tmainfrm.btn_msgClick(Sender: TObject);
begin
udpcore.createhisform;
end;

//------------------------------------------------------------------------------
// 拖动用户 改变他们的好友组
//------------------------------------------------------------------------------
procedure Tmainfrm.userbarDragOver(Sender: TmxOutlookBarPro;
  Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
  Mode: TmxDropMode; var Effect: Integer; var Accept: Boolean);
var sysgroup,sysgroupname:string;
    p:userinfo;
begin
sysgroup:=userbar.ActiveHeader.name;
sysgroupname:=userbar.ActiveHeader.Caption;
accept:=(sysgroup<>'latelylist') and (cur_seluser<>'');
if accept then
   begin
   if udpcore.user.checkuser(cur_seluser) then
       begin
       p:=udpcore.user.getuserinfoex(cur_seluser);
       p.groupid:=sysgroup;
       p.gname:=sysgroupname;
       udpcore.user.modifyuser(cur_seluser,p);
       end;
   end;
end;

procedure Tmainfrm.userbarMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if tmxbutton(sender).userstring='' then refreshlist_userbar;
end;

//------------------------------------------------------------------------------
// 改变的好友组  到 myfirends
//------------------------------------------------------------------------------
procedure Tmainfrm.N40Click(Sender: TObject);
var p:userinfo;
begin
if cur_seluser<>'' then
   begin
   deletebutton(cur_seluser);
   if udpcore.user.checkuser(cur_seluser) then
       begin
       p:=udpcore.user.getuserinfoex(cur_seluser);
       p.groupid:='myfirends';
       p.gname:='我的好友';
       udpcore.user.modifyuser(cur_seluser,p);
       end;
   refreshlist_userbar;
   end;
end;

//------------------------------------------------------------------------------
// 改变的好友组  到 blacklist
//------------------------------------------------------------------------------
procedure Tmainfrm.N53Click(Sender: TObject);
var p:userinfo;
begin
if cur_seluser<>'' then
   begin
   deletebutton(cur_seluser);
   if udpcore.user.checkuser(cur_seluser) then
       begin
       p:=udpcore.user.getuserinfoex(cur_seluser);
       p.groupid:='blacklist';
       p.gname:='黑名单';
       udpcore.user.modifyuser(cur_seluser,p);
       end;
   refreshlist_userbar;
   end;
end;

//------------------------------------------------------------------------------
// 删除用户
//------------------------------------------------------------------------------
procedure Tmainfrm.N7Click(Sender: TObject);
var p:userinfo;
begin
if cur_seluser<>'' then
   begin
   if udpcore.user.checkuser(cur_seluser) then
       begin
       p:=udpcore.user.getuserinfoex(cur_seluser);
       if p.userid<>loginuser then
          begin
          deletebutton(cur_seluser);
          p.nullity:=true;
          udpcore.user.modifyuser(cur_seluser,p);
          end;
       end;
   end;
end;

//------------------------------------------------------------------------------
// 新建好友组
//------------------------------------------------------------------------------
procedure Tmainfrm.N24Click(Sender: TObject);
var s1,s2:string;
begin
With Teditheaderfrm.create(application) do
  try
  Operation:='createheader';
  showmodal;
  finally
  s1:=str1;
  s2:=str2;
  free;
  end;
if (s1<>'')and(s2<>'') then createheader(s1,s2);
end;


//------------------------------------------------------------------------------
// 修改好友组
//------------------------------------------------------------------------------
procedure Tmainfrm.N36Click(Sender: TObject);
var s1,s2:string;
begin
s1:=userbar.ActiveHeader.name;
s2:=userbar.ActiveHeader.caption;
if (s1='myfirends')or
   (s1='blacklist')or
   (s1='latelylist') then
   showmessage('不能修改系统默认的组')
   else begin
    With Teditheaderfrm.create(application) do
      try
      Operation:='modifyheader';
      str1:=s1;str2:=s2;
      showmodal;
      finally
      s1:=str1;
      s2:=str2;
      free;
      end;
    udpcore.user.modifygroup(s1,s2);
    userbar.HeaderByName(s1).caption:=s2;
   end;
end;
//------------------------------------------------------------------------------
// 删除好友组
//------------------------------------------------------------------------------
procedure Tmainfrm.N29Click(Sender: TObject);
var sysgroup:string;
    n:integer;
begin
sysgroup:=userbar.ActiveHeader.name;
if (sysgroup='myfirends')or
   (sysgroup='blacklist')or
   (sysgroup='latelylist') then
   showmessage('不能删除系统默认的组')
   else begin
   n:=userbar.HeaderIndexByName(sysgroup);
   userbar.headers.Delete(n);
   userbar.activeheader:=userbar.header[0];
   udpcore.user.delgroup(sysgroup);
   refreshlist_userbar;
   end;
end;


//------------------------------------------------------------------------------
// 双击改变窗体渲染色
//------------------------------------------------------------------------------
procedure Tmainfrm.Panel1DblClick(Sender: TObject);
begin
udpcore.changeskin;
repaint;
end;

//------------------------------------------------------------------------------
//  定时计划任务检查
//------------------------------------------------------------------------------
procedure Tmainfrm.checktasklist;
var i:integer;
    tmptask:Ttaskinfo;
begin
if udpcore.task.getcount>0 then
for i:=1 to udpcore.task.getcount do
   begin
   tmptask:=udpcore.task.gettaskinfoex(i);
   if (not tmptask.nullity)and(tmptask.msgtime<now) then
       udpcore.process_tasklist(tmptask);
   end;
end;

//------------------------------------------------------------------------------
// 消息定时队列管理
//------------------------------------------------------------------------------
procedure Tmainfrm.N37Click(Sender: TObject);
begin
udpcore.createtaskmainfrm;
end;

//------------------------------------------------------------------------------
// 发送多个文件
//------------------------------------------------------------------------------
procedure Tmainfrm.N63Click(Sender: TObject);
begin
if cur_seluser<>'' then
   udpcore.sendmutilfile(cur_seluser);
end;

//------------------------------------------------------------------------------
// 发送一个目录
//------------------------------------------------------------------------------
procedure Tmainfrm.N48Click(Sender: TObject);
begin
if cur_seluser<>'' then
   udpcore.senddirectory(cur_seluser);
end;

//------------------------------------------------------------------------------
// 拖放文件
//------------------------------------------------------------------------------
procedure Tmainfrm.userbarDragDrop(Sender: TmxOutlookBarPro;
  Source: TObject; DataObject: IDataObject; const Formats: array of Word;
  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TmxDropMode);
Var
  medium: TStgMedium;
  DropFiles: PDropFiles;
  Filename: PChar;
  tmplist:tstringlist;
  m,n:integer;
begin
try
tmplist:=tstringlist.create;
userbar.GetItemAt(Pt.x,Pt.y,n,m);
if (not m<0)and(not n<0) then
   cur_seluser:=userbar.Header[n].Buttons[m].UserString;

  { You need to change this code to your own }
  if cur_seluser<>'' then
  If Mode = dmButton Then
  Begin
    If ( DataObject.GetData( HDropFormatEtc, medium ) <> S_OK ) Then exit;
    Try
      If ( medium.tymed = TYMED_HGLOBAL ) Then
      Begin
        DropFiles := PDropFiles( GlobalLock( medium.HGlobal ) );
        Try
          Filename := PChar( DropFiles ) + DropFiles^.pFiles;
          While ( Filename^ <> #0 ) Do
            If ( DropFiles^.fWide ) Then
               Begin
               tmplist.Add(PWideChar( FileName ));
               Inc( Filename, ( Length( PWideChar( FileName ) ) + 1 ) * 2 );
               End Else Begin
               tmplist.Add(PWideChar( FileName ));
               Inc( Filename, Length( Filename ) + 1 );
               End;
          if tmplist.Count>0 then
             udpcore.createfiletranfrom(cur_seluser,tmplist.text,extractfilepath(tmplist.strings[0]));
        Finally
          GlobalUnlock( medium.HGlobal );
        End;
      End;
    Finally
      ReleaseStgMedium( medium );
    End;
  End;
  
finally
freeandnil(tmplist);
end;

end;

//------------------------------------------------------------------------------
// 发送系统广播
//------------------------------------------------------------------------------
procedure Tmainfrm.N4Click(Sender: TObject);
begin
udpcore.createbroadcastfrm;
end;

procedure Tmainfrm.N2Click(Sender: TObject);
begin
opencmd(autopath);
end;

procedure Tmainfrm.N64Click(Sender: TObject);
begin
if cur_seluser<>'' then
   udpcore.createavfrom(cur_seluser);
end;

//------------------------------------------------------------------------------
// 设置透明度
//------------------------------------------------------------------------------
procedure Tmainfrm.N1Click(Sender: TObject);
begin
if sender=n1 then skinclarity:=255;
if sender=n851 then skinclarity:=215;
if sender=n651 then skinclarity:=165;
if sender=n451 then skinclarity:=115;
if sender=n251 then skinclarity:=65;
Tmenuitem(sender).checked:=true;
end;

procedure Tmainfrm.claritymenuPopup(Sender: TObject);
begin
if skinclarity=255 then n1.Checked:=true;
if skinclarity=215 then n851.Checked:=true;
if skinclarity=165 then n651.Checked:=true;
if skinclarity=115 then n451.Checked:=true;
if skinclarity=65 then n251.Checked:=true;
end;

procedure Tmainfrm.N18Click(Sender: TObject);
begin
with Tselectfrm.create(nil) do
  try
  showmodal;
  finally
  free;
  end;
end;

procedure Tmainfrm.N20Click(Sender: TObject);
begin
if cur_seluser<>'' then
   udpcore.createremotesvrfrm(cur_seluser);
end;

end.