www.pudn.com > QQ_FACE.rar > msg.pas
unit msg;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, RxRichEd, Buttons, dxsbar, Menus;
type
TFrmMsg = class(TForm)
GroupBox1: TGroupBox;
LabSendTo: TLabel;
PnlUserName: TPanel;
Panel2: TPanel;
ImgFace: TImage;
Label2: TLabel;
RedMsg: TRxRichEdit;
BtnSend: TBitBtn;
BtnChatLog: TBitBtn;
BtnCancle: TBitBtn;
LabQQNumber: TLabel;
BtnRevert: TBitBtn;
PnlTemp: TPanel;
Timer: TTimer;
RedChatLog: TRxRichEdit;
SaveDlg: TSaveDialog;
PMenu: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Copy2: TMenuItem;
procedure CreateParams(var Params:TCreateParams);override;
procedure BtnChatLogClick(Sender: TObject);
procedure RedMsgChange(Sender: TObject);
procedure BtnCancleClick(Sender: TObject);
procedure BtnSendClick(Sender: TObject);
procedure BtnRevertClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure RedMsgKeyPress(Sender: TObject; var Key: Char);
procedure TimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure RedChatLogMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMsg: TFrmMsg;
implementation
uses Var_Share, dm_share, main;
var
//这里定义的变量是为了在此窗体上显示好友头像的眼睛一眨一眨而设
bShow:Boolean;
{$R *.dfm}
procedure TFrmMsg.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
Params.WndParent:=GetDesktopWindow;
end;
procedure TFrmMsg.BtnChatLogClick(Sender: TObject);
var
s:string;
begin
if self.Height=285 then
begin
self.Height:=530;
RedChatLog.Clear;
DMShare.TblChatLog.Filtered:=False;
DMShare.TblChatLog.Filter:='QQNumber='''+LabQQNumber.Caption+'''';
DMShare.TblChatLog.Filtered:=True;
with DMShare.TblChatLog do
begin
while not Eof do
begin
if FieldValues['IsSender'] then
s:=FieldValues['UserName']+' -> '+sUserName+' '+DateTimeToStr(FieldValues['Time'])
else
s:=FieldValues['UserName']+' -> '+sUserName+' '+DateTimeToStr(FieldValues['Time']);
RedChatLog.Lines.Append(s);
RedChatLog.Lines.Append(FieldValues['Message']);
RedChatLog.Lines.Append('');
Next
end;
end;
DMShare.TblChatLog.Filtered:=False;
end
else
begin
self.Height:=285;
end;
end;
procedure TFrmMsg.RedMsgChange(Sender: TObject);
begin
BtnSend.Enabled:=True;
end;
procedure TFrmMsg.BtnCancleClick(Sender: TObject);
begin
Self.Hide;
Self.Close;
self.Release;
bShow:=True;
end;
procedure TFrmMsg.BtnSendClick(Sender: TObject);
var
MyStream:TMemoryStream;
sMsg:string;
begin
if RedMsg.Text='' then
begin
MessageBox(GetActiveWindow,'无法发送空信息!','提示',MB_OK+MB_ICONINFORMATION);
end
else
begin
RedMsg.ReadOnly:=True;//防止发送消息框在Close之前，消息的内容被非法修改，其实这一句也没有什么用，不加也没有关系
MyStream := TMemoryStream.Create;
try
DMShare.TblFriends.First;
DMShare.TblFriends.Locate('QQNumber',LabQQNumber.Caption,[]);
sMsg:='MSG'+'*'+sQQNumber+'*'+sUserName+'*'+IntToStr(iFaceID)+'*'+RedMsg.Text+'*';
MyStream.Write(sMsg[1],Length(sMsg));
with DMShare.Udp do
begin
LocalPort:=0;
RemotePort:=8088;
RemoteHost:=DMShare.TblFriends.FieldValues['IP'];
SendStream(Mystream);
end;
finally
MyStream.Free;
BtnCancle.Click;
end;
end;
bShow:=True;
bLeave:=False;//既然了消息了，那么你就不是离开状态了
FrmMain_QQ.ItmLeave1.Checked:=False;
FrmMain_QQ.ItmLeave2.Checked:=False;
FrmMain_QQ.ItmLeave3.Checked:=False;
FrmMain_QQ.ItmLeave4.Checked:=False;
//保存聊天记录
with DMShare.TblChatLog do
begin
Append;
FieldValues['QQNumber']:=LabQQNumber.Caption;
FieldValues['UserName']:=PnlUserName.Caption;
FieldValues['IsSender']:=False;
FieldValues['Time']:=Now;
FieldValues['Message']:=RedMsg.Text;
Post;
end;
end;
procedure TFrmMsg.BtnRevertClick(Sender: TObject);
begin
self.Caption:='发送消息';
LabSendTo.Caption:='发送给:';
BtnRevert.Enabled:=False;
RedMsg.ReadOnly:=False;
RedMsg.Lines.Clear;
RedMsg.Color:=clWindow;
RedMsg.SetFocus;
BtnSend.Enabled:=False;
end;
procedure TFrmMsg.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=vk_Return) and (ssCtrl in Shift) and (BtnSend.Enabled) then
begin
BtnSend.Click;
end;
end;
procedure TFrmMsg.RedMsgKeyPress(Sender: TObject; var Key: Char);
begin
if Key='*' then
begin
Key:='&';
end;
end;
procedure TFrmMsg.TimerTimer(Sender: TObject);
begin
if bShow then
begin
ImgFace.Picture.Bitmap.LoadFromFile(
ExtractFilePath(Application.ExeName)+'temp\'+LabQQNumber.Caption+'_1.bmp');
bShow:=False;
end
else
begin
ImgFace.Picture.Bitmap.LoadFromFile(
ExtractFilePath(Application.ExeName)+'temp\'+LabQQNumber.Caption+'_2.bmp');
bShow:=True;
end;
end;
procedure TFrmMsg.FormCreate(Sender: TObject);
var
i:integer;
begin
self.Height:=285;
{ for i := 0 to 253 do
begin
if WndRecArr[i].QQNum=self.LabQQNumber.Caption then
begin
WndRecArr[i].MyTimer.Interval:=300;
WndRecArr[i].MyTimer.OnTimer:=FrmMain_QQ.MyTimer;
WndRecArr[i].MyTimer.Enabled:=True;
end;
end;
}
end;
procedure TFrmMsg.FormShow(Sender: TObject);
var
i,j,ImgIdx:integer;
MyItem:TdxSideBarItem;
begin
//set the Timer.Enable:=Fasle
for i := 0 to 253 do
begin
if WndRecArr[i].QQNum=self.LabQQNumber.Caption then
begin
WndRecArr[i].MyTimer.Enabled:=False;
WndRecArr[i].MyTimer.Free;
Break;
end;
end;
//Set the SideBar.Groups[x].Items[y].LargeImage
for i := 0 to FrmMain_QQ.SideBar.GroupCount-1 do
begin
for j := 0 to FrmMain_QQ.SideBar.Groups[i].ItemCount-1 do
begin
if FrmMain_QQ.SideBar.Groups[i].Items[j].Tag=StrToInt(LabQQNumber.Caption) then
begin
MyItem:=FrmMain_QQ.SideBar.Groups[i].Items[j];
DMShare.TblFriends.First;
DMShare.TblFriends.Locate('QQNumber',LabQQNumber.Caption,[]);
ImgIdx:=DMShare.TblFriends.FieldValues['FaceID'];
MyItem.LargeImage:=ImgIdx;
MyItem.SmallImage:=ImgIdx;
Break;
end;
end;
end;
end;
procedure TFrmMsg.N3Click(Sender: TObject);
var
sFileName:string;
begin
if SaveDlg.Execute then
begin
sFileName:=SaveDlg.FileName;
if sFileName<>'' then
begin
if UpperCase(Copy(sFileName,Length(sFileName)-4,4))<>'.TXT' then
begin
sFileName:=sFileName+'.TXT';
end;
RedChatLog.Lines.SaveToFile(sFilename);
end;
end;
end;
procedure TFrmMsg.N1Click(Sender: TObject);
begin
RedChatLog.SelectAll;
end;
procedure TFrmMsg.RedChatLogMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Pos:TPoint;
begin
if Button=mbRight then
begin
GetCursorPos(Pos);
PMenu.Popup(Pos.x,Pos.Y);
end;
end;
end.