DBR Delphi-Ecke

// Hiermit kann man Message-Dialoge erstellen, die 1 bis 9 Buttons mit eigener
// Beschriftung aufweisen, eine eigene Formatierung des Dialog-Textes haben und
// ein eigenes Icon zeigen. Der Dialog wird an der Position X, Y angezeigt,
// es sei denn, man setzt eine dieser beiden Variablen auf "Maxint", dann
// erscheint der Dialog in der Bildschirmmitte. Über die Variable "Defbtn"
// wird gesteuert, welcher Button beim Erscheinen des Dialoges den Focus hat.
// Die Variable "Esc" legt fest, ob und welcher Button den Dialog cancelt.
// Hat sie den Wert Null oder einen Wert, der größer als die Button-Anzahl ist,
// kann der Dialog nicht über die Taste ESC geschlossen werden. Mit der Variablen
// "Signal" kann man festlegen, ob beim Erscheinen des Dialoges ein Beep-Ton
// zu hören ist. Die Rückmeldung der Funktion ist ein Integer-Wert, der den
// gedrückten Button representiert. Ist der Rückgabewert 1, dann wurde der erste
// Button von links betätigt, bei 2 war es der zweite von links usw. Wird der
// Dialog über den Button "Schließen" (Kreuz) des Fensters oder mit Alt+F4
// geschlossen, wird 0 zurückgegeben.

// Getestet mit D4 unter XP

function MyDLG(x, y: integer; caption, Text: string; TextColor: TColor; 
  TextStyle: TFontStyles; Buttons: array of string; Ico: TIcon; 
  defbtn, esc: byte; Signal: boolean): integer; 
var 
  MsgDlg: TForm; 
  MsgText: TLabel; 
  MsgIcon: TImage; 
  z, i, k, bl, abstand: integer; 
  b: TMsgDlgButtons; 
  dc: HDC; 
  cnv: TCanvas; 
begin 
  abstand := 7; 
  z := high(buttons); 
  if z > 8 then 
    z := 8; 
  if (defbtn < 1) or (defbtn > z + 1) then 
    defbtn := 1; 
  if z < 0 then 
    b := [mbYes] 
  else 
    b := []; 
  for i := 0 to z do 
  begin 
    if i > 2 then 
      k := i + 1 
    else 
      k := i; 
    b := b + [TMsgDlgBtn(k)]; 
  end; 
  MsgDlg := CreateMessageDialog(text, mtConfirmation, b); 
  bl := abstand; 
  dc := GetDC(MsgDlg.handle); 
  cnv := TCanvas.create; 
  cnv.handle := dc; 
  if z < 0 then 
    TButton(MsgDlg.components[2]).caption := '&OK' 
  else 
    for i := 0 to z do begin 
      with TButton(MsgDlg.components[i + 2]) do begin 
        caption := buttons[i]; 
        width := cnv.Textwidth(caption) + 10; 
        left := bl; 
        inc(bl, width + abstand); 
      end; 
    end; 
  cnv.free; 
  ReleaseDC(MsgDlg.handle, dc); 
  MsgDlg.clientwidth := bl; 
  MsgDlg.Caption := caption; 
  MsgText := TLabel(MsgDlg.FindComponent('Message')); 
  with MsgText do begin 
    Font.Color := TextColor; 
    Font.Style := TextStyle; 
    width := bl - ico.width - 3 * abstand; 
    left := abstand * 2 + ico.width; 
  end; 
  MsgIcon := TImage(MsgDlg.FindComponent('Image')); 
  MsgIcon.Picture.Icon := Ico; 
  MsgIcon.left := abstand; 
  for i := 2 to MsgDlg.ComponentCount - 1 do 
    TButton(MsgDlg.components[i]).Cancel := i = esc + 1; 
  if (x < maxint) and (y < maxint) then 
    MsgDlg.setbounds(x, y, MsgDlg.width, MsgDlg.height); 
  for i := 0 to z - 1 do 
  begin 
    k := defbtn + i + 1; 
    if k > z + 2 then 
      k := k - z - 1; 
    TButton(MsgDlg.components[k]).TabOrder := i; 
  end; 
  if signal then 
    Beep; 
  MsgDlg.showmodal; 
  k := MsgDlg.ModalResult; 
  case k of 
    1: result := 3; 
    3, 4, 5: result := k + 1; 
    6, 7: result := k - 5; 
    8, 9, 10: result := k - 1; 
  else 
    result := 0; 
  end; 
  MsgIcon.free; 
  MsgText.free; 
  MsgDlg.free; 
end;

// 2 Beispielaufrufe 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  ic: TIcon; 
  m: integer; 
begin 
  ic := TIcon.create; 
  ic.handle := ExtractIcon(hinstance, 'c:\windows\system32\shell32.dll', 9); 
  m := MyDlg(maxint, 0, 'DLG - Selbstgemacht', 'Button anklicken, aber flott!', 
    clgreen, [], ['Button&1', 'Button&2', 'Button&3'], ic, 0, 0, true); 
  case m of 
    1: showmessage('Button1 wurde gedrückt.'); 
    2: showmessage('Button2 wurde gedrückt.'); 
    3: showmessage('Button3 wurde gedrückt.'); 
  else 
    showmessage('Abgebrochen'); 
  end; 
  ic.free; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  case MyDlg(100, 50, 'DLG mit ESC', 'Klicken Sie auf eine Taste!', 
    clRed, [fsBold], ['&Wow', '&Cancel', '&Test', '&Ups'], 
    Application.icon, 4, 2, false) of 
    0, 2: showmessage('Abgebrochen'); 
    1: showmessage('Wow wurde gedrückt.'); 
    3: showmessage('Test wurde gedrückt.'); 
  end; 
end;