unit AvMsgBox;
{$G+}
{$IMPORTEDDATA ON}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, AppEvnts;
const
MENUID_COPY_TO_CLIPBOARD = 998;
type
TAvMessageBox =
class(TForm)
MsgLabel: TLabel;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
private
procedure SetMsgText(
const Value:
string);
protected
FButtons : TMsgDlgButtons;
FCaption :
string;
FDefaultBtn : TMsgDlgBtn;
FDelaySecs : integer;
FDelayTimer : TTimer;
FDlgType : TMsgDlgType;
FIconImage : TImage;
function GetMsgLabelWidth : integer;
function GetMsgLabelHeight : integer;
procedure AddSystemMenuItem;
procedure CreateButtons;
procedure CreateIcon;
procedure OnDelayTimerTimer(Sender: TObject);
procedure SetButtonStates(Enabled: boolean);
procedure SetCaption;
public
procedure WndProc(
var Msg: TMessage);
override;
property Buttons : TMsgDlgButtons
write FButtons;
property DefaultBtn : TMsgDlgBtn
write FDefaultBtn;
property DelaySecs : integer
write FDelaySecs;
property DlgType : TMsgDlgType
write FDlgType;
property MsgText :
string write SetMsgText;
end;
function AvMessageBox(
const Msg:
string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Word;
overload;
function AvMessageBox(
const Msg:
string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultBtn: TMsgDlgBtn; DelaySecs: integer): Word;
overload;
implementation
uses
Clipbrd,
Consts,
Math;
{$R *.DFM}
//resourcestring //hiermit funktionierts aber eigentlich sollen der Werte aus der Delphi-Unit "Consts" verwendet werden
// SMsgDlgWarning = 'Warnung';
// SMsgDlgError = 'Fehler';
// SMsgDlgInformation = 'Information';
// SMsgDlgConfirm = 'Bestätigung';
// SMsgDlgYes = '&Ja';
// SMsgDlgNo = '&Nein';
// SMsgDlgOK = 'OK';
// SMsgDlgCancel = 'Abbrechen';
// SMsgDlgHelp = '&Hilfe';
// SMsgDlgHelpNone = 'Keine Hilfe verfügbar';
// SMsgDlgHelpHelp = 'Hilfe';
// SMsgDlgAbort = '&Abbrechen';
// SMsgDlgRetry = '&Wiederholen';
// SMsgDlgIgnore = '&Ignorieren';
// SMsgDlgAll = '&Alle';
// SMsgDlgNoToAll = '&Alle Nein';
// SMsgDlgYesToAll = 'A&lle Ja';
var
ButtonCaptions:
array[TMsgDlgBtn]
of Pointer = (
@SMsgDlgYes,
@SMsgDlgNo,
@SMsgDlgOK,
@SMsgDlgCancel,
@SMsgDlgAbort,
@SMsgDlgRetry,
@SMsgDlgIgnore,
@SMsgDlgAll,
@SMsgDlgNoToAll,
@SMsgDlgYesToAll,
@SMsgDlgHelp
);
ButtonNames:
array[TMsgDlgBtn]
of string = (
'
Yes',
'
No',
'
OK',
'
Cancel',
'
Abort',
'
Retry',
'
Ignore',
'
All',
'
NoToAll',
'
YesToAll',
'
Help'
);
Captions:
array[TMsgDlgType]
of Pointer = (
@SMsgDlgWarning,
@SMsgDlgError,
@SMsgDlgInformation,
@SMsgDlgConfirm,
nil
);
IconIDs:
array[TMsgDlgType]
of PChar = (
IDI_EXCLAMATION,
IDI_HAND,
IDI_ASTERISK,
IDI_QUESTION,
nil
);
ModalResults:
array[TMsgDlgBtn]
of Integer = (
mrYes,
mrNo,
mrOk,
mrCancel,
mrAbort,
mrRetry,
mrIgnore,
mrAll,
mrNoToAll,
mrYesToAll,
0
);
function AvMessageBox(
const Msg:
string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Word;
begin
Result := AvMessageBox(Msg, DlgType, Buttons, mbOK, 0);
end;
function AvMessageBox(
const Msg:
string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultBtn: TMsgDlgBtn; DelaySecs: integer): Word;
var
AMsgBox : TAvMessageBox;
begin
Application.CreateForm(TAvMessageBox, AMsgBox);
try
AMsgBox.MsgText := Msg;
AMsgBox.DlgType := DlgType;
AMsgBox.Buttons := Buttons;
AMsgBox.DelaySecs := DelaySecs;
AMsgBox.DefaultBtn := DefaultBtn;
Result := AMsgBox.ShowModal;
finally
AMsgBox.Release;
AMsgBox :=
nil;
end;
end;
procedure TAvMessageBox.AddSystemMenuItem;
var
AMenuHandle : THandle;
begin
AMenuHandle := GetSystemMenu(Self.Handle, false);
if AMenuHandle <> 0
then
begin
InsertMenu(AMenuHandle, 0, MF_ENABLED, MENUID_COPY_TO_CLIPBOARD, PChar('
in Zwischenablage kopieren'));
DrawMenuBar(AMenuHandle);
end;
end;
procedure TAvMessageBox.CreateButtons;
const
BTN_SPACE = 4;
var
AIndex : TMsgDlgBtn;
ABtn : TBitBtn;
ABtnCnt : integer;
ABtnLeft : integer;
ABtnWidth : integer;
ABtnWidthSum : integer;
ACancelBtn : TMsgDlgBtn;
begin
ABtnCnt := 0;
ABtnWidth := 65;
//Anzahl der Schaltflächen ermitteln
Self.Canvas.Font := Self.Font;
for AIndex := Low(TMsgDlgBtn)
to High(TMsgDlgBtn)
do
if AIndex
in FButtons
then
begin
Inc(ABtnCnt);
ABtnWidth := Max(ABtnWidth, Self.Canvas.TextWidth(LoadResString(ButtonCaptions[AIndex])) + 8);
end;
ABtnWidthSum := (ABtnWidth * ABtnCnt) + (BTN_SPACE * Pred(ABtnCnt));
if ABtnWidthSum > ClientWidth
then
ClientWidth := ABtnWidthSum + 2 * BTN_SPACE;
//die linke Koordinate der ersten Schaltfläche setzen
ABtnLeft := (Self.ClientWidth - ABtnWidthSum)
div 2;
//Default-Buttno ermitteln
if FDefaultBtn = mbOK
then //wenn was anderes als mbOK gesetzt ist dann war das Absicht
if mbOk
in FButtons
then
FDefaultBtn := mbOk
else if mbYes
in FButtons
then
FDefaultBtn := mbYes
else
FDefaultBtn := mbRetry;
//Cancel-Button ermitteln
if mbCancel
in FButtons
then
ACancelBtn := mbCancel
else if mbNo
in FButtons
then
ACancelBtn := mbNo
else
ACancelBtn := mbOk;
//Schaltflächen erstellen, beschriften und platzieren
for AIndex := Low(TMsgDlgBtn)
to High(TMsgDlgBtn)
do
if AIndex
in FButtons
then
begin
ABtn := TBitBtn.Create(Self);
ABtn.
Name := ButtonNames[AIndex];
ABtn.Parent := Self;
ABtn.Caption := LoadResString(ButtonCaptions[AIndex]);
ABtn.ModalResult := ModalResults[AIndex];
ABtn.Enabled := false;
//Buttons dürfen erst aktiviert werden wenn Formular sichtbar ist damit der Default-Button vorselektiert wird => FormAfterShow
if AIndex = FDefaultBtn
then
ABtn.
Default := true;
if AIndex = ACancelBtn
then
ABtn.Cancel := true;
ABtn.Left := ABtnLeft;
ABtn.Top := ClientHeight - 36;
ABtn.Width := ABtnWidth;
ABtn.Height := 25;
ABtnLeft := ABtnLeft + ABtnWidth + BTN_SPACE;
end;
end;
procedure TAvMessageBox.CreateIcon;
var
IconID : PChar;
begin
IconID := IconIDs[FDlgType];
if IconID <>
nil then
begin
FIconImage := TImage.Create(Self);
FIconImage.
Name := '
IconImage';
FIconImage.Parent := Self;
FIconImage.Picture.Icon.Handle := LoadIcon(0, IconID);
FIconImage.SetBounds(16, Max(1, MsgLabel.Height
div 2 - 16 + MsgLabel.Top), 32, 32);
end;
end;
procedure TAvMessageBox.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose := FDelaySecs <= 0;
end;
procedure TAvMessageBox.FormCreate(Sender: TObject);
begin
FDefaultBtn := mbOK;
if Application.Icon.Handle <> 0
then
SendMessage(
Handle, WM_SETICON, ICON_BIG, Application.Icon.Handle);
AddSystemMenuItem;
end;
procedure TAvMessageBox.FormDestroy(Sender: TObject);
begin
FreeAndNil(FIconImage);
end;
procedure TAvMessageBox.FormShow(Sender: TObject);
var
AValue : integer;
begin
AValue := Max(144, GetMsgLabelWidth + 3);
Width := Width + (AValue - MsgLabel.Width);
AValue := GetMsgLabelHeight;
Height := Max(125, Height + (AValue - MsgLabel.Height));
SetCaption;
CreateIcon;
CreateButtons;
if FDelaySecs > 0
then
begin
FDelayTimer := TTimer.Create(Self);
FDelayTimer.Interval := 1000;
FDelayTimer.Enabled := true;
FDelayTimer.OnTimer := OnDelayTimerTimer;
Inc(FDelaySecs);
//sonst fängt der Timer scheinbar schon bei FDelaySecs-1 an
end;
if FDelaySecs <= 0
then
SetButtonStates(true);
end;
function TAvMessageBox.GetMsgLabelHeight: integer;
var
AStrList : TStringList;
begin
AStrList := TStringList.Create;
AStrList.Text := MsgLabel.Caption;
MsgLabel.Canvas.Font := MsgLabel.Font;
Result := MsgLabel.Canvas.TextHeight(MsgLabel.Caption);
Result := (Result + 2) * Max(1, AStrList.Count);
AStrList.Free;
end;
function TAvMessageBox.GetMsgLabelWidth: integer;
var
AIndex : integer;
AStrList : TStringList;
begin
Result := 0;
AStrList := TStringList.Create;
AStrList.Text := MsgLabel.Caption;
MsgLabel.Canvas.Font := MsgLabel.Font;
for AIndex := 0
to Pred(AStrList.Count)
do
Result := Max(Result, MsgLabel.Canvas.TextWidth(AStrList[AIndex]));
AStrList.Free;
end;
procedure TAvMessageBox.OnDelayTimerTimer(Sender: TObject);
begin
if FDelaySecs > 1
then
begin
Dec(FDelaySecs);
Caption := FCaption + '
- ' + IntToStr(FDelaySecs);
end else
begin
FDelayTimer.Enabled := false;
Caption := FCaption;
Dec(FDelaySecs);
SetButtonStates(true);
end;
end;
procedure TAvMessageBox.SetButtonStates(Enabled: boolean);
var
AIndex : integer;
begin
for AIndex := 0
to Pred(ComponentCount)
do
if Components[AIndex]
is TBitBtn
then
begin
TBitBtn(Components[AIndex]).Enabled := true;
if (ModalResults[FDefaultBtn] = TBitBtn(Components[AIndex]).ModalResult)
and
(TBitBtn(Components[AIndex]).CanFocus)
then
TBitBtn(Components[AIndex]).SetFocus;
end;
end;
procedure TAvMessageBox.SetCaption;
begin
if FDlgType <> mtCustom
then
FCaption := LoadResString(Captions[FDlgType])
else
FCaption := Application.Title;
Caption := FCaption;
end;
procedure TAvMessageBox.SetMsgText(
const Value:
string);
begin
MsgLabel.Caption := Value;
end;
procedure TAvMessageBox.WndProc(
var Msg: TMessage);
begin
inherited;
if Msg.Msg = WM_SYSCOMMAND
then
if Msg.WParam = MENUID_COPY_TO_CLIPBOARD
then
begin
Clipboard.Clear;
Clipboard.HasFormat(CF_TEXT);
Clipboard.AsText := '
Anwendung: ' + Application.Title + #13#10
+ '
Zeitstempel: ' + DateTimeToStr(Now) + #13#10
+ '
Meldung'#13#10'
======='#13#10 + MsgLabel.Caption;
end;
end;
end.