2009-07-08 18 views

risposta

10

Rispondere alla mia domanda .... Ho scritto l'unità di seguito che funziona bene per me.

Delphi fornisce CreateMessageDialog() per fornire un modello di finestra di dialogo, che è possibile modificare prima della visualizzazione. L'ho usato per creare una funzione che ho chiamato MessageDlgCustom, che prende gli stessi parametri di un MessageDlg standard, ma ne aggiunge uno in più per i titoli dei pulsanti di sostituzione.

Gestisce correttamente i caratteri personalizzati e regola automaticamente i pulsanti per essere sufficientemente ampi per il loro messaggio. Se i pulsanti superano la finestra di dialogo, anche quella viene regolata.

Dopo aver usato tale unità, l'esempio riportato di seguito funziona:

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 

Se qualcun altro conosce un modo migliore, si prega di condividerlo.

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

Bene, se si utilizza almeno Delphi 2007, quindi creerei una funzione MessageDlg() completamente nuova, verificando prima la versione di Windows, utilizzando le nuove classi di finestre di dialogo in Vista e utilizzando una versione modificata del messaggio originale MessageDlg () funziona diversamente. Ciò consentirebbe di aggiungere facilmente caselle di controllo "Non mostrare più". – mghie

+1

Il codice così com'è attualmente non viene compilato. Devi riorganizzare un paio di metodi. GetTextWidth deve essere spostato verso l'alto dell'implementazione e se si sposta ModifiyDialog sopra il metodo MessageDlgCustom nell'implementazione, è possibile rimuovere la dichiarazione dalla sezione dell'interfaccia. Su WinXP l'ultimo pulsante delle finestre di dialogo modificato, usando la tua chiamata di esempio, si trova quasi sul bordo del bordo della finestra. Per qualche motivo, il metodo non ricalcola correttamente la larghezza della finestra di dialogo. –

+0

@Ryan - grazie, l'ho riorganizzato per mettere la cosa più importante in cima, dimenticando che avrebbe rotto la compilazione. Ho ripristinato l'ordine originale. Dovrebbe essere compilato ora. Dovrò provarlo su una macchina XP - Sto usando Vista. Speriamo che il problema che descrivete si verifichi solo in casi estremi, comunque ... – JosephStyons

1

Inoltre, assicurarsi che il 3 ° partito controlli anche chiamare il tuo messaggio personalizzato dlg e non standard di funzione MessageDlg. Questo è se sono in realtà usando. È possibile che i controlli di terze parti non utilizzino la messaggistica Delphi e chiamino direttamente l'API MessageBox . In tal caso, è possibile che finisca con incongruenze nella visualizzazione delle caselle del messaggio .

2

In alternativa è possibile utilizzare l'unità Open Source SynTaskDialog. SynTaskDialog utilizza l'API TaskDialog di Windows in modo nativo nelle versioni di Windows più recenti e lo emula nelle versioni precedenti. Puoi anche use it with FireMonkey.

Per un esempio di una funzione MessageDlg personalizzabile, dare un'occhiata a this answer.

Problemi correlati