Personnaliser les boutons du MessageDialog

**popo** · 22/09/2009, 14h47

Bonjour,

Tout est dans le titre.
Je crée une boite de dialogue avec "CreateMessageDialog" et j'aimerai que les boutons (dans mon cas "Oui" et "Non") contienne des icone comme le BitBtn. En fait ce sont les icone des BitBtn Oui et Non que je veux faire apparaitre

Y'a t'il un moyen de le faire sachant que la solution de créer une fiche de remplacement ne convient pas.

Merci

**ShaiLeTroll** · 22/09/2009, 15h32

tu peux ajouter un paramètre tableau supplémentaire dans une MessageDlgCustomButton, ou pour chaque élément du Boutons, tu spécifie un libellé différent

j'ai bidouillé ça, je ne l'ai pas encore beaucoup utilisé cela fonctionne au moins pour mrYes et mrNo ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
{* --- MessageDlgCustomBtn ----------------------------------------------------}
function MessageDlgPosHelpCustomBtn(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; const ButtonStrings: array of String; HelpCtx: Longint; X, Y: Integer; const HelpFileName: string): Integer;
const
  ModalResults: array[TMsgDlgBtn] of Integer = (mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll, mrYesToAll, 0);
var
  MsgForm: TForm;
  IndexControls: Integer;
  IndexButtons: TMsgDlgBtn;
  IndexStrings: Integer;
  NewWidth, AllWidth, BaseWidth, BaseHeigth, BaseLeft, BaseTop: Integer;
  TextRect: TRect;
  ButtonLine: Integer;
begin
  MsgForm := CreateMessageDialog(Msg, DlgType, Buttons);
  with MsgForm do
  try
    if Length(ButtonStrings) > 0 then
    begin
      IndexStrings := Low(ButtonStrings);
      for IndexButtons := Low(IndexButtons) to High(IndexButtons) do
      begin
        if (IndexButtons in Buttons) and (IndexStrings <= High(ButtonStrings)) then
        begin
          for IndexControls := 0 to ControlCount - 1 do
          begin
            if Controls[IndexControls] is TButton then
            begin
              with TButton(Controls[IndexControls]) do
              begin
                if ModalResults[IndexButtons] = ModalResult then
                begin
                  Caption := ButtonStrings[IndexStrings];
                  Inc(IndexStrings);
 
                  if IndexStrings > High(ButtonStrings) then
                    Break;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
 
    AllWidth := 0;
    BaseHeigth := 0;
    BaseTop := MaxInt;
    for IndexControls := 0 to ControlCount - 1 do
    begin
      if Controls[IndexControls] is TButton then
      begin
        with TButton(Controls[IndexControls]) do
        begin
          TextRect := Rect(0,0,0,0);
          Windows.DrawText(Canvas.Handle, PChar(Caption), -1, TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly);
          with TextRect do
            NewWidth := Right - Left + 16;
 
          if NewWidth > Width then
            Width := NewWidth;
 
          Inc(AllWidth, Width + 8);
 
          if Height > BaseHeigth then
            BaseHeigth := Height;
 
          if Top < BaseTop then
            BaseTop := Top;
        end;
      end;
    end;
 
 
    // 2/3 de l'écran au maximum
    if AllWidth > ClientWidth then
    begin
      if AllWidth + 16 > (Screen.WorkAreaWidth div 3 * 2) then
        ClientWidth := (Screen.WorkAreaWidth div 3 * 2)
      else
        ClientWidth := AllWidth + 16;
    end;
 
    if AllWidth + 16 > ClientWidth then
      BaseWidth := ClientWidth - 16
    else
      BaseWidth := AllWidth;
 
    BaseLeft := (MsgForm.ClientWidth - BaseWidth) div 2;
    ButtonLine := 0;
    for IndexControls := 0 to ControlCount - 1 do
    begin
      if Controls[IndexControls] is TButton then
      begin
        with TButton(Controls[IndexControls]) do
        begin
          if (BaseWidth <> AllWidth) and (BaseLeft + Width > MsgForm.ClientWidth) then
          begin
            BaseLeft := (MsgForm.ClientWidth - BaseWidth) div 2;
            Inc(BaseTop, BaseHeigth + 8);
            Inc(ButtonLine);
          end;
 
          Left := BaseLeft;
          Top := BaseTop;
          Inc(BaseLeft, Width + 8);
        end;
      end;
    end;
 
    if ButtonLine > 0 then
      ClientHeight  := ClientHeight + ButtonLine * (BaseHeigth + 8);
 
    HelpContext := HelpCtx;
    HelpFile := HelpFileName;
    if X >= 0 then Left := X;
    if Y >= 0 then Top := Y;
    if (Y < 0) and (X < 0) then Position := poScreenCenter;
    Result := ShowModal;
  finally
    Free;
  end;
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if MessageDlgCustomBtn('Type de Restauration ?', mtConfirmation, [mbYes, mbNo], ['Rapide', 'Complète']) = mrYes then

l'ordre dans le Tableau est l'ordre naturelle de l'énumération

**popo** · 22/09/2009, 17h37

Je te remercie pour avoir répondu rapidement mais après avoir lu assez rapidement ton script, ça ce convient pas. Je ne cherche pas à modifier le caption de mes boutons mais plutôt à y insérer le petit V vert à coté du Oui et le petit O rouge avec la barre en travers à coté du Non, comme s'il s'agissait d'un BitBtn.

Pour le moment, j'ai commencé à me crééer mon propre CreateMessageDialog en créant des TBitBtn à la place des TButtons. je trouve que c'est barbare de faire ça mais c'est la seule solution qui m'est venue à l'esprit.

Si vous avez autre chose à me proposer je suis preneur.

**ShaiLeTroll** · 22/09/2009, 19h03

Ah, je l'ai faite aussi en encore plus barbare, je remplace le TButton déjà créé par d'autre TBitBtn ... c'est pas mieux ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
 
{* -----------------------------------------------------------------------------
MessageDlgFont fonctionne comme MessageDlg avec la Gestion de la Font pour la fenêtre et les Boutons
@param Msg Chaine à Afficher
@param DlgType Type du Dialogue
@param Buttons Ensemble de boutons
@param DefaultButton Désigne le bouton qui sera actif par défaut
@param FontMsg Font spécifique pour Fenêtre et Boutons
@param HelpCtx Contexte d'Aide
@return Entier Résultat associé à chaque Bouton
------------------------------------------------------------------------------ }
function MessageDlgFont(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; FontMsg: TFont; HelpCtx: Longint = 0): Integer; overload;
function MessageDlgFont(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn; FontMsg: TFont; HelpCtx: Longint = 0): Integer; overload;
function MessageDlgPosFont(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; FontMsg: TFont; HelpCtx: Longint; X, Y: Integer): Integer; overload;
function MessageDlgPosFont(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn; FontMsg: TFont; HelpCtx: Longint; X, Y: Integer): Integer; overload;
function MessageDlgPosHelpFont(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; FontMsg: TFont; HelpCtx: Longint; X, Y: Integer; const HelpFileName: string): Integer; overload;
function MessageDlgPosHelpFont(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn; FontMsg: TFont; HelpCtx: Longint; X, Y: Integer; const HelpFileName: string): Integer; overload;
 
 
...
 
{ MessageDlgFont }
 
{* --- MessageDlgFont ---------------------------------------------------------}
function MessageDlgFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; FontMsg: TFont; HelpCtx: Longint = 0): Integer;
begin
  Result := MessageDlgPosHelpFont(Msg, DlgType, Buttons, FontMsg, HelpCtx, -1, -1, '');
end;
 
{* --- MessageDlgFont ---------------------------------------------------------}
function MessageDlgFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn; FontMsg: TFont;
  HelpCtx: Longint = 0): Integer;
begin
  Result := MessageDlgPosHelpFont(Msg, DlgType, Buttons, DefaultButton, FontMsg, HelpCtx, -1, -1, '');
end;
 
{* --- MessageDlgFont ---------------------------------------------------------}
function MessageDlgPosFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; FontMsg: TFont;
  HelpCtx: Longint; X, Y: Integer): Integer;
begin
  Result := MessageDlgPosHelpFont(Msg, DlgType, Buttons, FontMsg, HelpCtx, X, Y, '');
end;
 
{* --- MessageDlgFont ---------------------------------------------------------}
function MessageDlgPosFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn; FontMsg: TFont;
  HelpCtx: Longint; X, Y: Integer): Integer;
begin
  Result := MessageDlgPosHelpFont(Msg, DlgType, Buttons, DefaultButton, FontMsg, HelpCtx, X, Y, '');
end;
 
{* --- MessageDlgFont forward -------------------------------------------------}
function _MessageDlgPosHelpFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; const DefaultButtonArray: array of TMsgDlgBtn;
  FontMsg: TFont; HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: string): Integer; forward;
 
{* --- MessageDlgFont ---------------------------------------------------------}
function MessageDlgPosHelpFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; FontMsg: TFont; HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: string): Integer;
var
  DefaultButtonArray: array of TMsgDlgBtn;
begin
  SetLength(DefaultButtonArray, 0);
  Result := _MessageDlgPosHelpFont(Msg, DlgType, Buttons, [], FontMsg, HelpCtx, X, Y, '');
end;
 
{* --- MessageDlgFont ---------------------------------------------------------}
function MessageDlgPosHelpFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn; FontMsg: TFont;
  HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: string): Integer;
var
  DefaultButtonArray: array of TMsgDlgBtn;
begin
  SetLength(DefaultButtonArray, 1);
  DefaultButtonArray[0] := DefaultButton;
  Result := _MessageDlgPosHelpFont(Msg, DlgType, Buttons, DefaultButtonArray, FontMsg, HelpCtx, X, Y, '');
end;
 
{* --- MessageDlgFont ---------------------------------------------------------}
function _MessageDlgPosHelpFont(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; const DefaultButtonArray: array of TMsgDlgBtn;
  FontMsg: TFont; HelpCtx: Longint; X, Y: Integer;
  const HelpFileName: string): Integer;
 
var
  MsgForm: TForm;
  MsgLabel: TComponent;
  IndexControls: Integer;
  OldWidth, OldFontSize, OldLabelWidth, OldLabelHeight, Decalage: Integer;
  OldButton: TButton;
  OverButton: TBitBtn;
 
  procedure SetOverButtonKind(AKind: TBitBtnKind; BtnType: TMsgDlgBtn);
  begin
    OverButton.Kind := AKind;
    OverButton.ModalResult := OldButton.ModalResult;
 
    if OldButton.Default then
    begin
      OldButton.Default := False;
      OverButton.Default := (Length(DefaultButtonArray) = 0) or ((Length(DefaultButtonArray) = 1) and (DefaultButtonArray[0] = BtnType));
    end
    else
      OverButton.Default := (Length(DefaultButtonArray) = 1) and (DefaultButtonArray[0] = BtnType);
 
    if OverButton.Default then
      OverButton.TabOrder := 0; // Ne devrais pas être nécessaire en théorie, mais en pratique cela fonctionne bien mieux !
    if OldButton.Cancel then
    begin
      OldButton.Cancel := False;
      OverButton.Cancel := True;
    end;
 
    if Assigned(OldButton.OnClick) then
     OverButton.OnClick := OldButton.OnClick;
  end;
 
begin
  MsgForm := CreateMessageDialog(Msg, DlgType, Buttons);
  with MsgForm do
  try
    MsgLabel := FindComponent('Message');
    if MsgLabel is TLabel then
    begin
      OldLabelWidth := TLabel(MsgLabel).Width;
      OldLabelHeight := TLabel(MsgLabel).Height;
      OldFontSize := Math.Max(TLabel(MsgLabel).Font.Size, 1);
      TLabel(MsgLabel).Font.Assign(FontMsg);
 
      TLabel(MsgLabel).Width := Math.Min(Math.Max(OldLabelWidth, Round(OldLabelWidth * TLabel(MsgLabel).Font.Size / OldFontSize)), Screen.Width div 2);
 
      OldWidth := Width;
      Width := Math.Max(Width, Width - OldLabelWidth + TLabel(MsgLabel).Width);
      Decalage := (Width - OldWidth) div 2;
 
      for IndexControls := 0 to ControlCount - 1 do
      begin
        if Controls[IndexControls] is TButton then
        begin
          OldButton := TButton(Controls[IndexControls]); // utilisé dans SetOverButtonKind
 
          OverButton := TBitBtn.Create(MsgForm);
          OverButton.Left := OldButton.Left + Decalage;
          OverButton.Top := OldButton.Top;
          OverButton.Height := OldButton.Height + 2;
          OverButton.Width := OldButton.Width;
          OverButton.Parent := OldButton.Parent;
          OverButton.Anchors := OldButton.Anchors - [akTop] + [akBottom];
 
          case OldButton.ModalResult of
            mrNone: SetOverButtonKind(bkHelp, mbHelp);
            mrOk: SetOverButtonKind(bkOK, mbOK);
            mrCancel: SetOverButtonKind(bkCancel, mbCancel);
            mrAbort: SetOverButtonKind(bkAbort, mbAbort);
            mrRetry: SetOverButtonKind(bkRetry, mbRetry);
            mrIgnore: SetOverButtonKind(bkIgnore, mbIgnore);
            mrYes: SetOverButtonKind(bkYes, mbYes);
            mrNo: SetOverButtonKind(bkNo, mbNo);
            mrAll: SetOverButtonKind(bkAll, mbAll);
            mrNoToAll: SetOverButtonKind(bkNo, mbYesToAll);
            mrYesToAll: SetOverButtonKind(bkYes, mbNoToAll);
          end;
 
          OldButton.Enabled := False;
          OldButton.Visible := False;
        end;
      end;
 
      Height := Math.Max(Height, Height - OldLabelHeight + TLabel(MsgLabel).Height);
 
      Left := (Screen.Width div 2) - (Width div 2);
      Top := (Screen.Height div 2) - (Height div 2);
    end;
 
    HelpContext := HelpCtx;
    HelpFile := HelpFileName;
    if X >= 0 then Left := X;
    if Y >= 0 then Top := Y;
    if (Y < 0) and (X < 0) then Position := poScreenCenter;
    Result := ShowModal();
  finally
     Free;
  end;
end;

**popo** · 23/09/2009, 18h10

Je l'ai un peu épuré pour mes besoins mais c'est tout à fait ça.
Merci

Personnaliser les boutons du MessageDialog

Delphi

Discussions similaires

Partager

Partager