talkrecunt.pas

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

unit talkrecunt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, xpButton, Menus,constunt,structureunt;
  
type
  Ttalkrecfrm = class(TForm)
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Panel1: TPanel;
    history_memo: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure process_custom_message(var msg:tmessage);message refresh_status;
    procedure addmsgtomemo(isme:boolean;dt:tdatetime;firendname,msg:string);
    procedure gethistorymsg;
    procedure formmove;
  public
    firendid:string;
    { Public declarations }
  end;

implementation
uses shareunit,udpcores,richunt;
{$R *.DFM}

//------------------------------------------------------------------------------
// 窗体事件
//------------------------------------------------------------------------------
procedure Ttalkrecfrm.FormCreate(Sender: TObject);
begin
addhwnd(handle);
udpcore.changeLayered(handle);
initrichedit(history_memo);
end;

procedure Ttalkrecfrm.FormClose(Sender: TObject;
  var Action: TCloseAction);
var tmp:userinfo;
begin
delhwnd(handle);
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    tmp.hishwnd:=0;
    udpcore.user.modifyuser(firendid,tmp);
    end;
action:=cafree;
Ttalkrecfrm(sender):=nil;
end;

procedure Ttalkrecfrm.FormShow(Sender: TObject);
begin
gethistorymsg;
end;

procedure Ttalkrecfrm.process_custom_message(var msg:tmessage);
begin
case msg.WParam of
  xy_form_close:close;
  xy_form_move:formmove;
  xy_form_mini:hide;
  xy_form_restore:show;
  end;
end;

procedure Ttalkrecfrm.formmove;
var tmp:userinfo;
begin
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    Ttalkrecfrm(self).left:=tmp.dx;
    Ttalkrecfrm(self).top:=tmp.dy+1;
    Ttalkrecfrm(self).width:=tmp.dw;
    end;
end;

//------------------------------------------------------------------------------
// 添加消息到 main_memo
//------------------------------------------------------------------------------
procedure Ttalkrecfrm.addmsgtomemo(isme:boolean;dt:tdatetime;firendname,msg:string);
begin
rolltoend(history_memo);
firendnamefont(history_memo,isme);
history_memo.Lines.add(firendname+'('+datetimetostr(dt)+')');
firendfont(history_memo,isme);
history_memo.lines.add(msg);
rolltoend(history_memo);
end;

procedure Ttalkrecfrm.gethistorymsg;
var tmp:pchatrec;
    p,q:userinfo;
    uname:string;
    i:integer;
begin
if udpcore.user.checkuser(firendid) then
    begin
    p:=udpcore.user.getuserinfoex(firendid);
    q:=udpcore.user.getuserinfoex(0);
    if udpcore.chat.getcount>0 then
    for i:=udpcore.chat.getcount downto 1 do
       begin
       tmp:=udpcore.chat.getidtochatrec(i);
       if (not tmp.nullity)and(tmp.readok)and(tmp.firendid=p.md5name) then
          begin
          if tmp.sendok then uname:=p.uname else uname:=q.uname;
          addmsgtomemo(tmp.sendok,tmp.msgtime,uname,strpas(tmp.msgtext));
          end;
       end;
    end;
history_memo.SelStart:=0;
end;

//------------------------------------------------------------------------------
// 复制
//------------------------------------------------------------------------------
procedure Ttalkrecfrm.N1Click(Sender: TObject);
begin
history_memo.CopyToClipboard;
end;

procedure Ttalkrecfrm.N2Click(Sender: TObject);
begin
history_memo.SelectAll;
end;

end.