我准备做一个像MSN的邮件提示一样打开窗口的程序,请教高手,有没有相关的函数.谢谢.在线等待...(100分)

  • 主题发起人 主题发起人 seeme0526
  • 开始时间 开始时间
S

seeme0526

Unregistered / Unconfirmed
GUEST, unregistred user!
unit UMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ComCtrls, Buttons, DB, ADODB, TrayIcon, Menus,
ExtCtrls, IniFiles;

type
TFrmMail = class(TForm)
StatusBar1: TStatusBar;
MMail: TMemo;
QQ: TADOQuery;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
TrayIcon1: TTrayIcon;
Timer1: TTimer;
N2: TMenuItem;
procedure BtnCloseClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N2Click(Sender: TObject);
private
bwinstat:boolean;
procedure WMwindowposchanging(var msg:twmwindowposchanging);
message wm_windowposchanging;
procedure WMSysCommand(var Message:TMessage);
message WM_SYSCOMMAND;
{ Private declarations }
public
{ Public declarations }
end;

var
FrmMail: TFrmMail;
const
uflag = SWP_NOMOVE ;
implementation
{$R *.dfm}

procedure TFrmMail.WMwindowposchanging(var msg:twmwindowposchanging);
begin
inherited;
if bwinstat then msg.windowpos^.flags:=msg.windowpos.flags or SWP_NOMOVE;
end;

procedure TFrmMail.WMSysCommand(var Message:TMessage);
begin
// if Message.WParam = SC_ICON then
// begin
Hide;
TrayIcon1.TrayIcon(true);
// end
// else
// DefWindowProc(self.Handle,Message.Msg,Message.WParam,Message.LParam);
end;

procedure TFrmMail.BtnCloseClick(Sender: TObject);
begin
close;
end;

procedure TFrmMail.N1Click(Sender: TObject);
begin
Show;
TrayIcon1.TrayIcon(false);
end;

procedure TFrmMail.Timer1Timer(Sender: TObject);
var
IniID: TIniFile;
i,ID: Integer;
begin
IniID := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Ini/SteelQQ.HYG');
ID := IniID.ReadInteger('IniIDStr','MaxID',0);
with QQ do
begin
SQL.Clear;
SQL.Text:='SELECT si_id, d_DateTime, vc_Name, Txt_Msg, vc_Address, c_Tag FROM LV_SteelQQ '+
'WHERE (c_Tag=110 and si_id>:id) or (c_Tag=130 and si_id>:id) '+
'or (c_Tag=:Tag and si_id>:id) ORDER BY d_DateTime';
Parameters[0].Value:=ID;
Parameters[1].Value:=ID;
Parameters[2].Value:='520';//Frm_Enter.AddRess;
Parameters[3].Value:=ID;
Prepared;
Open;
if recordcount = 0 then
begin
IniID.Free;
exit;
end;
windows.Beep(4000,90);
windows.Beep(3000,90);
windows.Beep(4000,90);
windows.Beep(3000,90);
windows.Beep(4000,90);
windows.Beep(3000,90);
windows.Beep(4000,90);
windows.Beep(3000,90);
windows.Beep(4000,90);
windows.Beep(3000,90);
windows.Beep(4000,90);
MMail.Lines.Clear;
for i:=0 to recordcount-1 do
begin
with MMail do
begin
Lines.Add(FieldByName('vc_AddRess').AsString+'-'+
FieldByName('vc_Name').AsString+':'+FieldByName('d_DateTime').AsString);
Lines.Add(FieldByName('Txt_Msg').AsString);
end;
next;
end;
Last;
IniID.WriteInteger('IniIDStr','MaxID',FieldByName('si_id').AsInteger);
end;
IniID.Free;
end;

procedure TFrmMail.FormCreate(Sender: TObject);
begin
FrmMail.BorderIcons:=[biSystemMenu,biMinimize];
bwinstat:=true;
end;

procedure TFrmMail.N2Click(Sender: TObject);
begin
Close;
end;

end.
 
用这个函数
AnimateWindow
假设你要实现MSN提示的窗口为 FrmMessage

显示:
application.createForm(TFrmMessage,FrmMessage);
AnimateWindow(FrmMessage.handle,300,AW_VER_NEGATIVE);
FrmMessage.show;

关闭:
AnimateWindow(FrmMessage.handle,300,AW_VER_POSITIVE);
凭印象写的,可能有误,具体使用查一下API32指南


 
我在:windows.Beep(4000,90);
后面加入:AnimateWindow(FrmMessage.handle,300,AW_VER_NEGATIVE);
之后,
procedure TFrmMail.WMSysCommand(var Message:TMessage);
begin
Hide;
TrayIcon1.TrayIcon(true);
end;
就失效了,这个如何处理.
 
windows.Beep()
我在WIN98下使用没有声音.
 
接受答案了.
 
后退
顶部