2009-07-08 6 views

Antwort

10

Beantworten meiner eigenen Frage .... Ich schrieb die folgende Einheit, die gut für mich funktioniert.

Delphi stellt CreateMessageDialog() zur Verfügung, um Ihnen eine Dialogvorlage zu geben, die Sie vor der Anzeige ändern können. Ich benutzte das, um eine Funktion zu erstellen, die ich MessageDlgCustom nannte, die die gleichen Parameter wie ein Standard-MessageDlg nimmt, aber einen weiteren für Ersatz-Button-Titel hinzufügt.

Es verarbeitet benutzerdefinierte Schriftarten korrekt und passt Schaltflächen automatisch an, um für ihre Nachricht breit genug zu sein. Wenn die Schaltflächen den Dialog überlaufen, wird auch dieser angepasst.

Nach dieser Einheit verwendet wird, die unter Beispiel funktioniert:

case MessageDlgCustom('Save your changes?',mtConfirmation, 
    [mbYes,mbNo,mbCancel], 
    ['&Yes, I would like to save them with this absurdly long button', 
    '&No, I do not care about my stupid changes', 
    '&Arg! What are you talking about? Do not close the form!'], 
    nil) //nil = no custom font 
of 
    mrYes: 
    begin 
     SaveChanges; 
     CloseTheForm; 
    end; //mrYes (save & close) 
    mrNo: 
    begin 
     CloseForm; 
    end; //mrNo (close w/o saving) 
    mrCancel: 
    begin 
     //do nothing 
    end; //mrCancel (neither save nor close) 
end; //case 

Wenn jemand einen besseren Weg kennt, bitte teilen.

unit CustomDialog; 

interface 

uses 
    Dialogs, Forms, Graphics, StdCtrls; 

function MessageDlgCustom(const Msg: string; DlgType: TMsgDlgType; 
    Buttons: TMsgDlgButtons; ToCaptions: array of string; 
    customFont: TFont) : integer; 
procedure ModifyDialog(var frm: TForm; ToCaptions : array of string; 
    customFont : TFont = nil); 


implementation 

uses 
    Windows, SysUtils; 

function GetTextWidth(s: string; fnt: TFont; HWND: THandle): integer; 
var 
    canvas: TCanvas; 
begin 
    canvas := TCanvas.Create; 
    try 
    canvas.Handle := GetWindowDC(HWND); 
    canvas.Font := fnt; 
    Result := canvas.TextWidth(s); 
    finally 
    ReleaseDC(HWND,canvas.Handle); 
    FreeAndNil(canvas); 
    end; //try-finally 
end; 

function MessageDlgCustom(const Msg: string; 
    DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; ToCaptions: array of string; 
    customFont: TFont): integer; 
var 
    dialog : TForm; 
begin 
    try 
    dialog := CreateMessageDialog(Msg, DlgType, Buttons); 
    dialog.Position := poScreenCenter; 
    ModifyDialog(dialog,ToCaptions,customFont); 
    Result := dialog.ShowModal; 
    finally 
    dialog.Release; 
    end; //try-finally 
end; 

procedure ModifyDialog(var frm: TForm; ToCaptions: array of string; 
    customFont: TFont); 
const 
    c_BtnMargin = 10; //margin of button around caption text 
var 
    i,oldButtonWidth,newButtonWidth,btnCnt : integer; 
begin 
    oldButtonWidth := 0; 
    newButtonWidth := 0; 
    btnCnt := 0; 
    for i := 0 to frm.ComponentCount - 1 do begin 
    //if they asked for a custom font, assign it here 
    if customFont <> nil then begin 
     if frm.Components[i] is TLabel then begin 
     TLabel(frm.Components[i]).Font := customFont; 
     end; 
     if frm.Components[i] is TButton then begin 
     TButton(frm.Components[i]).Font := customFont; 
     end; 
    end; 
    if frm.Components[i] is TButton then begin 
     //check buttons for a match with a "from" (default) string 
     //if found, replace with a "to" (custom) string 
     Inc(btnCnt); 

     //record the button width *before* we changed the caption 
     oldButtonWidth := oldButtonWidth + TButton(frm.Components[i]).Width; 

     //if a custom caption has been provided use that instead, 
     //or just leave the default caption if the custom caption is empty 
     if ToCaptions[btnCnt - 1]<>'' then 
     TButton(frm.Components[i]).Caption := ToCaptions[btnCnt - 1]; 

     //auto-size the button for the new caption 
     TButton(frm.Components[i]).Width := 
     GetTextWidth(TButton(frm.Components[i]).Caption, 
      TButton(frm.Components[i]).Font,frm.Handle) + c_BtnMargin; 

     //the first button can stay where it is. 
     //all other buttons need to slide over to the right of the one b4. 
     if (1 < btnCnt) and (0 < i) then begin 
     TButton(frm.Components[i]).Left := 
      TButton(frm.Components[i-1]).Left + 
      TButton(frm.Components[i-1]).Width + c_BtnMargin; 
     end; 

     //record the button width *after* changing the caption 
     newButtonWidth := newButtonWidth + TButton(frm.Components[i]).Width; 
    end; //if TButton 
    end; //for i 

    //whatever we changed the buttons by, widen/shrink the form accordingly 
    frm.Width := Round(frm.Width + (newButtonWidth - oldButtonWidth) + 
    (c_BtnMargin * btnCnt)); 
end; 

end. 
+0

Nun, wenn Sie mindestens Delphi 2007 verwenden, würde ich eine komplett neue MessageDlg() - Funktion erstellen, zuerst die Windows-Version überprüfen, die neuen Dialogklassen unter Vista verwenden und eine modifizierte Version der ursprünglichen MessageDlg verwenden () Funktion anders. Auf diese Weise können Sie problemlos die Kontrollkästchen "Nicht mehr anzeigen" hinzufügen. – mghie

+1

Der Code, wie er derzeit steht, kompiliert nicht. Sie müssen einige Methoden reorganisieren. GetTextWidth muss an den Anfang der Implementierung verschoben werden. Wenn Sie ModifyDialog über die MessageDlgCustom-Methode in der Implementierung verschieben, können Sie die Deklaration aus dem Schnittstellenabschnitt entfernen. Unter WinXP befindet sich die Schaltfläche für die zuletzt bearbeiteten Dialogfelder. Ihr Beispielaufruf befindet sich fast am Rand des Fensterrahmens. Aus irgendeinem Grund berechnet die Methode die Breite des Dialogfelds nicht ordnungsgemäß neu. –

+0

@Ryan - danke, ich habe es neu organisiert, um das Wichtigste an die Spitze zu setzen, vergessend, dass es die Kompilierung brechen würde. Ich habe die ursprüngliche Reihenfolge wiederhergestellt. Es sollte jetzt kompilieren. Ich muss es auf einer XP-Maschine versuchen - ich benutze Vista. Hoffentlich tritt das Problem, das Sie beschreiben, nur in extremen Fällen auf ... – JosephStyons

1

Stellen Sie außerdem sicher, dass Ihre 3rd-Party-Kontrollen rufen auch Ihre dlg benutzerdefinierte Nachricht und nicht die Standard MessageDlg Funktion. Das ist, wenn sie tatsächlich verwenden. Es ist möglich, dass die Steuerelemente von Drittanbietern nicht die Delphi messagesdlg verwenden und die MessageBox API direkt aufrufen. Wenn das der Fall ist, könnten Sie mit Inkonsistenzen in der Anzeige der Nachricht Boxen enden.

2

Als Alternative können Sie die Open Source SynTaskDialog Einheit verwenden. SynTaskDialog verwendet die Windows TaskDialog API nativ in neueren Windows Versionen und emuliert diese in älteren Versionen. Sie können sogar use it with FireMonkey.

Ein Beispiel für eine anpassbare Funktion MessageDlg finden Sie unter this answer.

Verwandte Themen