clientunit.pas

IPXControl: 本软件是一个免费控件

      //去头
      Delete(TmpStr,1,Length('Rain_Update:'));
      OnLineUserUpdate(TmpStr);//更新用户列表
      //去用户列表
      Delete(TmpStr,1,Pos(',\n',TmpStr)+2);
  end;
  Memo2.Lines.add(TmpStr);
  //图表闪烁
  FlashTimer.Enabled:=True;
  UpdateTrayTip(TmpStr);
end;

procedure TChatClient.OnLineUserUpdate(TmpStr:string);
var
    str:string;
begin
    OnLineListBox.Clear;
    //Get the userlist
    TmpStr:=Copy(TmpStr,1,Pos(',\n',TmpStr));
    while Pos(',',TmpStr)<>0  do
    begin
       str:=Copy(TmpStr,1,Pos(',',TmpStr)-1);
       OnLineListBox.Items.Add(str);
       Delete(TmpStr,1,Pos(',',TmpStr))
    end;
end;
procedure TChatClient.EnableClient;
begin
   ClientConnected:=True;
   Statusbar1.Panels[0].Text:='正在连接服务器...';
   ClientSocket1.Open;
end;
procedure TChatClient.ValidateControls(Sender:TObject;var Done:Boolean);
begin
   if ClientConnected then
   begin
      SpeedButton1.Hint:='断开连接';
      ConnectMenuItem.Enabled:=False;
      ConnectPop.Enabled:=False;
      DisConnectMenuItem.Enabled:=True;
      DisConnectPop.Enabled:=True;
   end else
   begin
      SpeedButton1.Hint:='连接服务器';
      ConnectPop.Enabled:=True;
      ConnectMenuItem.Enabled:=True;
      DisConnectPop.Enabled:=False;
      DisConnectMenuItem.Enabled:=False;
   end;

end;

procedure TChatClient.MaxTray(Sender: TObject);
begin
  ShowWindow(Application.Handle,SW_NORMAL);
  Shell_NotifyIcon(NIM_DELETE,@Pnid);
end;                                                       //
                                                            //
procedure TChatClient.MiniTray(Sender: TObject);
begin                                                      //
  FlashTimer.Enabled:=False;
  FlashCount:=0;
  Pnid.hIcon:=Application.Icon.Handle;
  Shell_NotifyIcon(NIM_ADD,@Pnid);
  ShowWindow(Application.Handle,SW_HIDE);
  UpdateTrayTip('风雨同舟聊天室');
end;
//////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////
procedure TChatClient.WMmyicon(var MSG:Tmessage);           //
var                                                        //
  Pos:TPoint;                                              //
begin                                                      //
   if MSG.Msg   = WM_MYICON  then
    begin
      GetCursorPos(Pos);
       case MSG.LParam of                                       //
           WM_RBUTTONDOWN:
           begin
            SetForegroundWindow(Application.Handle);
            PopupMenu1.PopUp(Pos.x,Pos.y);
            PostMessage(pnid.wnd,WM_USER,0,0);
           end;
           WM_LBUTTONDBLCLK:
           begin
             OpenPopClick(Application);
             SetForegroundWindow(Application.Handle);
             FlashTimer.Enabled:=False;
             Pnid.hIcon:=Application.Icon.Handle;     
           end;

       end;
    end
    else
      DefWindowProc(Pnid.Wnd,MSG.MSG,MSG.wParam,MSG.lParam);     //
end;                                                       //

procedure TChatClient.UpdateTrayTip(TempStr:string);
begin
   StrCopy(Pnid.szTip,Pchar(TempStr));
   Shell_NotifyIcon(NIM_MODIFY,@Pnid);
end;
/////////////////////////////////////////////////////////////


procedure TChatClient.OpenPopClick(Sender: TObject);
begin
  Application.Restore;
  FlashTimer.Enabled:=False;
  Pnid.hIcon:=Application.Icon.Handle;
end;

procedure TChatClient.ConnectPopClick(Sender: TObject);
begin
  ConnectMenuItemClick(application);
end;

procedure TChatClient.DisConnectPopClick(Sender: TObject);
begin
   DisConnectMenuItemClick(Application);
end;

procedure TChatClient.ExitPopClick(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE,@Pnid);
  Close;
end;

procedure TChatClient.ExitClick(Sender: TObject);
begin
   ExitPopClick(application);
end;

procedure TChatClient.AutoRunMenuItemClick(Sender: TObject);
var
   RegF:TRegistry;
begin
   RegF:=TRegistry.Create;
   RegF.RootKey:=HKEY_LOCAL_MACHINE;
   AutoRunMenuItem.Checked:=not AutoRunMenuItem.Checked;
   if AutoRunMenuItem.Checked then //自动运行
   begin
      try
        RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
        RegF.WriteString('MultiChatClient',Application.ExeName);
      finally
        RegF.CloseKey;
        RegF.Free;
      end;
   end
   else                      //删除自动运行
   begin
      try
        RegF.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
        RegF.DeleteValue('MultiChatClient');
      finally
        RegF.CloseKey;
        RegF.Free;
      end;
   end;
end;

procedure TChatClient.FormPaint(Sender: TObject);
begin
   if AutoRunMenuItem.Checked and CanPaint then
   begin
     Shell_NotifyIcon(NIM_ADD,@Pnid);
     ShowWindow(Application.Handle,SW_MINIMIZE);
     ShowWindow(Application.Handle,SW_HIDE);
     UpdateTrayTip('风雨同舟聊天室');
   end;
   CanPaint:=False;
end;

procedure TChatClient.SpeedButton1Click(Sender: TObject);
begin
 OnLineListBox.Clear;
 if ClientConnected then
    DisConnectMenuItemClick(application)
 else
    ConnectMenuItemClick(Application);
end;

procedure TChatClient.CanSoundPopClick(Sender: TObject);
begin
   CanSoundPop.Checked:=not CanSoundPop.Checked;
   CanSound.Checked:=not CanSound.Checked;
end;

procedure TChatClient.CanSoundClick(Sender: TObject);
begin
   CanSoundPop.Checked:=not CanSoundPop.Checked;
   CanSound.Checked:=not CanSound.Checked;
end;

procedure TChatClient.A2Click(Sender: TObject);
begin
   AboutMenuItemClick(Application);
end;

procedure TChatClient.AboutMenuItemClick(Sender: TObject);
begin
   ShowMessage('     欢迎使用风雨同舟聊天室'+#13#10+'              RainChat Ver1.0'+#13#10+' http://rainsoft.home.chinaren.com');
end;

procedure TChatClient.FlashTimerTimer(Sender: TObject);
var
    MyIcon:TIcon;
begin
    if Flag then
    begin
     MyIcon:=TIcon.Create;
     ImageList1.GetIcon(0,MyIcon);
     Pnid.hIcon:=MyIcon.Handle;
     Shell_NotifyIcon(NIM_MODIFY,@Pnid);
    end
    else
    begin
     Pnid.hIcon:=Application.Icon.Handle;
     Shell_NotifyIcon(NIM_MODIFY,@Pnid);
    end;
    Flag:=not Flag;
    if FlashCount>19 then            //闪烁几次后退出
       if Flag then
       begin
         FlashTimer.Enabled:=False;
         FlashCount:=0;
       end;
    inc(FlashCount);
end;

procedure TChatClient.CheckBox1Click(Sender: TObject);
begin
   if not CheckBox1.Checked then
       OutSocket.SendText('Rain_Private:')
   else
       OnLineListBoxClick(nil);
end;

procedure TChatClient.OnLineListBoxClick(Sender: TObject);
var
   i:Integer;
   str:string;
begin
   if CheckBox1.Checked then
   begin
       for i:=0 to OnLineListBox.items.Count -1 do
       begin
         if OnLineListBox.Selected[i] then
                str:=str+OnLineListBox.Items[i]+',';
       end;
       OutSocket.SendText('Rain_Private:'+str);
   end;

end;

procedure TChatClient.Button1Click(Sender: TObject);
var
    sta:LongInt;
    str:string;
    Add:string;
begin
    if ClientSocket1.Address<>'' then
        Add:=ClientSocket1.Address
    else
        Add:=ClientSocket1.Host;
    sta:=startPhone(LPCTSTR(Add),1234,1235);
    case sta  of
       0:str := '网络电话正常打开';
      -1:str := '网络电话不能同时打开多个';
      -2:str := '主机地址错';
      -3:str := '网络套接字创建失败';
       1:str := '播音设备打开失败，播音设备被其他程序占用';
       2:str := '录音设备打开失败，可能声卡不支持全双工。';
       3:str := '无法锁定录音内存';
       4:str := '无法增加录音内存';
       5:str := '无法开始录音';
    end;
       ShowMessage(str);
end;

procedure TChatClient.Button2Click(Sender: TObject);
begin
  ClosePhone;
end;

end.