Discussion :

[LadyWasky]

Je tenais à apporter une précision sur la solution tordue que je vous proposerais (et que vous êtes en train de chercher) :

Le gag, c'est que c'est déconcertant de facilité à mettre en oeuvre et assez court. Une fois que l'on connait les trois astuces principales de programmation Delphi qui la composent.
Bref, c'est peut-être tordu, mais franchement simple : pas besoin d'être un dieu de l'algorithme !

Pour vous mettre sur la piste de ma solution, deux des astuces peuvent être trouvées sur votre forum préféré, l'autre je ne l'ai vu qu'une seule fois sur internet et en français (elle existe toujours).

Par contre, les trois combinées pour notre défi, je n'ai rien vu sur internet

[anapurna]

salut

j'avait bien penser a une solution du genre message
mais c'est pas genial

si ca interesse une personne voila le debut de ma reflexion

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
 
procedure TWin2kAppForm.WMMenuSelect(var Msg: TWMMenuSelect) ;
var
   menuItem : TMenuItem;
   menu     : TMenu;
   hSubMenu : HMENU;
begin
   inherited; // from TCustomForm (so that Application.Hint is assigned)
   menuItem := nil;
     if Msg.MenuFlag and MF_POPUP = MF_POPUP then
     begin
       hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem) ;
       menuItem := Self.Menu.FindItem(hSubMenu, fkHandle) ;
      if menuItem.Name = 'Help1' Then
        menuItem.ImageIndex := FPhoneRngIndex
      else
      begin
        menuItem := Self.FindComponent('Help1') as TMenuItem;
        menuItem.ImageIndex := FPhoneIndex;
      end;
     end
     else
     begin
       menuItem := Self.Menu.FindItem(Msg.IDItem, fkCommand) ;
       if menuItem.Name = 'FileExitItem' Then
         menuItem.ImageIndex := 17
       else
       begin
          menuItem := Self.FindComponent('FileExitItem') as TMenuItem;
          menuItem.ImageIndex := 16
       end;
     end;
end;

mais c'est pas beau ca flash
j'ai pas chercher mais il doit bien y avoir d'autre message

@+ Phil

[portu]

J'ai trouvé le moyen de le faire avec une TToolBar où le TMenuItem lui est associé. Tout marche nickel (Couleur, Thème, image). Le seul hic est que je n'arrive pas à mettre l'image par défaut lorsqu'on sort directement du menu sans passer la souris sur les autres Menuitems (a sa gauche).
Le seul truc que j'ai trouvé est d'appeller les évenement OnMouseMove de la Fiche et du ToolBar (Mais bon , y a encore de prob)

Enfin voilà, je me suis bien pris la tête avec ce défi .

[bjl]

Waskol >> bon les résultats, on les connait déjà, je crois: bravo Anapurna !

mais pour le code , tu attends minuit ou quoi ?

[LadyWasky]

Alors..................

Je viens tout juste de rentrer du cinoche avec un pote, donc pour le classement j'ai eu le temps de réfléchir.

Effectivement : bravo anapurna !

Pour ce qui est de la solution, je vous la livre pour l'instant en vrac, je vous donnerais de plus amples informations d'ici une petite heure.

d'abord une petite unité à rajouter au projet :

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
unit UnitSuperMenus;
 
interface
uses Windows, Classes, Menus,Graphics,types,ImgList;
 
type
  TImageIndex=type Integer;
 
  TMenuItemPublic=class(TComponent)
  public
    FCaption: string;
    FHandle: HMENU;
    FChecked: Boolean;
    FEnabled: Boolean;
    FDefault: Boolean;
    FAutoHotkeys: TMenuItemAutoFlag;
    FAutoLineReduction: TMenuItemAutoFlag;
    FRadioItem: Boolean;
    FVisible: Boolean;
    FGroupIndex: Byte;
    FImageIndex: TImageIndex;
    FActionLink: TMenuActionLink;
    FBreak: TMenuBreak;
    FBitmap: TBitmap;
    FCommand: Word;
    FHelpContext: THelpContext;
    FHint: string;
    FItems: TList;
    FShortCut: TShortCut;
    FParent: TMenuItem;
    FMerged: TMenuItem;
    FMergedWith: TMenuItem;
    FMenu: TMenu;
    FStreamedRebuild: Boolean;
    FImageChangeLink: TChangeLink;
    FSubMenuImages: TCustomImageList;
    FOnChange: TMenuChangeEvent;
    FOnClick: TNotifyEvent;
    FOnDrawItem: TMenuDrawItemEvent;
    FOnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
    FOnMeasureItem: TMenuMeasureItemEvent;
    FAutoCheck: Boolean;
  end;
 
  TMenuItemHelper=class(TMenuItem)
  public
    procedure DoAdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
      State: TOwnerDrawState; NewIndex:Integer);
  end;
 
implementation
uses SysUtils;
 
 
{ TMenuItemHelper }
 
procedure TMenuItemHelper.DoAdvancedDrawItem(ACanvas: TCanvas;
  ARect: TRect; State: TOwnerDrawState;
  NewIndex: Integer);
var OldMenuDrawItemEvent:TMenuDrawItemEvent;
    OldAdvancedMenuDrawItemEvent:TAdvancedMenuDrawItemEvent;
    IsTopLevel:Boolean;
begin
  OldMenuDrawItemEvent:=OnDrawItem;
  OldAdvancedMenuDrawItemEvent:=OnAdvancedDrawItem;
  OnDrawItem:=nil;
  OnAdvancedDrawItem:=nil;
  TMenuItemPublic(Self).FImageIndex:=NewIndex;
  IsTopLevel:=(GetParentComponent is TMainMenu);
  AdvancedDrawItem(ACanvas,ARect,State,IsTopLevel);
  OnDrawItem:=OldMenuDrawItemEvent;
  OnAdvancedDrawItem:=OldAdvancedMenuDrawItemEvent;
end;
 
end.

Et dans l'unité du programme principal, où vous aurez pris le soin de mettre la propriété du Menu à OwnerDraw à True, vous remarquerez, l'utilisation des évènements AdvancedDrawItem :

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
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
 
unit W2kMain;
 
interface
 
uses Windows, Classes, Graphics, Forms, Controls, Menus,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ImgList, StdActns,
  ActnList, ToolWin;
 
type
  TWin2kAppForm = class(TForm)
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    ActionList1: TActionList;
    FileNew1: TAction;
    FileOpen1: TAction;
    FileSave1: TAction;
    FileSaveAs1: TAction;
    FileSend1: TAction;
    FileExit1: TAction;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    HelpAbout1: TAction;
    StatusBar: TStatusBar;
    ImageList1: TImageList;
    RichEdit1: TRichEdit;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileNewItem: TMenuItem;
    FileOpenItem: TMenuItem;
    FileSaveItem: TMenuItem;
    FileSaveAsItem: TMenuItem;
    N1: TMenuItem;
    FileSendItem: TMenuItem;
    N2: TMenuItem;
    FileExitItem: TMenuItem;
    Edit1: TMenuItem;
    CutItem: TMenuItem;
    CopyItem: TMenuItem;
    PasteItem: TMenuItem;
    Help1: TMenuItem;
    HelpAboutItem: TMenuItem;
    SaveDialog1: TSaveDialog;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    PopupMenu1: TPopupMenu;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    mm1: TMainMenu;
    mni1: TMenuItem;
    mni2: TMenuItem;
    mni3: TMenuItem;
    mni4: TMenuItem;
    mni5: TMenuItem;
    mni6: TMenuItem;
    mni7: TMenuItem;
    mni8: TMenuItem;
    mni9: TMenuItem;
    mni10: TMenuItem;
    mni11: TMenuItem;
    mni12: TMenuItem;
    mni13: TMenuItem;
    mni14: TMenuItem;
    mni15: TMenuItem;
    procedure FileNew1Execute(Sender: TObject);
    procedure FileOpen1Execute(Sender: TObject);
    procedure FileSave1Execute(Sender: TObject);
    procedure FileSaveAs1Execute(Sender: TObject);
    procedure FileSend1Execute(Sender: TObject);
    procedure FileExit1Execute(Sender: TObject);
    procedure HelpAbout1Execute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Help1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; State: TOwnerDrawState);
    procedure FileExitItemAdvancedDrawItem(Sender: TObject;
      ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
  private
    FFileName: String;
    FDoorShutIndex, FDoorOpenIndex, FPhoneIndex, FPhoneRngIndex : Integer;
  public
    { Public declarations }
  end;
 
var
  Win2kAppForm: TWin2kAppForm;
 
implementation
 
uses
  SysUtils, Mapi, about, SHFolder,UnitSuperMenus;
 
{$R *.dfm}
 
resourcestring
  SUntitled  = 'Untitled';
  SOverwrite = 'OK to overwrite %s';
  SSendError = 'Error sending mail';
 
function DefaultSaveLocation: string;
var
  P: PChar;
begin
  {
    returns the location of 'My Documents' if it exists, otherwise it returns
    the current directory.
  }
  P := nil;
  try
    P := AllocMem(MAX_PATH);
    if SHGetFolderPath(0, CSIDL_PERSONAL, 0, 0, P) = S_OK then
      Result := P
    else
      Result := GetCurrentDir;
  finally
    FreeMem(P);
  end;
end;
 
procedure TWin2kAppForm.FileNew1Execute(Sender: TObject);
begin
  SaveDialog.InitialDir := DefaultSaveLocation;
  FFileName := SUntitled;
  RichEdit1.Lines.Clear;
  RichEdit1.Modified := False;
end;
 
procedure TWin2kAppForm.FileOpen1Execute(Sender: TObject);
begin
  if OpenDialog.Execute then
  begin
    RichEdit1.Lines.LoadFromFile(OpenDialog.FileName);
    FFileName := OpenDialog.FileName;
    RichEdit1.SetFocus;
    RichEdit1.Modified := False;
    RichEdit1.ReadOnly := ofReadOnly in OpenDialog.Options;
  end;
end;
 
procedure TWin2kAppForm.FileSave1Execute(Sender: TObject);
begin
  if (FFileName = SUntitled) or (FFileName = '') then
    FileSaveAs1Execute(Sender)
  else
  begin
    RichEdit1.Lines.SaveToFile(FFileName);
    RichEdit1.Modified := False;
  end;
end;
 
procedure TWin2kAppForm.FileSaveAs1Execute(Sender: TObject);
begin
  with SaveDialog do
  begin
    FileName := FFileName;
    if Execute then
    begin
      if FileExists(FileName) then
        if MessageDlg(Format(SOverwrite, [FileName]),
          mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
      RichEdit1.Lines.SaveToFile(FileName);
      FFileName := FileName;
      RichEdit1.Modified := False;
    end;
  end;
end;
 
procedure TWin2kAppForm.FileSend1Execute(Sender: TObject);
var
  MapiMessage: TMapiMessage;
  MError: Cardinal;
begin
  with MapiMessage do
  begin
    ulReserved := 0;
    lpszSubject := nil;
    lpszNoteText := PChar(RichEdit1.Lines.Text);
    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;
    lpOriginator := nil;
    nRecipCount := 0;
    lpRecips := nil;
    nFileCount := 0;
    lpFiles := nil;
  end;
 
  MError := MapiSendMail(0, Application.Handle, MapiMessage,         
    MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0);
  if MError <> 0 then MessageDlg(SSendError, mtError, [mbOK], 0);
end;
 
procedure TWin2kAppForm.FileExit1Execute(Sender: TObject);
begin
  Close;
end;
 
procedure TWin2kAppForm.HelpAbout1Execute(Sender: TObject);
begin
  AboutBox.ShowModal;
end;
 
procedure TWin2kAppForm.FormCreate(Sender: TObject);
Var Abitmap : Tbitmap;
begin
  ABitmap := Tbitmap.Create;
  Abitmap.LoadFromFile('C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\DoorOpen.bmp');
  FDoorOpenIndex := imagelist1.AddMasked( Abitmap, ClOlive);
  Abitmap.LoadFromFile('C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\DoorShut.bmp');
  FDoorShutIndex := Imagelist1.AddMasked( Abitmap, ClOlive);
  Abitmap.LoadFromFile('C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\Phone.bmp');
  FPhoneIndex := Imagelist1.AddMasked( Abitmap, ClOlive);
  Abitmap.LoadFromFile('C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\PhoneRng.bmp');
  FPhoneRngIndex := Imagelist1.AddMasked( Abitmap, ClOlive);
  Abitmap.Free;
 
  FileNew1.Execute; { sets the default file name and clears the RichEdit Control }
end;
 
 
procedure TWin2kAppForm.Help1AdvancedDrawItem(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var NewImageIndex:Integer;
begin
  if (OdSelected	in State)
  then NewImageIndex:=FPhoneRngIndex
  else NewImageIndex:=FPhoneIndex;
  TMenuItemHelper(Sender).DoAdvancedDrawItem(ACanvas,ARect,State,NewImageIndex);
end;
 
procedure TWin2kAppForm.FileExitItemAdvancedDrawItem(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var NewImageIndex:Integer;
begin
  ACanvas.Font.Color:=clRed;
  ACanvas.Brush.Color:=clYellow;
  if (OdSelected	in State)
  then NewImageIndex:=FDoorOpenIndex
  else NewImageIndex:=FDoorShutIndex;
  TMenuItemHelper(Sender).DoAdvancedDrawItem(ACanvas,ARect,State,NewImageIndex);
end;
 
end.

A+

[LadyWasky]

1ère astuce :
Pouvoir acceder à la méthode protégée AdvancedDrawItem, est réalisé en dérivant la classe de base TMenuItem en TMenuItemHelper et en créant une fonction publique qui l'appelle à son tour.
C'est cette méthode AdvancedDrawItem qui va dessiner l'élément de menu.

Le hic, c'est que la méthode va appeler de nouveau notre évènement qui l'a lui même appeler, donc on risque (le mot est faible..) de ce retrouver avec une boucle sans fin. Bref, ceci :

Code :

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

1
2
3
4
5
6
7
8
9
procedure TWin2kAppForm.Help1AdvancedDrawItem(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var NewImageIndex:Integer;
begin
  if (OdSelected   in State)
  then NewImageIndex:=FPhoneRngIndex
  else NewImageIndex:=FPhoneIndex;
  TMenuItemHelper(Sender).DoAdvancedDrawItem(ACanvas,ARect,State,NewImageIndex);
end;

...s'appelera elle même de façon récursive.
Mais il y a une deuxième astuce

2ème astuce (l'art de désactiver les évènements 8) ) :

Je crois que le code, bien commenté, parle de lui même :

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
procedure TMenuItemHelper.DoAdvancedDrawItem(ACanvas: TCanvas;
  ARect: TRect; State: TOwnerDrawState;
  NewIndex: Integer);
var OldMenuDrawItemEvent:TMenuDrawItemEvent;
    OldAdvancedMenuDrawItemEvent:TAdvancedMenuDrawItemEvent;
    IsTopLevel:Boolean;
begin
  //On sauvegarde un lien vers les procédures évènements rattachées au MenuItem et qui sont appelées par la méthode AdvancedDrawItem
  OldMenuDrawItemEvent:=OnDrawItem;
  OldAdvancedMenuDrawItemEvent:=OnAdvancedDrawItem;
 
  //Puis on "détache" les évènements, comme ça ils ne risquent plus d'ètre appelés
  OnDrawItem:=nil;
  OnAdvancedDrawItem:=nil;
 
  //L'explication de cette ligne constitue la troisième astuce ;p
  TMenuItemPublic(Self).FImageIndex:=NewIndex;
 
  //Cette ligne est nécessaire pour le bon fonctionnement de AdvancedDrawItem
  IsTopLevel:=(GetParentComponent is TMainMenu);
 
  //Ici, on appelle notre méthode protégée, du coup sans le déclenchement des évènement, donc en dessinant le menu à la Delphi :)
  AdvancedDrawItem(ACanvas,ARect,State,IsTopLevel);
 
  //et on fini en restituant au MenuItem ses évènements
  OnDrawItem:=OldMenuDrawItemEvent;
  OnAdvancedDrawItem:=OldAdvancedMenuDrawItemEvent;
end;

Si vous avez essayés, à ce stade ou un autre de vos recherches, de modifier ImageIndex vous avez du en suer , puisque en fait, c'est la variable privée FImageIndex qu'il fallait réussir à modifier. Le problème est que, lorsque vous modifiez la propriété ImageIndex, Delphi redessine son menu

"Mais comment acceder à la variable privée d'un objet ?"

me direz vous...
J'en vois des sceptiques d'ici, qui se disent :

non.... c'est pas possible.

Hé bien si c'est possible (na !)

3ème astuce (la plus tordue ) :

Donc, comme vous l'avez certainement compris, tout réside dans la magie du transtypage, et du fait que les types classes ne sont rien d'autres que des types de pointeurs particuliers.

Tout d'abord, Il aura fallu déclarer la classe TMenuItemPublic qui dérive de TComponent, tout comme TMenuItem.

Vous remarquerez, que l'on y retrouve exactement les mêmes variables et exactement dans le même ordre que dans la classe TMenuItem, à la différence que ces variables sont toutes déclarées public.

Ainsi, on obtient une classe ayant la même structure en mémoire que la classe TMenuItem, ce qui nous autorise alors à transtyper un TMenuItem en TMenuItemPublic et nous permet alors d'accéder à toutes les variables privées de TMenuItem comme si elles avaient été déclarées Public !

La variable qui nous intéresse en particulier étant

Code :

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

FImageIndex

, le problème est résolu

En prime je vous ai rajouté une modification des couleurs de l'élément de menu.


En tout cas Bravo bjl, portu et anapurnaqui avez su animer ce thread à travers votre participation à une question qui n'était pas si facile à résoudre.


Je pars demain matin en vacances avec ma petite famille dans un endroit où il n'y a ni internet ni ordinateur.

Je serais de retour sur le forum Mardi ou Mercredi (le 26/12 ou 27/12).
En attendant, je vous souhaites à tous de joyeuse fêtes.

A+

[Hauwke]

Félicitations aux gagnants
Vous avez gagné une montre de 45 kg, le bracelet du même métal ou mon estime, au choix

[anapurna]

Salut

jolie solution

le pire c'est qu'au debut je pensait "Hacker" le TmenuItem
mais je n'arrivait pas a redefinir ma fonction de dessin

J'ai pas du tout penser a recreer une methode suplementaire
pour desactiver et reactiver la methode ondrawitems

c'est vrai qu'il faut etre tordu pour penser a des trucs pareil
Bon a tout prendre l'estime me sufira


@+ Phil

[bjl]

hello,

pour continuer dans le principe objet mais hors concours (délai dépassé )

en reprenant le code de Waskol,

l'unit supermenus devient

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
unit supermenus;
 
Interface
 
uses Windows, Classes, Graphics, Controls, Menus, ImgList, SysUtils;
 
 
Type TMenuExoticLink = Class(TComponent)
  Private
    FSelectImageIndex : integer;
    FUnselectImageIndex : Integer;
    FMenuItem : TMenuItem;
    FImageListWidth : Integer;
    FFontColor : TColor;
    FBrushColor : TColor;
    FparentFontColor : Boolean;
    FParentBrushColor : Boolean;
  Protected
    procedure AdvancedDrawMenuItem(Sender: TObject;
      ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
  public
    Constructor Create( Aowner : Tcomponent; Item : TmenuItem; var ImageList : TimageList; UnselectBmp,
      Selectbmp : TfileName);reintroduce;
    Procedure ChangeFontColor( Value : TColor);
    Procedure ChangeBrushColor( Value : Tcolor);
    Procedure ChangeAspectColors( FontColor, BrushColor : TColor);
  published
  End;
 
 
implementation
 
Type
  TImageIndex = type Integer;
 
  TMenuItemPublic=class(TComponent)
  public 
    FCaption: string; 
    FHandle: HMENU; 
    FChecked: Boolean; 
    FEnabled: Boolean; 
    FDefault: Boolean; 
    FAutoHotkeys: TMenuItemAutoFlag; 
    FAutoLineReduction: TMenuItemAutoFlag; 
    FRadioItem: Boolean; 
    FVisible: Boolean; 
    FGroupIndex: Byte; 
    FImageIndex: TImageIndex;
    FActionLink: TMenuActionLink; 
    FBreak: TMenuBreak; 
    FBitmap: TBitmap; 
    FCommand: Word;
    FHelpContext: THelpContext;
    FHint: string; 
    FItems: TList; 
    FShortCut: TShortCut; 
    FParent: TMenuItem; 
    FMerged: TMenuItem; 
    FMergedWith: TMenuItem; 
    FMenu: TMenu; 
    FStreamedRebuild: Boolean;
    FImageChangeLink: TChangeLink;
    FSubMenuImages: TCustomImageList; 
    FOnChange: TMenuChangeEvent; 
    FOnClick: TNotifyEvent;
    FOnDrawItem: TMenuDrawItemEvent; 
    FOnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
    FOnMeasureItem: TMenuMeasureItemEvent; 
    FAutoCheck: Boolean; 
  end; 
 
 
TMenuItemHelper=class(TMenuItem) 
  public
    procedure DoAdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
      State: TOwnerDrawState; NewIndex:Integer); 
  end; 
 
procedure TMenuItemHelper.DoAdvancedDrawItem(ACanvas: TCanvas;
  ARect: TRect; State: TOwnerDrawState; 
  NewIndex: Integer); 
var OldMenuDrawItemEvent:TMenuDrawItemEvent; 
    OldAdvancedMenuDrawItemEvent:TAdvancedMenuDrawItemEvent;
    IsTopLevel:Boolean;
begin
  OldMenuDrawItemEvent:=OnDrawItem;
  OldAdvancedMenuDrawItemEvent:=OnAdvancedDrawItem;
  OnDrawItem:=nil; 
  OnAdvancedDrawItem:=nil; 
  TMenuItemPublic(Self).FImageIndex:=NewIndex;
  IsTopLevel:=(GetParentComponent is TMainMenu);
  AdvancedDrawItem(ACanvas,ARect,State,IsTopLevel);
  OnDrawItem:=OldMenuDrawItemEvent;
  OnAdvancedDrawItem:=OldAdvancedMenuDrawItemEvent;
end; 
 
 
 
Constructor TMenuExoticLink.Create( Aowner : Tcomponent;Item : TmenuItem; var ImageList : TimageList; UnselectBmp,
  Selectbmp : TfileName);
Var
  Abitmap : Tbitmap;
Begin
  inherited create(aowner);
  FMenuItem := Item;
  ABitmap := Tbitmap.Create;
  Abitmap.LoadFromFile(UnselectBmp);
  FUnselectImageIndex := imagelist.AddMasked( Abitmap, ClOlive);
  Abitmap.LoadFromFile(SelectBmp);
  FSelectImageIndex := imagelist.AddMasked( Abitmap, ClOlive);
  Abitmap.Free;
  FMenuItem.OnAdvancedDrawItem := AdvancedDrawMenuItem;
  If (FMenuItem.GetParentComponent is TMainMenu) then
    FimageListWidth := ImageList.Width
  else FimageListWidth:= 0;
  FParentFontColor := True;
  FParentBrushColor := True;
End;
 
procedure TMenuExoticLink.AdvancedDrawMenuItem(Sender : Tobject;
  ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var NewImageIndex:Integer;
begin
  if (OdSelected   in State)
  then NewImageIndex:=FSelectImageIndex
  else NewImageIndex:=FUnselectImageIndex;
  if not FParentFontCOlor then
    ACanvas.Font.Color := FFontColor;
  if not FParentBrushColor then
    ACanvas.Brush.Color := FBrushColor;
  Arect.Right := Arect.Right + FImageListWidth; // ajuste la taille du rect à dessiner
  TMenuItemHelper(Sender).DoAdvancedDrawItem(ACanvas,ARect,State,NewImageIndex);
end;
 
Procedure TMenuExoticLink.ChangeFontColor( Value : TColor);
Begin
FParentFontColor := False;
FFontColor := Value;
End;
 
Procedure TMenuExoticLink.ChangeBrushColor( Value : Tcolor);
Begin
FParentBrushColor := False;
FBrushColor := Value;
End;
 
Procedure TMenuExoticLink.ChangeAspectColors( FontColor, BrushColor : TColor);
Begin
ChangeFontColor(FontColor);
ChangeBrushColor(BrushColor);
End;
 
end.

et dans l'application principale on ajuste à faire

mettre TmainMenu.ownerdraw à true
assigner TForm1.create à l'évènement Oncreate (curieusement ce n'est pas fait quand je crée une application W2K)
mettre supermenus dans les uses.

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
 
 
type
  TWin2kAppForm = class(TForm)
...
  private
    FFileName: String;
    HelpLink : TMenuExoticLink;
    ExitLink : TMenuExoticLink;
  public
..
 
Implementation
 
 
procedure TWin2kAppForm.FormCreate(Sender: TObject);
begin
    HelpLink := TMenuExoticLink.Create(self, Help1, imagelist1,
      'C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\Phone.bmp',
      'C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\PhoneRng.bmp');
    HelpLink.ChangeAspectColors(ClYellow, Clred);
 
    ExitLink := TMenuExoticLink.Create(self, FileExitItem, imagelist1,
      'C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\DoorShut.bmp',
      'C:\Program Files\Fichiers communs\Borland Shared\Images\Buttons\DoorOpen.bmp');
 
  FileNew1.Execute; { sets the default file name and clears the RichEdit Control }
end;

il reste juste une petite chose. un effet disgracieux sous l'item Help après première sélection.

[LadyWasky]

Joli bjl ! L'amélioration est sympa

En tout cas, je suis persuadé que ces 3 astuces de programmation vous servirons dans d'autre projets et étendrons les possibilités déjà nombreuses de vos composants.

Ce qui pourrais être sympa, c'est de creuser un peu la chose pour savoir où celà peut-il avoir une utilité concrète ailleurs que pour les icones de menus.
Il doit bien exister d'autres applications de la technique que je vous ai exposé ici, mais je manque franchement d'inspiration ces derniers temps.

Comme vous l'avez remarqué, je suis de retour de congé et de nouveau dispo pour de nouvelles aventures

[anapurna]

salut

on doit pouvoir utiliser la meme astuce pour mettre un icone
ou changer la couleur des caractere dans les tabsheet

@+ Phil

[LadyWasky]

salut

on doit pouvoir utiliser la meme astuce pour mettre un icone
ou changer la couleur des caractere dans les tabsheet

@+ Phil

Après m'etre penché sur le problème, ce n'est pas évident que ça marche avec les Tabsheet...

[anapurna]

salut


pourtant pour changer la couleur de mon texte
j'utilise ceci

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
type 
   TMPageControl = class (TPageControl)
  end;
// permet d'acceder au propriete Tabs
...
procedure TMyform.pcTestDrawTab(Control: TCustomTabControl;
  TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
  TabText: string;
  P: TPageControl;
  OutRect : TRect;
begin
 p :=   Control as TPageControl ;
 TabText := TMPageControl(P).Tabs[TabIndex];
 OutRect := Rect;
 InflateRect (OutRect, -3, -3);
 OutRect.Left := OutRect.Left + 3;
 if Active Then
 begin
   P.Canvas.Font.Color := clred ;
 end
 else
 begin
   P.Canvas.Font.Color := clBlack;
 end;
 DrawText (Control.Canvas.Handle,
    PChar (ExtractFileName (TabText)),
    Length (ExtractFileName (TabText)),
    OutRect, dt_Left or dt_SingleLine or dt_VCenter);
     P.Pages[TabIndex].Caption);
end;

ce n'est pas tres eloigner de ma premiere solution donc je supose qu'il est possible d'affecter la tienne


@+ Phil

[bjl]

Bien .....

à quand le prochain défi ?

je crois que Waskol est impatient

[LadyWasky]

Bien .....

à quand le prochain défi ?

je crois que Waskol est impatient

Oh oui, oh oui !!!

Je suis prêt

[anapurna]

salut

Qui doit le lancer ?
moi aussi je suis pres a le pietiner

@+ Phil

[Pedro]

Une question: Est-ce que si je donne un défi, je doit forcément connaître la réponse? Autrement dit, est-ce qu'on peut utiliser le défi pour trouver une solution à un problème visiblement insoluble? Parce que j'en ai un pas mal

[LadyWasky]

Une question: Est-ce que si je donne un défi, je doit forcément connaître la réponse? Autrement dit, est-ce qu'on peut utiliser le défi pour trouver une solution à un problème visiblement insoluble? Parce que j'en ai un pas mal

Connaître une réponse, c'est mieux quand mème... Charge aux compétiteurs d'en trouver une meilleure que la tienne

Sinon, vas-y, propose (on ne sait jamais) !

[Pedro]

Ben j'ai une solution mais elle n'est franchement pas belle (bricolage)
Dans ce cas: j'y vais:
Créer un TPageControl customisé qui permetrait:
- De redessiner complètement les onglets à partir de Bitmap ou bien pré établi (comme par exemple, la possibilité de dessiner un dégradé depuis une couleur FromColor vers ToColor et les bords d'une autre couleur)
- D'avoir, sur chaque onglet, une croix de fermeture (soit standard soit dessinée à partir de TBitmap) qui détruise l'onglet et ses objets contenus
- D'avoir un évènement OnCanClose lors de la destruction d'un onglet qui (comme celui d'un TForm) donne la permission ou non de la destruction (var CanClose:boolean) Personnellement, c'est sur celui-là que je bute
- D'avoir des highlights quand la souris passe dessus (Par exemple: quand le curseur passe sur la croix de fermeture, elle se met en relief)
- De pouvoir redessiner les flèches de défilement qui apparaissent lorsqu'il y a trop d'onglets (toujours avec une possibilité d'highlight)

Voila... Evidemment, l'intérêt est de partir d'un TPageControl (ou bien de son ancêtre direct)...
Bien entendu, toutes ces possibilités doivent être accessible aussi bien en Run-Time qu'en Designe Time
[Edit]N'hésitez pas à dire si ça ne vous plait pas

[LadyWasky]

- D'avoir un évènement OnCanClose lors de la destruction d'un onglet qui (comme celui d'un TForm) donne la permission ou non de la destruction (var CanClose:boolean) Personnellement, c'est sur celui-là que je bute

Non, il vaut mieux éviter de court circuiter le destructeur Destroy du TTabShhet...
En effet, Imagine que l'applicatioon se termine :
1) L'application demande la destruction de la fiche.
2) La fiche demande la destruction du TPageControl
3) le TPageControl demande la destruction du TTabSheet a FPages (variable privée de type TList)
4).. qui appelle le destroy du TTabSheet, et là... le TabSheet ne veut pas, CROUIK, ça coince et Delphi te sort un "Access Violation" des familles

Une solution consiste à créer une procedure "gentille" dans le descendant du TTabControl chargée de détruire indirectement un onglet.

Voici le nouveau composant :

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
 
unit waPageControl;
 
interface
 
uses
  SysUtils, Classes, Controls, ComCtrls,Types;
 
type
  TTabSheetCloseEvent = procedure(Control: TCustomTabControl; Page: TTabSheet;
   var CanClose: Boolean) of object;
 
  TwaPageControl = class(TPageControl)
  private
    FOnCanClose: TTabSheetCloseEvent;
    procedure SetOnCanClose(const Value: TTabSheetCloseEvent);
    { Déclarations privées }
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    procedure ClosePage(Page:TTabSheet);
  published
    { Déclarations publiées }
    property OnCanClose:TTabSheetCloseEvent read FOnCanClose write SetOnCanClose;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TwaPageControl]);
end;
 
{ TwaPageControl }
 
procedure TwaPageControl.ClosePage(Page: TTabSheet);
var CanClose:Boolean;
begin
  CanClose:=True;
  if Assigned(FOnCanClose) then FOnCanClose(Self,Page,CanClose);
  if CanClose then Page.Free;
end;
 
procedure TwaPageControl.SetOnCanClose(const Value: TTabSheetCloseEvent);
begin
  FOnCanClose := Value;
end;
 
end.

Et un exemple d'utilisation (un waPageControl et un Bouton dans une fiche, avec l'évènement OnCanClose du waPageControl) :

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, waPageControl, StdCtrls;
 
type
  TForm1 = class(TForm)
    waPageControl1: TwaPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure waPageControl1CanClose(Control: TCustomTabControl;
      Page: TTabSheet; var CanClose: Boolean);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with waPageControl1 do
    ClosePage(ActivePage);
end;
 
procedure TForm1.waPageControl1CanClose(Control: TCustomTabControl;
  Page: TTabSheet; var CanClose: Boolean);
begin
  if Page.Tag=1 then CanClose:=False;
end;
 
end.