[ 分享]类似MSN的提示窗口
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
type
TSlidHintForm = class(TForm)
Panel1: TPanel;
Image1: TImage;
Label1: TLabel;
Image2: TImage;
ActClose: TSpeedButton;
Timer1: TTimer;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure ActCloseClick(Sender: TObject);
private
FAnimateTime: integer;
{ Private declarations }
protected
procedure CreateParams(var Param: TCreateParams); override;
published
property AnimateTime: integer read FAnimateTime write FAnimateTime; { Second }
public
{ Public declarations }
class function Execute(Msg: string; DelayTime:integer = 6;uType: integer=MB_ICONINFORMATION): integer;
end;
var
SlidHintForm: TSlidHintForm;
implementation
{$R *.dfm}
procedure RefreshControl(Control: TControl); { Refresh Self and SubControls }
var
i: integer;
begin
if Control is TWinControl then
for i := 0 to TWinControl(Control).ControlCount - 1 do
RefreshControl(TWinControl(Control).Controls[i]);
Control.Invalidate;
end;
procedure TSlidHintForm.FormShow(Sender: TObject);
begin
// SetForegroundWindow(Handle);
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
Timer1.Enabled := True;
AnimateWindow(Handle, FAnimateTime, AW_SLIDE or AW_VER_NEGATIVE);
RefreshControl(Self);
end;
procedure TSlidHintForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer1.Enabled := False;
AnimateWindow(Handle, FAnimateTime, AW_SLIDE or AW_VER_POSITIVE or AW_HIDE);
end;
procedure TSlidHintForm.FormCreate(Sender: TObject);
begin
FAnimateTime := 1000;
Left := Screen.WorkAreaRect.Right - Width;
Top := Screen.WorkAreaRect.Bottom - Height;
end;
procedure TSlidHintForm.CreateParams(var Param: TCreateParams);
begin
inherited;
Param.WndParent := GetDesktopWindow;
Param.Style := WS_SIZEBOX or WS_POPUP or WS_BORDER;
Param.ExStyle := Param.ExStyle or WS_EX_TOPMOST;
end;
class function TSlidHintForm.Execute;
begin
with TSlidHintForm.Create(nil), Image2.Picture.Icon do
try
Label1.Caption := Msg;
case uType of
MB_ICONHAND: Handle := LoadIcon(0, IDI_HAND);
MB_ICONQUESTION: Handle := LoadIcon(0, IDI_QUESTION);
MB_ICONEXCLAMATION: Handle := LoadIcon(0, IDI_EXCLAMATION);
MB_ICONASTERISK: Handle := LoadIcon(0, IDI_ASTERISK);
else
Handle := uType;
end;
Timer1.Interval := DelayTime * 1000;
Show;
while Showing do
begin
Sleep(50);
Application.ProcessMessages;
if Application.Terminated then Break;
end;
finally
Free;
end;
end;
procedure TSlidHintForm.ActCloseClick(Sender: TObject);
begin
Close;
end;
end.
------------------------
object SlidHintForm: TSlidHintForm
Left = 522
Top = 179
BorderStyle = bsToolWindow
BorderWidth = 2
Caption = 'SlidHintForm'
ClientHeight = 162
ClientWidth = 226
Color = clNavy
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 226
Height = 162
Align = alClient
BevelInner = bvSpace
TabOrder = 0
DesignSize = (
226
162)
object Image1: TImage
Left = 2
Top = 2
Width = 222
Height = 158
Align = alClient
Center = True
Stretch = True
end
object Label1: TLabel
Left = 55
Top = 10
Width = 161
Height = 116
Anchors = [akLeft, akTop, akRight, akBottom]
AutoSize = False
Caption = 'Label1'
Transparent = True
WordWrap = True
end
object Image2: TImage
Left = 10
Top = 15
Width = 32
Height = 32
Center = True
Stretch = True
Transparent = True
end
object ActClose: TSpeedButton
Left = 130
Top = 135
Width = 86
Height = 22
Anchors = [akRight, akBottom]
Caption = '关闭'
Flat = True
onClick = ActCloseClick
end
end
object Timer1: TTimer
OnTimer = ActCloseClick
Left = 170
Top = 95
end
end