2009-07-08 19 views

cevap

10

Kendi sorumu yanıtlama .... Aşağıda benim için iyi çalışan bir birim yazdım.

Delphi, görüntülemeden önce değiştirebileceğiniz bir iletişim şablonu sunmak için CreateMessageDialog() sağlar. Bunu MessageDlgCustom olarak adlandırdığım, standart MessageDlg ile aynı parametreleri alan bir işlev oluşturmak için kullandım, ancak değiştirme düğmesi başlıkları için bir tane daha ekler.

Özel yazı tiplerini doğru şekilde işler ve düğmeleri, iletileri için yeterince geniş olacak şekilde otomatik olarak ayarlar. Düğmeler diyaloğu taşarsa, bu da ayarlandı.

o üniteyi kullandıktan sonra, aşağıdaki örnek çalışır:

başkası daha iyi bir yol bilen varsa
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 

, lütfen bizimle paylaşın.

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

En azından Delphi 2007'yi kullanıyorsanız, tamamen yeni bir MessageDlg() işlevi oluşturarak, Vista'daki yeni iletişim sınıflarını kullanarak, önce Windows sürümünü denetler ve orijinal MessageDlg'in değiştirilmiş bir sürümünü kullanırdım () aksi halde işlev. Bu, "Tekrar gösterme" onay kutularını kolayca eklemenizi de sağlar. – mghie

+1

Şu anda bulunduğu haliyle kod derleme yapmıyor. Birkaç yöntemi yeniden düzenlemelisiniz. GetTextWidth, uygulamanın en üstüne gitmeye ihtiyaç duyar ve ModifiyDialog'u uygulamada MessageDlgCustom yönteminin üzerine getirdiğinizde, arabirim bölümünden bildirimi kaldırabilirsiniz. WinXP'de, örnek çağrınızı kullanarak değiştirilen diyaloglar son düğmesi neredeyse pencere kenarlığının kenarında yer alır. Bazı nedenlerden dolayı yöntem, iletişim kutusunun genişliğini doğru şekilde yeniden hesaplamıyor. –

+0

@Ryan - teşekkürler, en önemli şeyi en başa koymak için derledim, derlemeyi bozacağını unutarak. Orijinal siparişi geri yükledim. Şimdi derlemeli. Bir XP makinesinde denemek zorundayım - Vista kullanıyorum. Umarım anlattığınız problem sadece aşırı durumlarda ortaya çıkar ... – JosephStyons

1

Ayrıca, 3. taraf denetimleri de özel mesaj DLG değil standart MessageDlg işlevini çağırmak emin olun. Yani aslında kullanıyorlarsa. 3. tarafın kontrolünün Delphi messagedlg'i kullanmaması ve MessageBox API'sini doğrudan çağırması mümkündür. Bu durumda, , kutularını gösterme konusunda tutarsızlıklarla sonuçlanabilir.

2

Alternatif olarak Open Source SynTaskDialog birimini kullanabilirsiniz. SynTaskDialog, Windows TaskDialog API'sini daha yeni Windows sürümlerinde yerel olarak kullanır ve eski sürümlerinde öykünür. Hatta use it with FireMonkey yapabilirsiniz.

Özelleştirilebilir bir MessageDlg işlevi örneği için this answer'a bakın.

İlgili konular