How to create a message box with your own icon

Problem/Question/Abstract:

The message box has limited icons as set by Microsoft. I would like to use one of the icon I have and insert it into the message box. Is there a way to do that? Do I have to create a component to handle it?

Answer:

function CustMsgBox(const AMsg, ACaption, BCap1, BCap2, BCap3: string;
  IconInd: integer; FocusInd: byte; Mainform: TForm): integer;
const
  Userexe: array[0..9] of char = 'user.exe';
const
{$IFDEF Win32}
  BHeight = 23;
{$ELSE}
  BHeight = 25;
{$ENDIF}
  BWidth = 77;
var
  W: TForm;
  lCaption: TLabel;
  But1, But2, But3: TButton;
  i1: integer;
  Image1: TImage;
  IHandle: THandle;
  P1: array[byte] of char;
  Textsize: TSize;
  MDC: hDC;
  CurMetrics: TTextMetric;
  Curfont: HFont;
  Msgrect: TRect;
begin
  W := TForm.CreateNew(Application);
  But2 := nil;
  But3 := nil;
  try {set up form}
    W.BorderStyle := bsDialog;
    W.Ctl3D := True;
    W.Width := 360;
    W.Height := 160;
    W.Caption := ACaption;
    W.Font.Name := 'Arial' {Mainform.Font.Name};
    W.Font.CharSet := BALTIC_CHARSET;
    W.Font.Size := Mainform.Font.Size;
    W.Font.Style := Mainform.Font.Style;
    {Get text extent}
    for i1 := 0 to 25 do
      P1[i1] := Chr(i1 + Ord('A'));
    for i1 := 0 to 25 do
      P1[i1 + 26] := Chr(i1 + Ord('a'));
    GetTextExtentPoint(W.Canvas.Handle, P1, 52, Textsize);
    {Get line height}
    MDC := GetDC(0);
    CurFont := SelectObject(MDC, W.Font.Handle);
    GetTextMetrics(MDC, CurMetrics);
    SelectObject(MDC, CurFont);
    ReleaseDC(0, MDC);
    {Set icon}
    Image1 := TImage.Create(W);
    StrPCopy(P1, ParamStr(0));
    if Image1 <> nil then
    begin
      Image1.Width := Image1.Picture.Icon.Width;
      Image1.Height := Image1.Picture.Icon.Height;
      Image1.Left := 20;
      Image1.Top := Textsize.CY + (Textsize.CY div 2);
      Image1.Width := 32;
      Image1.Height := 32;
      Image1.Parent := W;
      Image1.Name := 'Image';
      {get icon index}
      case IconInd of
        16: IHandle := ExtractIcon(hInstance, userexe, 3);
        32: IHandle := ExtractIcon(hInstance, userexe, 2);
        48: IHandle := ExtractIcon(hInstance, userexe, 1);
        64: IHandle := ExtractIcon(hInstance, userexe, 4);
        128: IHandle := ExtractIcon(hInstance, userexe, 0);
        256: IHandle := ExtractIcon(hInstance, userexe, 5);
        512: IHandle := ExtractIcon(hInstance, userexe, 6);
      else
        IHandle := ExtractIcon(hInstance, P1, IconInd);
      end;
      if IHandle <> 0 then
        Image1.Picture.Icon.Handle := IHandle
      else
        Image1.Picture.Icon := Application.Icon;
    end;
    SetRect(MsgRect, 0, 0, Screen.Width div 2, 0);
    DrawText(W.Canvas.Handle, PChar(AMsg), -1, MsgRect, DT_CALCRECT or DT_WORDBREAK);
    {set up label}
    lCaption := TLabel.Create(W);
    lCaption.Parent := W;
    lCaption.Left := 72;
    lCaption.Top := Image1.Top;
    lCaption.Width := Msgrect.Right;
    LCaption.Height := Msgrect.Bottom;
    lCaption.Autosize := False;
    lCaption.WordWrap := True;
    {Adjust form width...must do here to accommodate buttons}
    W.Width := lCaption.Left + lCaption.Width + 30;
    lCaption.Caption := AMsg;
    {buttons}
    But1 := TButton.Create(W);
    But1.Parent := W;
    But1.Caption := BCap1;
    But1.ModalResult := 1;
    if BCap2 <> '' then
    begin
      But2 := TButton.Create(W);
      But2.Parent := W;
      But2.Caption := BCap2;
      But2.ModalResult := 2;
      if BCap3 <> '' then
      begin
        But3 := TButton.Create(W);
        But3.Parent := W;
        But3.Caption := BCap3;
        But3.ModalResult := 3;
      end;
    end;
    {Set button positions}
    {set height depending on whether icon or message is tallest}
    if lCaption.Height > Image1.Height then
      But1.Top := (lCaption.Top + lCaption.Height + 20)
    else
      But1.Top := (Image1.Top + Image1.Height + 20);
    But1.Width := BWidth;
    But1.Height := BHeight;
    if But2 <> nil then
    begin
      But2.Height := BHeight;
      But2.Width := BWidth;
      But2.Top := But1.Top;
      if But3 <> nil then
      begin
        But3.Top := But1.Top;
        But3.Width := BWidth;
        But3.Height := BHeight;
        But3.Left := (W.Width div 2) + ((BWidth div 2) + 8);
        But2.Left := (W.Width div 2) - (BWidth div 2);
        But1.Left := (W.Width div 2) - ((BWidth div 2) + BWidth + 8);
        But3.Cancel := True;
      end
      else
      begin
        But2.Left := (W.Width div 2) + 4;
        But1.Left := (W.Width div 2) - (BWidth + 4);
      end;
    end
    else
    begin
      But1.Left := (W.Width div 2) - (BWidth div 2);
    end;
    {set focus}
    case FocusInd of
      3:
        if BCap3 <> '' then
          But3.Default := True;
      2:
        if BCap2 <> '' then
          But2.Default := True;
    else
      But1.Default := True;
    end;
    {Set clientheight to proper height}
    W.ClientHeight := But1.Top + But1.Height + Textsize.CY;
    { Left := (W.ClientWidth div 2) - (((OKButton.Width * 2) + 10) div 2) }
    {Show messagebox}
    {Set position}
    { Position := poScreenCenter;  }
    W.Left := Mainform.Left + ((Mainform.Width - W.Width) div 2);
    W.Top := Mainform.Top + ((Mainform.Height - W.Height) div 2);
    W.ShowModal;
    Result := W.ModalResult;
  finally
    W.Free;
  end;
end;