historyunt.pas

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

unit historyunt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, ExtCtrls, StdCtrls, OLERichEdit,constunt,structureunt,
  xpButton;

type
  Thistoryfrm = class(TForm)
    CoolBar1: TCoolBar;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    Splitter1: TSplitter;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    Splitter2: TSplitter;
    ListView1: TListView;
    Panel1: TPanel;
    main_memo: TOLEEdit;
    Panel2: TPanel;
    xpButton1: TxpButton;
    xpButton2: TxpButton;
    Edit1: TEdit;
    xpButton3: TxpButton;
    procedure FormShow(Sender: TObject);
    procedure Splitter2CanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure ListView1Click(Sender: TObject);
    procedure xpButton1Click(Sender: TObject);
    procedure xpButton2Click(Sender: TObject);
    procedure xpButton3Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    curpage:integer;
    firendid:string;
    procedure createuserlist;
    procedure showfirendmsg;
    procedure addmsgtomemo(isme:boolean;dt:tdatetime;firendname,msg:string);
    procedure savechattolog(filename:string);
    procedure clearchatlog;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  historyfrm: Thistoryfrm;

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

//------------------------------------------------------------------------------
// 建立用户列表
//------------------------------------------------------------------------------
procedure Thistoryfrm.createuserlist;
var i,n:integer;
    tmp:userinfo;
begin
n:=0;
listview1.items.Clear;
if udpcore.user.getcount>0 then
for i:=1 to udpcore.user.getcount do
  begin
  tmp:=udpcore.user.getuserinfoex(i-1);
  if not tmp.nullity then
   with listview1.Items.Add,SubItems do
     begin
     imageindex:=0;
     caption:=tmp.uname+'('+tmp.userid+')';
     add(tmp.md5name);
     inc(n);
     end;
  end;
statusbar1.Panels.Items[1].Text:=inttostr(n);
end;

//------------------------------------------------------------------------------
// 添加消息到 main_memo
//------------------------------------------------------------------------------
procedure Thistoryfrm.addmsgtomemo(isme:boolean;dt:tdatetime;firendname,msg:string);
var startpos:integer;
begin
startpos:=length(main_memo.text);
rolltoend(Trichedit(main_memo));
firendnamefont(Trichedit(main_memo),isme);
main_memo.Lines.add(firendname+'('+datetimetostr(dt)+')');
firendfont(Trichedit(main_memo),isme);
main_memo.lines.add(msg);
parsemd5topicture(false,startpos,main_memo);
rolltoend(Trichedit(main_memo));
end;

//------------------------------------------------------------------------------
// 显示当前用户的聊天记录
//------------------------------------------------------------------------------
procedure Thistoryfrm.showfirendmsg;
var i,n:integer;
    uname:string;
    tmp:pchatrec;
    p,q:userinfo;
begin
n:=0;
if curpage<1 then curpage:=1;
initrichedit(Trichedit(main_memo));
if udpcore.user.checkuser(firendid) then
   begin
    q:=udpcore.user.getuserinfoex(0);
    p:=udpcore.user.getuserinfoex(firendid);
    if udpcore.chat.getcount>0 then
    for i:=1 to udpcore.chat.getcount do
      begin
      tmp:=udpcore.chat.getidtochatrec(i);
      if (tmp.firendid=firendid)and(not tmp.nullity) then
         begin
         inc(n);
         if (n>=curpage)and(n<curpage+10) 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;
    end;
xpButton2.Enabled:=curpage+10<=n;
statusbar1.Panels.Items[3].Text:=inttostr(n);
statusbar1.Panels.Items[5].Text:=inttostr(curpage);
end;


//------------------------------------------------------------------------------
// 导出聊天记录
//------------------------------------------------------------------------------
procedure Thistoryfrm.savechattolog(filename:string);
var i:integer;
    tmp:pchatrec;
    uname:string;
    p,q:userinfo;
    tmpmemo:tstringlist;
begin
try
tmpmemo:=tstringlist.create;
if udpcore.user.checkuser(firendid) then
    begin
    q:=udpcore.user.getuserinfoex(0);
    p:=udpcore.user.getuserinfoex(firendid);
    if udpcore.chat.getcount>0 then
    for i:=1 to udpcore.chat.getcount do
      begin
      tmp:=udpcore.chat.getidtochatrec(i);
      if (tmp.firendid=firendid)and(not tmp.nullity) then
         begin
         if tmp.sendok then uname:=p.uname else uname:=q.uname;
         tmpmemo.add(uname+'('+datetimetostr(tmp.msgtime)+')');
         tmpmemo.add(strpas(tmp.msgtext));
         tmpmemo.add(#13#10);
         end;
      end;
    end;
finally
tmpmemo.SaveToFile(filename);
freeandnil(tmpmemo);
end;
end;

//------------------------------------------------------------------------------
// 清除聊天记录
//------------------------------------------------------------------------------
procedure Thistoryfrm.clearchatlog;
var i:integer;
    tmp:pchatrec;
begin
if udpcore.chat.getcount>0 then
for i:=1 to udpcore.chat.getcount do
  begin
  tmp:=udpcore.chat.getidtochatrec(i);
  if (tmp.firendid=firendid)and(not tmp.nullity) then
     begin
     tmp.nullity:=true;
     udpcore.chat.modifychatrec(i,tmp);
     end;
  end;
end;

procedure Thistoryfrm.FormShow(Sender: TObject);
begin
createuserlist;
end;

procedure Thistoryfrm.Splitter2CanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
begin
accept:=false;
end;

procedure Thistoryfrm.ListView1Click(Sender: TObject);
begin
if listview1.SelCount>0 then
   begin
   curpage:=1;
   firendid:=listview1.Selected.SubItems[0];
   showfirendmsg;
   end;
end;

procedure Thistoryfrm.xpButton1Click(Sender: TObject);
begin
inc(curpage,-10);
showfirendmsg;
end;

procedure Thistoryfrm.xpButton2Click(Sender: TObject);
begin
inc(curpage,10);
showfirendmsg;
end;

procedure Thistoryfrm.xpButton3Click(Sender: TObject);
begin
curpage:=strtointdef(edit1.text,1);
showfirendmsg;
end;

procedure Thistoryfrm.ToolButton1Click(Sender: TObject);
var logfilename:string;
begin
if firendid<>'' then
with Tsavedialog.create(nil) do
   try
   Filter:='文本文件|*.txt';
   InitialDir:=extractfilepath(application_name);
   if execute then
      begin
      logfilename:=changefileext(filename,'.txt');
      savechattolog(logfilename);
      end;
   finally
   free;
   end;
end;

procedure Thistoryfrm.ToolButton2Click(Sender: TObject);
begin
clearchatlog;
end;

procedure Thistoryfrm.FormCreate(Sender: TObject);
begin
udpcore.changeLayered(handle);
end;

end.