dialogunt.pas

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

//------------------------------------------------------------------------------
// 侧边条
//------------------------------------------------------------------------------
procedure Tdialogfrm.sidebtnClick(Sender: TObject);
begin
panel10.Visible:=not panel10.Visible;
sidehide:=not panel10.visible;
end;

//------------------------------------------------------------------------------
// 设置字体
//------------------------------------------------------------------------------
procedure Tdialogfrm.SpeedButton7Click(Sender: TObject);
begin
if udpcore.myfont.Execute then
   send_memo.Font:=udpcore.myfont.Font;
end;

//------------------------------------------------------------------------------
// 表情图标
//------------------------------------------------------------------------------
procedure Tdialogfrm.SpeedButton8Click(Sender: TObject);
var mouse:tpoint;
begin
getcursorpos(mouse);
with phizfrm do
  begin
  msghandle:=Tdialogfrm(self).handle;
  left:=mouse.x-5;
  top:=mouse.y-5;
  show;
  end;
end;

//------------------------------------------------------------------------------
// 显示详细资料
//------------------------------------------------------------------------------
procedure Tdialogfrm.mypicClick(Sender: TObject);
var msg:string;
begin
makeparamsex(msg,'msgid',xy_user);
makeparamsex(msg,'funid',xy_detail);
udpcore.sendtouser(firendid,msg);
udpcore.showfirendinfo(firendid);
end;
//------------------------------------------------------------------------------
// 插入图片
//------------------------------------------------------------------------------
procedure Tdialogfrm.insert_phiz(s:string);
var filenames:string;
begin
filenames:=udpcore.pic.getmd5tofile(s);
send_memo.Insertpicture(filenames);
end;

//------------------------------------------------------------------------------
// 自定义消息
//------------------------------------------------------------------------------
procedure Tdialogfrm.process_custom_message(var msg:tmessage);
begin
case msg.WParam of
  xy_phiz:insert_phiz(phizfrm.sel_md5str);
  xy_message:readnextmsg;
  xy_form_close:close;
  xy_infor:showfirendinfo;
  xy_downpic_starting:initdownpicfile;
  xy_downpic_outtime:downpicclientstop;
  xy_downpic_complete:downpicclientcomplete;
  end;
end;
//------------------------------------------------------------------------------
// 添加消息到 main_memo
//------------------------------------------------------------------------------
procedure Tdialogfrm.addmsgtomemo(isme:boolean;dt:tdatetime;firendname,msg:string);
var startpos:integer;
    str:string;
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);
str:=parsemd5topicture(true,startpos,main_memo);
parsechartopicture(startpos,main_memo);
rolltoend(Trichedit(main_memo));
if not isme then request_picfile(str);
end;

//------------------------------------------------------------------------------
// 发送消息
//------------------------------------------------------------------------------
procedure Tdialogfrm.sendmessager;
var msg,msgex:string;
    tmp:userinfo;
begin
tmp:=udpcore.user.getuserinfoex(0);
strtopic(0,trichedit(send_memo));
msg:=parsepicturetomd5(send_memo);
if length(msg)>0 then
   begin
   if msg[length(msg)]<>chr(10) then msg:=msg+chr(10);
   addmsgtomemo(true,now,tmp.uname,msg);
   //---------------------------------------------------------------------------
   //发送,并添加到聊天记录 过程
   //---------------------------------------------------------------------------
   makeparamsex(msgex,'msgid',xy_message);
   makeparamsex(msgex,'funid',xy_usertext);
   makeparamsex(msgex,'msgtext',msg);
   makeparamsex(msgex,'firendid',tmp.md5name);
   makeparamsex(msgex,'fontname',send_memo.font.name);
   makeparamsex(msgex,'fontsize',send_memo.font.size);
   makeparamsex(msgex,'fontcolor',send_memo.font.color);
   makeparamsex(msgex,'fontstyle',destyle(send_memo.font.style));
   makeparamsex(msgex,'dt',datetimetostr(now));
   udpcore.chat.addusertext(firendid,msgex,true,true);
   udpcore.sendtouser(firendid,msgex);
   end;
end;

procedure Tdialogfrm.BitBtn6Click(Sender: TObject);
begin
sendmessager;
end;

//------------------------------------------------------------------------------
// 显示收到的消息
//------------------------------------------------------------------------------
procedure Tdialogfrm.readnextmsg;
var params:string;
    tmp:userinfo;
    i:integer;
begin
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    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
         begin
         expandmemo.Delete(i-1);
         udpcore.tempfont.Font.Name:=getparamitem(params,'fontname');
         udpcore.tempfont.Font.size:=strtoint(getparamitem(params,'fontsize'));
         udpcore.tempfont.Font.color:=strtoint(getparamitem(params,'fontcolor'));
         udpcore.tempfont.Font.style:=enstyle(getparamitem(params,'fontstyle'));
         addmsgtomemo(false,strtodatetime(getparamitem(params,'dt')),
                     tmp.uname,getparamitem(params,'msgtext'));
         end;
      end;
    end;
if GetForegroundWindow<>handle then flashwindow(handle,true);
end;

//------------------------------------------------------------------------------
// 回显历史记录
//------------------------------------------------------------------------------
procedure Tdialogfrm.loadhistoryrec;
var tmp:pchatrec;
    p,q:userinfo;
    i:integer;
    uname:string;
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:=1 to udpcore.chat.getcount do
       begin
       tmp:=udpcore.chat.getidtochatrec(i);
       if (not tmp.nullity)and(not tmp.readok)
          and(tmp.firendid=p.md5name) then
          begin
          tmp.readok:=true;
          udpcore.chat.modifychatrec(i,tmp);
          if tmp.sendok then uname:=q.uname else uname:=p.uname;
          addmsgtomemo(tmp.sendok,tmp.msgtime,uname,strpas(tmp.msgtext));
          end;
       end;
    end;
end;

procedure Tdialogfrm.xpButton2Click(Sender: TObject);
var tmp:userinfo;
begin
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    if tmp.hishwnd>0 then
       postmessage(tmp.hishwnd,refresh_status,xy_form_close,0)
       else udpcore.createhisform(firendid);
    end;
end;

//------------------------------------------------------------------------------
// 发送图片文件
//------------------------------------------------------------------------------
procedure Tdialogfrm.SpeedButton9Click(Sender: TObject);
var newfilename,
    img_path,
    md5str:string;
    pic:TPicture;
begin
with topendialog.Create(nil) do
   try
   Title:='选择要发送的图片文件';
   Filter:='图片文件|*.bmp;*.jpg;*.jpeg;*.gif';
   img_path:=extractfilepath(application_name)+'images\';
   InitialDir:=img_path;
   if execute then
     try
     pic:=TPicture.Create;
      try
      pic.LoadFromFile(filename);
      md5str:='{'+md5encodefile(filename)+'}';
      if (extractfilepath(filename)<>img_path)
          and(not udpcore.pic.checkmd5pic(md5str)) then
        begin
        newfilename:=img_path+md5str+extractfileext(filename);
        copyfile(pchar(filename),pchar(newfilename),true);
        udpcore.pic.addpictolist(newfilename);
        end;
       send_memo.Insertpicture(filename);
      except
       on EInvalidGraphic do
         pic:= nil;
      end;
    finally
     freeandnil(pic);
    end;
  finally
  free;
  end;
end;

//------------------------------------------------------------------------------
// 截屏
//------------------------------------------------------------------------------
procedure Tdialogfrm.SpeedButton10Click(Sender: TObject);
var filenames:string;
begin
with Tcopy_screen.Create(nil) do
  try
  showmodal;
  filenames:=copytofile;
  finally
  free;
  end;
if fileexists(filenames) then
   begin
   udpcore.pic.addpictolist(filenames);
   send_memo.Insertpicture(filenames);
   end;
end;

//------------------------------------------------------------------------------
// 请求图形文件下载
//------------------------------------------------------------------------------
procedure Tdialogfrm.request_picfile(str:string);
var myinfo:userinfo;
    msgex,md5str:string;
begin
if str<>'' then downpiclist.Add(str);
if not downpic.just_receiving then
if downpiclist.Count>0 then
   begin
   md5str:=downpiclist.strings[0];
   if (length(md5str)=34) and
      (md5str[1]='{') and (md5str[34]='}') then
     begin
     myinfo:=udpcore.user.getuserinfoex(0);
     makeparamsex(msgex,'msgid',xy_downpic);
     makeparamsex(msgex,'funid',xy_request);
     makeparamsex(msgex,'firendid',myinfo.md5name);
     makeparamsex(msgex,'picmd5code',md5str);
     downpic.sendmsgtosvr(msgex);
     end else downpiclist.Delete(0);
   end
end;

//------------------------------------------------------------------------------
// 收到请求开始准备传输图片
//------------------------------------------------------------------------------
procedure Tdialogfrm.initdownpicfile;
var i:integer;
    picmd5,
    picfile,
    params:string;
begin
if expandmemo.count>0 then
for i:=1 to expandmemo.count do
  begin
  params:=expandmemo.strings[i-1];
  if getparamitem(params,'msgid')=inttostr(xy_downpic) then
  if getparamitem(params,'firendid')=firendid then
  if getparamitem(params,'funid')=inttostr(xy_request) then
     begin
     expandmemo.Delete(i-1);
     picmd5:=getparamitem(params,'picmd5code');
     picfile:=udpcore.pic.getmd5tofile(picmd5);
     if not downpic.just_sending then 
     if fileexists(picfile) then
        begin
        downpic.sourcefile:=picfile;
        downpic.sourcemd5:=picmd5;
        downpic.destip:=getparamitem(params,'fromip');
        downpic.destport:=strtoint(getparamitem(params,'fromport'));
        downpic.just_sending:=true;
        downpic.succeedconnect:=true;
        downpic.handshake(xy_succeed_handshake); //确认连接
        end;
     end;
  end;
end;

//------------------------------------------------------------------------------
// 因对方服务端退出.请求方超时退出
//------------------------------------------------------------------------------
procedure Tdialogfrm.downpicclientstop;
begin
downpic.just_receiving:=false;
end;

//------------------------------------------------------------------------------
// 请求方图片完成.
//------------------------------------------------------------------------------
procedure tdialogfrm.downpicclientcomplete;
var md5str:String;
    n:integer;
begin
md5str:=downpic.destmd5;
udpcore.pic.addpictolist(downpic.destfile);
n:=downpiclist.IndexOf(md5str);
downpiclist.Delete(n);
downpic.just_receiving:=false;
request_picfile('');
paraspicture(0,md5str,main_memo);
rolltoend(Trichedit(main_memo));
refreshfirendpic;
end;

//------------------------------------------------------------------------------
// 发文件
//------------------------------------------------------------------------------
procedure Tdialogfrm.SpeedButton3Click(Sender: TObject);
begin
with topendialog.create(nil) do
  try
  Title:='选择要发送的文件.';
  Filter:='所有文件(*.*)|*.*';
  Options:=[ofFileMustExist,ofAllowMultiSelect];
  if execute then udpcore.createfiletranfrom(firendid,files.text,extractfilepath(files.strings[0]));
  finally
  free;
  end;
end;

procedure Tdialogfrm.SpeedButton2Click(Sender: TObject);
begin
udpcore.createavfrom(firendid);
end;

procedure Tdialogfrm.SpeedButton4Click(Sender: TObject);
begin
udpcore.createremotesvrfrm(firendid);
end;

end.