MessageDlg mit eigenen Icons

[Dani]

In Delphi 6 scheint es keine solche Funktion zu geben (MessageDlg mit BMP Parameter ist gemeint) und MessageBoxIndirect gibts nur für NT

Delphi-Quellcode:

{...}

 Uses 
  Dialogs,
  ExtCtrls;

{...}

function MessageDlgImg(const Msg: String; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; BMP32x32: TBitmap=nil; CustomTitle: String=''; HelpCtx: Integer=0): Integer; overload;

function MessageDlgImg(const Msg: String; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; ImagePath: String=''; CustomTitle: String=''; HelpCtx: Integer=0): Integer; overload;

implementation

{...}

function MessageDlgImg(const Msg: String; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; BMP32x32: TBitmap=nil; CustomTitle: String=''; HelpCtx: Integer=0): Integer; overload;
var Img: TImage;
begin
 if DlgType = mtCustom then DlgType := mtInformation;
 Img := nil;
  with CreateMessageDialog(Msg, DlgType, Buttons) do
    try
      HelpContext := HelpCtx;
      HelpFile := Application.HelpFile;
      Position := poScreenCenter;
      if CustomTitle <> '' then Caption := CustomTitle;
      if BMP32x32 <> nil then
       begin
        Img := FindComponent('Image') as TImage;
        if Img <> nil then
         begin
          Img.Picture.Bitmap.Assign(BMP32x32);
          Img.Transparent := true;
         end;
       end;
      Result := ShowModal;
    finally
      Free;
      Img := nil;
    end;
end;


function MessageDlgImg(const Msg: String; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; ImagePath: String=''; CustomTitle: String=''; HelpCtx: Integer=0): Integer; overload;
var Img: TImage;
begin
 if DlgType = mtCustom then DlgType := mtInformation;
 Img := nil;
  with CreateMessageDialog(Msg, DlgType, Buttons) do
    try
      HelpContext := HelpCtx;
      HelpFile := Application.HelpFile;
      Position := poScreenCenter;
      if CustomTitle <> '' then Caption := CustomTitle;
      if ImagePath <> '' then
       begin
        Img := FindComponent('Image') as TImage;
        if Img <> nil then
         try
          Img.Picture.LoadFromFile(ImagePath);
          Img.Transparent := true;
         except
          {tue nichts}
         end;
       end;
      Result := ShowModal;
    finally
      Free;
      Img := nil;
    end;
end;

{ Beispiel }

procedure TForm1.Button1Click(Sender: TObject);
var BMP: TBitmap;
begin
  MessageDlgImg('Test', mtWarning, [mbYes, mbNo],
                'H:\ProjectPics\LAN.bmp', 'Guten Tag');

  BMP := TBitmap.Create;
  try
   BMP.LoadFromFile('H:\ProjectPics\LAN.bmp');
   MessageDlgImg('Test', mtWarning, [mbYes, mbNo],
                 'H:\ProjectPics\LAN.bmp', 'Guten Tag');
  finally
   BMP.Free;
  end; 
end;

{...}