⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 msg.pas

📁 一个QQ的界面源码
💻 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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -