在程序中uses unit2
使用 ShowMsg('数据提交成功',mtInformation,5);
ShowMsg(提示信息,窗口类型,显示的秒数);
不满意自己改。
unit Unit2;
interface
uses
Consts, Forms, ExtCtrls, Classes, Dialogs, Graphics, Windows,
StdCtrls;
type
TMsgForm = class(TForm)
private
FTimer: TTimer;
procedure OnTime(Sender: TObject);
public
constructor CreateNew(AOwner: TComponent);reintroduce;
destructor Destroy; override;
procedure SetShowTime(ShowTime: Integer);
end;
procedure ShowMsg(const Msg: string; DlgType: TMsgDlgType; ShowTime: Integer);
implementation
procedure TMsgForm.SetShowTime(ShowTime: Integer);
begin
FTimer.Interval:=ShowTime*1000;
FTimer.Enabled:=True;
end;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
var
Captions: array[TMsgDlgType] of Pointer = (@SMsgDlgWarning, @SMsgDlgError,
@SMsgDlgInformation, @SMsgDlgConfirm, nil);
IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
IDI_ASTERISK, IDI_QUESTION, nil);
function CreateMsgDlg(const Msg: string; DlgType: TMsgDlgType; ShowTime: Integer): TForm;
const
mcHorzMargin = 8;
mcVertMargin = 8;
mcHorzSpacing = 10;
mcVertSpacing = 10;
var
DialogUnits: TPoint;
HorzMargin, VertMargin, HorzSpacing, VertSpacing,
IconTextWidth, IconTextHeight, ALeft: Integer;
IconID: PChar;
TextRect: TRect;
begin
Result := TMsgForm.CreateNew(Application);
with Result do
begin
TMsgForm(Result).SetShowTime(ShowTime);
BiDiMode := Application.BiDiMode;
BorderStyle := bsDialog;
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
DrawText(Canvas.Handle, PChar(Msg), Length(Msg)+1, TextRect,
DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
DrawTextBiDiModeFlagsReadingOnly);
IconID := IconIDs[DlgType];
IconTextWidth := TextRect.Right;
IconTextHeight := TextRect.Bottom;
if IconID <> nil then
begin
Inc(IconTextWidth, 32 + HorzSpacing);
if IconTextHeight < 32 then IconTextHeight := 32;
end;
ClientWidth := IconTextWidth + HorzMargin * 2;
ClientHeight := IconTextHeight + VertSpacing + VertMargin * 2;
Left := (Screen.Width div 2) - (Width div 2);
Top := (Screen.Height div 2) - (Height div 2);
if DlgType <> mtCustom then
Caption := LoadResString(Captions[DlgType]) else
Caption := Application.Title;
if IconID <> nil then
with TImage.Create(Result) do
begin
Name := 'Image';
Parent := Result;
Picture.Icon.Handle := LoadIcon(0, IconID);
SetBounds(HorzMargin, VertMargin, 32, 32);
end;
with TLabel.Create(Result) do
begin
Name := 'Message';
Parent := Result;
WordWrap := True;
Caption := Msg;
BoundsRect := TextRect;
BiDiMode := Result.BiDiMode;
ALeft := IconTextWidth - TextRect.Right + HorzMargin;
if UseRightToLeftAlignment then
ALeft := Result.ClientWidth - ALeft - Width;
SetBounds(ALeft, VertMargin,
TextRect.Right, TextRect.Bottom);
end;
end;
end;
procedure TMsgForm.OnTime(Sender: TObject);
begin
Close;
end;
constructor TMsgForm.CreateNew(AOwner: TComponent);
var
NonClientMetrics: TNonClientMetrics;
begin
inherited CreateNew(AOwner);
NonClientMetrics.cbSize := sizeof(NonClientMetrics);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
BorderStyle:=bsDialog;
FTimer:=TTimer.Create(Self);
FTimer.Interval:=5000;
FTimer.OnTimer:=OnTime;
FTimer.Enabled:=False;
end;
destructor TMsgForm.Destroy;
begin
FTimer.Free;
inherited Destroy;
end;
procedure ShowMsg(const Msg: string; DlgType: TMsgDlgType; ShowTime: Integer);
var
tm: TForm;
begin
tm:=CreateMsgDlg(msg,dlgtype,ShowTime);
Try
tm.ShowModal;
Finally
tm.Free;
end;
end;
end.