关于类似于QQ的消息提示 ( 积分: 200 )

  • 主题发起人 主题发起人 claud
  • 开始时间 开始时间
C

claud

Unregistered / Unconfirmed
GUEST, unregistred user!
各位FW,
小弟没有接触过网络开发,请问如何开发类似于QQ的各种消息提示(右下角即时弹出框等)? 小弟只是感兴趣,如果分不够还可以加
MY QQ: 362608042
 
各位FW,
小弟没有接触过网络开发,请问如何开发类似于QQ的各种消息提示(右下角即时弹出框等)? 小弟只是感兴趣,如果分不够还可以加
MY QQ: 362608042
 
unit formPSHotKey;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;


{========================================================================
DESIGN BY : 彭国辉
DATE: 2004-10-28
SITE: http://kacarton.yeah.net/
BLOG: http://blog.csdn.net/nhconch
EMAIL: kacarton@sohu.com

文章为作者原创,转载前请先与本人联系,转载请注明文章出处、保留作者信息,谢谢支持!
=========================================================================}

type
TfrmPSHotKey = class(TForm)
imgTitleBar: TImage;
imgTitleBarBG: TImage;
imgShapeBG: TImage;
SpeedButton1: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
procedure FormPaint(Sender: TObject);
procedure imgTitleBarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Label11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormResize(Sender: TObject);
procedure Label12MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label13MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgTitleBarMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label11MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmPSHotKey: TfrmPSHotKey;

implementation

{$R *.dfm}

procedure TfrmPSHotKey.FormCreate(Sender: TObject);
begin
Tag := Height;
Height := 16;
//定位到屏幕右下角
Top := Screen.Height - 40;
Left := Screen.Width - Width - 2;
Show;
//从屏幕右下角逐渐弹出
while Height<Tag do begin
Height := Height + 5;
Top := Top - 5;
Update;
Application.ProcessMessages;
Sleep(10);
end;
Height := Tag;
Tag := 0;
Color := $F4BA9D;
FormResize(Sender);
end;

procedure TfrmPSHotKey.FormPaint(Sender: TObject);
var
i: integer;
rgn: HRGN;
r: TRect;
begin
with Canvas do begin
//利用imgTitleBarBG绘制标题背景
for i:=0 to ClientWidth div imgTitleBarBG.Width do
Draw(i*imgTitleBarBG.Width, 0, imgTitleBarBG.Picture.Bitmap);
if Tag<>0 then Exit; //如果窗体正在弹出状态,不绘制内容面板背景
//绘制内容面板背景
SetRect(r, 5, 15, Width-5, Height-5);
StretchDraw(r, imgShapeBG.Picture.Bitmap);
Pen.Color := $C97F55;
Brush.Style := bsClear;
RoundRect(r.Left, r.Top, r.Right, r.Bottom, 6, 6);
//绘制窗体边框
rgn := CreateRectRgn(0,0,0,0);
GetWindowRgn(Self.Handle, rgn);
Brush.Color := $BE796B;
windows.FrameRgn(Handle, rgn, Brush.Handle, 2, 2);
DeleteObject(rgn);
end;
end;

procedure TfrmPSHotKey.imgTitleBarMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//在标题按下鼠标键时,允许移动窗体或改变窗体大小
ReleaseCapture;
if X < 5 then Perform(WM_SYSCOMMAND, $F004, 0)
else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F005, 0)
else if Y < 3 then Perform(WM_SYSCOMMAND, $F003, 0)
else Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TfrmPSHotKey.FormResize(Sender: TObject);
var
rgn, rgn2: HRGN;
begin
if Tag<>0 then Exit;
//窗体改变大小时重建Rgn
rgn := CreateRoundRectRgn(0, 0, Width+1, Height, 4, 4);
rgn2 := CreateRectRgn(0, 11, Width, Height);
CombineRgn(rgn, rgn, rgn2, RGN_OR);
SetWindowRgn(Handle, rgn, True);
DeleteObject(rgn);
DeleteObject(rgn2);
Invalidate;
end;

procedure TfrmPSHotKey.SpeedButton1Click(Sender: TObject);
begin
Close;
end;

//以下几个Label用来改变窗体大小
procedure TfrmPSHotKey.Label11MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
if X < 5 then Perform(WM_SYSCOMMAND, $F007, 0)
else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F008, 0)
else Perform(WM_SYSCOMMAND, $F006, 0);
end;

procedure TfrmPSHotKey.Label12MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F001, 0);
end;

procedure TfrmPSHotKey.Label13MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F002, 0);
end;

//下面代码判断鼠标所在位置,并改变鼠标光标,提示用户可以拖动窗体或改变大小
procedure TfrmPSHotKey.imgTitleBarMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if X < 5 then imgTitleBar.Cursor := crSizeNWSE
else if X > Width - 5 then imgTitleBar.Cursor := crSizeNESW
else if Y < 3 then imgTitleBar.Cursor := crSizeNS
else imgTitleBar.Cursor := crSizeAll;
end;

procedure TfrmPSHotKey.Label11MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if X < 5 then Label11.Cursor := crSizeNESW
else if X > Width - 5 then Label11.Cursor := crSizeNWSE
else Label11.Cursor := crSizeNS;
end;

end.
http://www.delphibbs.com/keylife/iblog_show.asp?xid=15790
這裏有你要的答案
 
瞧瞧了。。。
 
各位大侠,
上面回答随是弹出式窗体,但我想要的样的弹出式窗体可以显示即时信息,及点击右下角那个一闪一闪的图标后出现一个信息框!
我的描述不太好,有意请QQ联系, 共同努力,提高技术
 
用ttrayicon控件可以实现
 
to All:
我想的是可以显示,及发送即时的。 大家帮忙想想
 
利用流制作自己的OICQ

OICQ是深圳腾讯公司的一个网络实时通讯软件,在国内拥有大量的用户群。但OICQ必须连接上互联网登陆到腾讯的服务器才能使用。所以我们可以自己写一个在局部网里面使用。

OICQ使用的是UDP协议,这是一种无连接协议,即通信双方不用建立连接就可以发送信息,所以效率比较高。Delphi本身自带的FastNEt公司的NMUDP控件就是一个UDP协议的用户数据报控件。不过要注意的是如果你使用了这个控件必须退出程序才能关闭计算机,因为TNMXXX控件有BUG。所有nm控件的基础 PowerSocket用到的ThreadTimer,用到一个隐藏的窗口(类为TmrWindowClass)处理有硬伤。

出问题的地方:

Psock::TThreadTimer::WndProc(var msg:TMessage)

if msg.message=WM_TIMER then

他自己处理

msg.result:=0

else

msg.result:=DefWindowProc(0,....)

end

问题就出在调用 DefWindowProc时,传输的HWND参数居然是常数0,这样实际上DefWindowProc是不能工作的,对任何输入的消息的调用均返回0,包括WM_QUERYENDSESSION,所以不能退出windows。由于DefWindowProc的不正常调用,实际上除WM_TIMER,其他消息由DefWindowProc处理都是无效的。

解决的办法是在 PSock.pas

在 TThreadTimer.Wndproc 内

Result := DefWindowProc( 0, Msg, WPARAM, LPARAM );

改为:

Result := DefWindowProc( FWindowHandle, Msg, WPARAM, LPARAM );

早期低版本的OICQ也有这个问题,如果不关闭OICQ的话,关闭计算机时屏幕闪了一下又返回了。

好了,废话少说,让我们编写我们的OICQ吧,这个实际上是Delphi自带的例子而已:)

新建一个工程,在FASTNET面版拖一个NMUDP控件到窗口,然后依次放上三个EDIT,名字分别为EditIP、EditPort、EditMyTxt,三个按钮BtSend、BtClear、BtSave,一个MEMOMemoReceive,一个SaveDialog和一个状态条StatusBar1。当用户点击BtSend时,建立一个内存流对象,把要发送的文字信息写进内存流,然后NMUDP把流发送出去。当NMUDP有数据接收时,触发它的DataReceived事件,我们在这里再把接收到的流转换为字符信息,然后显示出来。

注意:所有的流对象建立后使用完毕后要记得释放(Free),其实它的释构函数应该为Destroy,但如果建立流失败的话,用Destroy会产生异常,而用Free的话程序会先检查有没有成功建立了流,如果建立了才释放,所以用Free比较安全。

在这个程序中我们用到了NMUDP控件,它有几个重要的属性。RemoteHost表示远程电脑的IP或者计算机名,LocalPort是本地端口,主要监听有没有数据传入。而RemotePort是远程端口,发送数据时通过这个端口把数据发送出去。理解这些已经可以看懂我们的程序了。



全部代码如下:

unit Unit1;



interface



uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, ComCtrls,NMUDP;



type

TForm1 = class(TForm)

NMUDP1: TNMUDP;

EditIP: TEdit;

EditPort: TEdit;

EditMyTxt: TEdit;

MemoReceive: TMemo;

BtSend: TButton;

BtClear: TButton;

BtSave: TButton;

StatusBar1: TStatusBar;

SaveDialog1: TSaveDialog;

procedure BtSendClick(Sender: TObject);

procedure NMUDP1DataReceived(Sender: TComponent; NumberBytes: Integer;

FromIP: String; Port: Integer);

procedure NMUDP1InvalidHost(var handled: Boolean);

procedure NMUDP1DataSend(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure BtClearClick(Sender: TObject);

procedure BtSaveClick(Sender: TObject);

procedure EditMyTxtKeyPress(Sender: TObject; var Key: Char);

private

{ Private declarations }

public

{ Public declarations }

end;



var

Form1: TForm1;



implementation



{$R *.DFM}



procedure TForm1.BtSendClick(Sender: TObject);

var

MyStream: TMemoryStream;

MySendTxt: String;

Iport,icode:integer;

Begin

Val(EditPort.Text,Iport,icode);

if icode<>0 then

begin

Application.MessageBox('端口必须为数字,请重新输入!','信息',MB_ICONINFORMATION+MB_OK);

Exit;

end;

NMUDP1.RemoteHost := EditIP.Text; {远程主机}

NMUDP1.LocalPort:=Iport; {本地端口}

NMUDP1.RemotePort := Iport; {远程端口}

MySendTxt := EditMyTxt.Text;

MyStream := TMemoryStream.Create; {建立流}

try

MyStream.Write(MySendTxt[1], Length(EditMyTxt.Text));{写数据}

NMUDP1.SendStream(MyStream); {发送流}

finally

MyStream.Free; {释放流}

end;

end;





procedure TForm1.NMUDP1DataReceived(Sender: TComponent;

NumberBytes: Integer; FromIP: String; Port: Integer);

var

MyStream: TMemoryStream;

MyReciveTxt: String;

begin

MyStream := TMemoryStream.Create; {建立流}

try

NMUDP1.ReadStream(MyStream);{接收流}

SetLength(MyReciveTxt,NumberBytes);{NumberBytes为接收到的字节数}

MyStream.Read(MyReciveTxt[1],NumberBytes);{读数据}

MemoReceive.Lines.Add('接收到来自主机'+FromIP+'的信息:'+MyReciveTxt);

finally

MyStream.Free; {释放流}

end;

end;



procedure TForm1.NMUDP1InvalidHost(var handled: Boolean);

begin

Application.MessageBox('对方IP地址不正确,请重新输入!','信息',MB_ICONINFORMATION+MB_OK);

end;



procedure TForm1.NMUDP1DataSend(Sender: TObject);

begin

StatusBar1.SimpleText:='信息成功发出!';

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

EditIP.Text:='127.0.0.1';

EditPort.Text:='8868';

BtSend.Caption:='发送';

BtClear.Caption:='清除聊天记录';

BtSave.Caption:='保存聊天记录';

MemoReceive.ScrollBars:=ssBoth;

MemoReceive.Clear;

EditMyTxt.Text:='在这里输入信息,然后点击发送.';



StatusBar1.SimplePanel:=true;

end;



procedure TForm1.BtClearClick(Sender: TObject);

begin

MemoReceive.Clear;

end;



procedure TForm1.BtSaveClick(Sender: TObject);

begin

if SaveDialog1.Execute then MemoReceive.Lines.SaveToFile(SaveDialog1.FileName);

end;



procedure TForm1.EditMyTxtKeyPress(Sender: TObject; var Key: Char);

begin

if Key= #13 then

BtSend.Click;

end;

end.

上面的程序跟OICQ相比当然差之甚远,因为OICQ利用的是Socket5通信方式。它上线时先从服务器取回好友信息和在线状态,发送超时还会将信息先保存在服务器,等对方下次上线后再发送然后把服务器的备份删除。你可以根据前面学的概念来完善这个程序,比如说再添加一个NMUDP控件来管理在线状态,发送的信息先转换成ASCII码进行与或运行并加上一个头信息,接收方接收信息后先判断信息头正确与否,如果正确才把信息解密显示出来,这样就提高了安全保密性。



另外,UDP协议还有一个很大的好处就是可以广播,就是说处于一个网段的都可以接收到信息而不必指定具体的IP地址。网段一般分A、B、C三类,

1~126.XXX.XXX.XXX



(A类网) :广播地址为XXX.255.255.255

128~191.XXX.XXX.XXX(B类网):广播地址为XXX.XXX.255.255

192~254.XXX.XXX.XXX(C类网):广播地址为XXX.XXX.XXX.255

比如说三台计算机192.168.0.1、192.168.0.10、192.168.0.18,发送信息时只要指定IP地址为192.168.0.255就可以实现广播了。下面给出一个转换IP为广播IP的函数,快拿去完善自己的OICQ吧^-^.

Function

Trun_ip(S:string):string;

vars1,s2,s3,ss,sss,Head:string; n,m:integer; begin

sss:= S;

n:= pos('.',s);

s1:= copy(s,1,n);

m:= length(s1);delete(s,1,m);

Head:= copy(s1,1,(length(s1)-1));

n:= pos('.',s);

s2:=copy(s,1,n);

m:=length(s2);

delete(s,1,m);

n:= pos('.',s);

s3:=copy(s,1,n);

m:=length(s3);

delete(s,1,m);

ss:=sss;

if

strtoint(Head)

in

[1..126]

then

ss:=s1+'255.255.255'; //1~126.255.255.255



(A类网) if

strtoint(Head)

in

[128..191]

then

ss:=s1+s2+'255.255';//128~191.XXX.255.255(B类网)

if

strtoint(Head)

in

[192..254]

then

ss:=

s1+s2+s3+'255';

//192~254.XXX.XXX.255(C类网)

Result:=ss;

end;
 
跟网络没关系, 只是一个弹出式窗口
 
还没搞定,结账了
 

Similar threads

D
回复
0
查看
911
DelphiTeacher的专栏
D
D
回复
0
查看
868
DelphiTeacher的专栏
D
D
回复
0
查看
840
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
后退
顶部