dialogunt.pas

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

unit dialogunt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, ExtCtrls, ComCtrls,Menus, xpButton, ActnList,
  jpeg,gifimage, constunt,structureunt, OLERichEdit,downpicunt;
type
  Tdialogfrm = class(TForm)
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N6: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    ActionList1: TActionList;
    Action1: TAction;
    PopupMenu3: TPopupMenu;
    N2: TMenuItem;
    n12: TMenuItem;
    SpeedButton5: TSpeedButton;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    SpeedButton7: TSpeedButton;
    Panel5: TPanel;
    xpButton2: TxpButton;
    BitBtn6: TxpButton;
    xpButton7: TxpButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    sidebtn: TSpeedButton;
    N3: TMenuItem;
    N4: TMenuItem;
    send_memo: TOLEEdit;
    main_memo: TOLEEdit;
    Panel1: TPanel;
    SpeedButton4: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Panel10: TPanel;
    mypic: TImage;
    adimg: TImage;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure main_memoContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure send_memoContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure N2Click(Sender: TObject);
    procedure n12Click(Sender: TObject);
    procedure xpButton7Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure sidebtnClick(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure SpeedButton7Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure mypicClick(Sender: TObject);
    procedure xpButton2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure PopupMenu3Popup(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
  private
    ismemo:boolean;
    downpiclist:tstringlist;
    downpic:Tdownpic;
    procedure formmove(var Msg: TMessage); message WM_MOVE;
    procedure formcomm(var msg:tmessage); message WM_SYSCOMMAND;
    procedure process_custom_message(var msg:tmessage);message refresh_status;
    procedure addmsgtomemo(isme:boolean;dt:tdatetime;firendname,msg:string);
    procedure insert_phiz(s:string);
    procedure sendmessager;
    procedure readnextmsg;
    procedure loadhistoryrec;
    procedure formmini;
    procedure formrestore;
    procedure request_picfile(str:string);
    procedure initdownpicfile;
    procedure downpicclientstop;
    procedure downpicclientcomplete;
    procedure showfirendinfo;
    procedure refreshfirendpic;
    { Private declarations }
  public
    firendid:string;
    { Public declarations }
  end;

implementation

uses udpcores,shareunit,phizunt,richunt,copyscreen;

{$R *.DFM}

//------------------------------------------------------------------------------
// 窗口事件
//------------------------------------------------------------------------------
procedure Tdialogfrm.CreateParams(var Params: TCreateParams);
begin
  inherited ;
  Params.WndParent := 0;
end;

procedure Tdialogfrm.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.dlghwnd:=0;
    udpcore.user.modifyuser(firendid,tmp);
    if tmp.hishwnd>0 then
       postmessage(tmp.hishwnd,refresh_status,xy_form_close,0);
    end;
postmessage(main_hwnd,refresh_status,xy_refresh_lately,0);
downpic.filetranover;
downpic.Free;
freeandnil(downpiclist);
action:=cafree;
Tdialogfrm(sender):=nil;
end;

procedure Tdialogfrm.FormResize(Sender: TObject);
begin
sidebtn.Left:=panel4.width-sidebtn.width;
xpButton7.left:=panel4.width-xpButton7.width;
BitBtn6.left:=panel4.width-BitBtn6.width-15;
end;

procedure Tdialogfrm.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
if newheight<350 then newheight:=350;
if newwidth<380 then newwidth:=380;
end;

procedure Tdialogfrm.formmove(var Msg: TMessage);
var tmp:userinfo;
begin
inherited;
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    tmp.dx:=Tdialogfrm(self).left;
    tmp.dy:=Tdialogfrm(self).top+Tdialogfrm(self).height;
    tmp.dw:=Tdialogfrm(self).width;
    udpcore.user.modifyuser(firendid,tmp);
    if tmp.hishwnd>0 then
       postmessage(tmp.hishwnd,refresh_status,xy_form_move,0);
    end;
end;

procedure Tdialogfrm.formmini;
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_mini,0);
    end;
end;

procedure Tdialogfrm.formrestore;
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_restore,0);
    end;
end;

procedure Tdialogfrm.formcomm(var msg:tmessage);
begin
inherited ;
case msg.WParam of
   SC_RESTORE:formrestore;
   SC_MINIMIZE:formmini;
   end;
end;
//------------------------------------------------------------------------------
// 窗口初始化
//------------------------------------------------------------------------------
procedure Tdialogfrm.FormCreate(Sender: TObject);
begin
addhwnd(handle);
udpcore.changeLayered(handle);
downpiclist:=tstringlist.create;
downpic:=Tdownpic.Create;
downpic.ownerhwnd:=handle;
panel10.Visible:=not sidehide;
initrichedit(Trichedit(main_memo));
initrichedit(Trichedit(send_memo));
if pressenter_send then action1.ShortCut:=ShortCut(13,[])
   else action1.ShortCut:=ShortCut(13,[ssCtrl]);
end;

procedure Tdialogfrm.FormShow(Sender: TObject);
var msg:string;
begin
makeparamsex(msg,'msgid',xy_user);
makeparamsex(msg,'funid',xy_detail);
udpcore.sendtouser(firendid,msg);
showfirendinfo;
loadhistoryrec;
end;


procedure Tdialogfrm.refreshfirendpic;
var tmp:userinfo;
    picfilename:string;
begin
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    if fileexists(picfilename)then
       begin
        try
        mypic.Picture.LoadFromFile(picfilename);
        except
          on EInvalidGraphic do
             mypic.Picture:= nil;
        end;
       end;
    end;
end;

procedure Tdialogfrm.showfirendinfo;
var tmp:userinfo;
    picfilename:string;
begin
if udpcore.user.checkuser(firendid) then
    begin
    tmp:=udpcore.user.getuserinfoex(firendid);
    caption:='与 '+tmp.uname+' 聊天中';
    downpic.svrip:=tmp.localip;
    downpic.svrport:=core_port;
    picfilename:=udpcore.pic.getmd5tofile(tmp.md5pic);
    if fileexists(picfilename)then
       begin
        try
        mypic.Picture.LoadFromFile(picfilename);
        except
          on EInvalidGraphic do
             mypic.Picture:= nil;
        end;
       end else request_picfile(tmp.md5pic);
       
    picfilename:=udpcore.pic.getmd5tofile(adpic);
    if fileexists(picfilename)then
        try
        adimg.Picture.LoadFromFile(picfilename);
        except
          on EInvalidGraphic do
             adimg.Picture:= nil;
        end;
    end;
end;
//------------------------------------------------------------------------------
// 复制菜单设置
//------------------------------------------------------------------------------
procedure Tdialogfrm.main_memoContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
ismemo:=TRUE;
n16.Enabled:=false;
n17.Enabled:=false;
end;

procedure Tdialogfrm.send_memoContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
ismemo:=FALSE;
n16.Enabled:=true;
n17.Enabled:=true;
end;

procedure Tdialogfrm.N1Click(Sender: TObject);
begin
IF ismemo then
Trichedit(main_memo).CopyToClipboard else
Trichedit(send_memo).copytoclipboard;
end;

procedure Tdialogfrm.N17Click(Sender: TObject);
begin
send_memo.Clear;
end;

procedure Tdialogfrm.N6Click(Sender: TObject);
begin
if ismemo then
Trichedit(main_memo).SelectAll else
Trichedit(send_memo).selectall;
end;

procedure Tdialogfrm.N16Click(Sender: TObject);
begin
Trichedit(send_memo).PasteFromClipboard;
end;

//------------------------------------------------------------------------------
// 另存图片
//------------------------------------------------------------------------------
procedure Tdialogfrm.N3Click(Sender: TObject);
var oldfile,newfile:string;
begin
if ismemo then
   oldfile:=main_memo.getpicfilename
   else oldfile:=send_memo.getpicfilename;

if fileexists(oldfile) then
   begin
    with tsavedialog.Create(nil) do
       try
       Title:='另存图片为';
       Filter:='图片文件|*.bmp;*.jpg;*.jpeg;*.gif';
       InitialDir:=extractfilepath(application_name);
       if execute then
          begin
          newfile:=changefileext(filename,extractfileext(oldfile));
          copyfile(pchar(oldfile),pchar(newfile),true);
          end;
       finally
       free;
       end;
   end;
end;
//------------------------------------------------------------------------------
// 发送键设置
//------------------------------------------------------------------------------
procedure Tdialogfrm.N2Click(Sender: TObject);
begin
n2.Checked:=true;
pressenter_send:=true;
if pressenter_send then action1.ShortCut:=ShortCut(13,[])
   else action1.ShortCut:=ShortCut(13,[ssCtrl]);
end;

procedure Tdialogfrm.n12Click(Sender: TObject);
begin
n12.Checked:=true;
pressenter_send:=false;
if pressenter_send then action1.ShortCut:=ShortCut(13,[])
   else action1.ShortCut:=ShortCut(13,[ssCtrl]);
end;

procedure Tdialogfrm.xpButton7Click(Sender: TObject);
var mouse:tpoint;
begin
getcursorpos(mouse);
popupmenu3.Popup(mouse.x,mouse.y);
end;

procedure Tdialogfrm.PopupMenu3Popup(Sender: TObject);
begin
n2.Checked:=pressenter_send;
n12.Checked:=not pressenter_send;
end;