信息窗口自动消失(50分)

  • 主题发起人 主题发起人 xxc
  • 开始时间 开始时间
X

xxc

Unregistered / Unconfirmed
GUEST, unregistred user!
在DELPHI中如何在数据提交成功后自动弹出一个信息窗口,提示“数据提交成功”信息
窗口后,过几秒中后,该信息窗口自动消失。象VF中的什么信息一样,该函数我忘了;
 
自己建个信息窗口嘛
 
怎么建,如你知道就告诉我了,何必说的这么含糊,最好有源码,谢谢!
 
在信息窗口上放个 TTimer, Interval 为停留时间(毫秒)
在 OnTimer 事件中写代码:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Close;
end;
 
在程序中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.
 
接受答案了.
 
后退
顶部