Merhaba, Showmessage veya messagebox türevi kullanmadan, Form oluşturarak mesaj ekranı oluşturma işlemini yapabilirsiniz.
procedure ZamanliMesajKutusu(const Baslik, Mesaj: string; Zaman: Integer);
var
Form: TForm;
Prompt: TLabel;
DialogUnits: TPoint;
nX, Lines: Integer;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := 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;
begin
Form := TForm.Create(Application);
Lines := 0;
For nX := 1 to Length(Mesaj) do
if APrompt[nX]=#13 then Inc(Lines);
with Form do
try
Font.Name:='Arial';
Font.Size:=10;
Font.Style:=[fsBold];
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
//BorderStyle := bsDialog;
BorderStyle := bsToolWindow;
FormStyle := fsStayOnTop;
BorderIcons := [];
Caption := Baslik;
ClientWidth := MulDiv(Screen.Width div 4, DialogUnits.X, 4);
ClientHeight := MulDiv(23 + (Lines*10), DialogUnits.Y, 8);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
AutoSize := True;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Caption := Mesaj;
end;
Form.Width:=Prompt.Width+Prompt.Left+50;
Show;
Application.ProcessMessages;
finally
Sleep(Zaman*1000);
Form.Free;
end;
end;
