unit UnitDLG; 
 
interface 
 
uses Forms, Windows, Sysutils, Stdctrls, Graphics, Extctrls, XButton; 
 
function Box(const cptn, txt: string; x, y: integer; btns: array of string; 
  defb, cncl: integer; anp: boolean; clr, fclr, bfclr: TColor; 
  shd: TXShading; hic: HIcon): Integer; 
 
implementation 
 
var 
  arr: array of TXButton; 
  erg: integer; 
 
function Box(const cptn, txt: string; x, y: integer; btns: array of string; 
  defb, cncl: integer; anp: boolean; clr, fclr, bfclr: TColor; 
  shd: TXShading; hic: HIcon): Integer; 
 
const 
  abst = 8; 
 
var 
  a, i, w, m, h, l: integer; 
  form: TForm; 
  img: TImage; 
  lbl: TLabel; 
  ic: TIcon; 
  r: TRect; 
 
  clk: procedure(Sender: TObject) of object; 
 
  procedure MyClick(Form: TForm; Sender: TObject); 
  begin 
    erg := TXButton(sender).tag; 
    form.close; 
  end; 
 
begin 
  SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0); 
  erg := -1; 
  ic := TIcon.Create; 
  ic.handle := hic; 
  a := abst + abst; 
  l := length(btns); 
  Form := TForm.create(application); 
  form.font.style := [fsbold]; 
  img := TImage.create(form); 
  img.parent := form; 
  img.autosize := true; 
  if hic > 0 then 
    img.picture.assign(ic) else 
    img.picture := nil; 
  img.left := abst; 
  img.top := abst; 
  if l = 0 then 
    setlength(arr, 1) 
  else setlength(arr, l); 
  h := high(arr); 
  w := 0; 
  lbl := TLabel.create(form); 
  lbl.parent := form; 
  lbl.top := abst; 
  lbl.wordwrap := true; 
  lbl.Font.color := fclr; 
  TMethod(clk).Code := @Myclick; 
  TMethod(clk).Data := form; 
  if (cncl < 0) or (cncl > h) then cncl := h; 
  with form do begin 
    color := clr; 
    borderstyle := bsSingle; 
    bordericons := [biSystemMenu]; 
    for i := 0 to h do begin 
      arr[i] := TXButton.create(form); 
      arr[i].font.style := [fsbold]; 
      if l > 0 then 
        arr[i].caption := btns[i] 
      else arr[i].caption := '&OK'; 
      m := canvas.textwidth(arr[i].caption) + a; 
      if anp or (m > arr[i].width) then 
        arr[i].width := m; 
      w := w + arr[i].width; 
      arr[i].parent := form; 
      arr[i].tag := i; 
      arr[i].onclick := clk; 
      if i = defb then activecontrol := arr[i]; 
      if i = cncl then arr[i].cancel := true; 
      arr[i].defaultframes := false; 
      arr[i].bright := false; 
      arr[i].shading := shd; 
      arr[i].font.color := bfclr; 
    end; 
    m := w + succ(length(arr)) * abst + a; 
    if m > clientwidth then begin 
      width := m; 
      arr[0].left := a; 
    end else 
      arr[0].left := (clientwidth - w - h * abst) div 2; 
    for i := 1 to h do 
      arr[i].left := arr[i - 1].boundsrect.right + abst; 
    if (x < r.left) or (x + width > r.right) then 
      left := r.left + (r.right - r.left - width) div 2 
    else left := x; 
    caption := cptn; 
    lbl.width := clientwidth - (a + img.width) * 2; 
    lbl.height := clientheight - arr[0].height - a - a; 
    lbl.caption := txt; 
    clientheight := lbl.boundsrect.bottom + arr[0].height + a + abst; 
    lbl.left := a + img.width + (clientwidth - lbl.width - 
      (a + img.width) * 2) div 2; 
    for i := 0 to h do 
      arr[i].top := clientheight - arr[i].height - abst; 
    if (y < r.top) or (y + height > r.bottom) then 
      top := r.top + (r.bottom - r.top - height) div 2 
    else top := y; 
    showmodal; 
  end; 
  for i := 0 to h do arr[i].free; 
  lbl.free; 
  img.free; 
  ic.free; 
  result := erg; 
  form.free; 
end; 
 
end. 
 
// -------------------- Beispielaufruf ------------------------------
 
uses unitdlg; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  case 
    Box('Frage', 'Möchten Sie einen Sechser im Lotto haben und in Frührente gehen?', 
    -1, -1, ['&Ja', '&Nein', '&Vielleicht', '&Später', 'S&ofort', '&Abbruch'], 
    4, 5, true, clblue, clAqua, clnavy, xbtnBlue, LoadIcon(0, IDI_QUESTION)) 
    of 
    -1, 5: exit; 
    1: Box('FEHLER', 'Das kann nicht stimmen!', -1, -1, ['&Abbruch'], 0, 0, 
        false, clred, clyellow, clMaroon, xbtnRed, 
        LoadIcon(0, MakeIntResource(32513))); 
    2: Box('Hä?', 'Seltsame Antwort.', -1, -1, ['&Schließen'], 0, 0, false, color, 
        clBlack, clWhite, xbtnGray, application.icon.handle); 
    3: Box('Was?', 'Später sind die meisten Leute tot!', -1, -1, ['&Esc'], 
        0, 0, false, clpurple, clyellow, $660066, xbtnPurple, 
        LoadIcon(0, IDI_EXCLAMATION)); 
  else Box('AHA', 'Das dachte ich mir!', -1, -1, [], 0, 0, false, clgreen, 
      clwhite, $4000, xbtnGreen, 0); 
  end; 
end;