// Hiermit kann man ein TMessageDlg mit Vintage-Icons erstellen.
 

Beispiel 2	Verwendete Icons	Beispiel 5

 

// Getestet mit RS 10.4 unter Win11

{
 Als erstes laden Sie DLGBMP herunter und entpacken die vier
 Bildchen in den Ordner Ihres Projekts. Dann erstellen Sie
 in dem Ordner eine (Text)Datei mit Namen "DLGBitmaps.rc".
 Dort hinein schreiben Sie die folgenden vier Zeilen:

Confirmation Bitmap Confirmation.bmp
Information  Bitmap Information.bmp
Error        Bitmap Error.bmp
Warning      Bitmap Warning.bmp

 Danach fügen Sie die DLGBitmaps.rc und die folgende Unit Ihrem
 Projekt hinzu.

 Hinweis:
 Das Einfärben fuktioniert beim Einsatz des StyleManagers natürlich nicht.
}
 

unit UnitDLG; 
 
interface 
 
{$R 'DLGBitmaps.res' 'DLGBitmaps.rc'} 
 
uses Winapi.Windows, Vcl.Dialogs, Vcl.Graphics, Vcl.Controls, Vcl.Forms, 
  Vcl.StdCtrls, Vcl.ExtCtrls; 
 
function MyDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; 
  DefaultButton: TMsgDlgBtn = mbOk; X: Integer = -1; Y: Integer = -1; 
  Cl: TColor = clBtnface; Ico: TBitmap = nil; Transparency: Boolean = True) 
  : TModalResult; 
 
implementation 
 
function MyDlg(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; 
  DefaultButton: TMsgDlgBtn = mbOk; X: Integer = -1; Y: Integer = -1; 
  Cl: TColor = clBtnface; Ico: TBitmap = nil; Transparency: Boolean = True) 
  : TModalResult; 
var 
  Dlg: TForm; 
  MsgIcon: TImage; 
begin 
  Dlg := CreateMessageDialog(Msg, DlgType, Buttons, DefaultButton); 
  MsgIcon := TImage(Dlg.FindComponent('Image')); 
  Dlg.Color := Cl; 
  if MsgIcon <> nil then 
  begin 
    MsgIcon.Transparent := Transparency; 
    if Ico <> nil then 
      MsgIcon.Picture.Bitmap := Ico 
    else 
      case DlgType of 
        mtWarning: 
          MsgIcon.Picture.Bitmap.Handle := LoadBitmap(Hinstance, 'Warning'); 
        mtError: 
          MsgIcon.Picture.Bitmap.Handle := LoadBitmap(Hinstance, 'Error'); 
        mtInformation: 
          MsgIcon.Picture.Bitmap.Handle := LoadBitmap(Hinstance, 'Information'); 
        mtConfirmation: 
          MsgIcon.Picture.Bitmap.Handle := 
            LoadBitmap(Hinstance, 'Confirmation'); 
      end; 
  end; 
  Dlg.Formstyle := fsStayOnTop; 
  if (X >= 0) then 
    Dlg.Left := X; 
  if (Y >= 0) then 
    Dlg.Top := Y; 
  Result := Dlg.showmodal; 
  Dlg.Free; 
end; 
 
end.

//------------------------------------------------------------

// Beispielaufrufe in Form1
 
uses UnitDLG; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  MyDLG('Vorsicht! Das ist ein Versuch!', mtWarning, [mbOk]); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  DlgType: TMsgDlgType; 
  Buttons: TMsgDlgButtons; 
  DefaultButton: TMsgDlgBtn; 
  X, Y: Integer; 
begin 
  DlgType := mtConfirmation; 
  Buttons := [mbYes, mbNo]; 
  DefaultButton := mbNo; 
  X := 300; 
  Y := 200; 
  MyDLG('Wollen Sie Viel Geld?', DlgType, Buttons, DefaultButton, X, Y); 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  MyDLG('Irgendetwas ist immer falsch.', mtError, [mbCancel]); 
end; 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  MyDLG('Nur mal so', mtCustom, [mbOk], mbOk, 200, 200); 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
var 
  bm: TBitmap; 
begin 
  bm := TBitmap.Create; 
  bm.LoadFromFile('D:\Bilder\Totenkopf.bmp'); // 32x32 empfohlen 
  MyDLG('ALARM', mtWarning, [mbOk], mbOk, -1, -1, clFuchsia, bm, False); 
  bm.Free; 
end;

Zugriffe seit 6.9.2001 auf Delphi-Ecke