Discussion :

[Pill_S]

Bonjour à tous,

je rencontre un problème avec Delphi 6 et la création de composants. J'essaie d'ajouter une propriété 'font' à une classe dérivée de TStringGrid.

Ce TFont représente une police de caractères particulière que j'aimerais appliquer sur une colonne du StringGrid. (pour la petite histoire, cela devrait permettre d'afficher les caractères grecs, russes, ... en tant que caractères MBCS et ce dans une colonne unique, alors que les autres garderont la font d'origine)

Voilà comment je m'y prend:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
type
  TMyStringGrid=class(TStringGrid)
    private 
     TempFont:TFont; {sauvegarde lors du changement}
      fAnotherFont:TFont;{cf. property}
      // ...
    published
      property AnotherFont:TFont read fAnotherFont write fAnotherFont;
      ...
  end;

et dans le constructeur:

Code :

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

1
2
 
AnotherFont:=TFont.Create;

ensuite, dans le OnDrawCell, lorsque je détecte que je suis sur la colonne voulue, j'ai fait comme ceci:

Code :

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

1
2
3
4
 
 Canvas.Font:=fAnotherFont; {font spéciale}
 Canvas.TextOut(Rect.Left, Rect.Top, 'translated value');
 Canvas.Font:=TempFont; {font normale}

ça parait simple...

Mais quand je pose mon composant sur une fiche, et que je change la valeur de la propriété AnotherFont, delphi me balance une de ses fameuses "Violation d'accès à l'adresse 4001D0A2 dans le module rtl6.bpl. Lecture de l'adresse 000000001"



Où est l'erreur ??!

Merci

PS: ça me fait ça avec n'importe quel type de composant, comme les TLabel ou les TDrawGrid...

[bjl]

bonjour

dans le créteur, il faudrait

FAnotherfont := Tfont.create;


rq : je ne suis pas sur qu'il ne faille pas ecrire aussi

Code :

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

1
2
3
4
5
6
7
8
9
10
type 
  TMyStringGrid=class(TStringGrid) 
    private 
      fAnotherFont:TFont; 
      Procedure SetAnotherFont(Value : Tfont);
      // ... 
    published 
      property AnotherFont:TFont read fAnotherFont write setAnotherFont; 
      ... 
  end;

avec une procedure

Procedure TMyStringGrid.SetAnotherFont(Value : Tfont);
Begin
FAnotherFont := Value;
..... {traitement du changement du font }
End;

[Pill_S]

dans le créteur, il faudrait

FAnotherfont := Tfont.create;

déjà fait lis mon post précédent

rq : je ne suis pas sur qu'il ne faille pas ecrire aussi...

personnelement je ne pense pas, étant donné que je n'ai pas envie de réagir particulièrement à la modification de cette propriété... Elle est directement liée à "fAnotherFont"

[RamDevTeam]

J'ai le code suivant sous D7 et ca marche sans pb.

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
 
Private
  Fpolice : Tfont;
  ...
Published
    property Police: TFont read FPolice write SetPolice;
 
...
 
constructor TMonCOmpo.Create;
begin
	inherited;
	FPolice:= TFont.Create;
end;
 
destructor TMonCOmpo.Destroy;
begin
	FPolice.Free;
end;
 
procedure TMonCOmpo.SetPolice(const Value: TFont);
begin
	FPolice := Value;
end;

tu es sur que le pb ne vient pas du OnDrawCell ?

[bjl]

dans le créteur, il faudrait

FAnotherfont := Tfont.create;

déjà fait lis mon post précédent

désolé, tu as écrit anotherfont := Tfont.create;

et non

fanotherfont := Tfont.create;

[Pill_S]

tu es sur que le pb ne vient pas du OnDrawCell ?

malheureusement non... je l'ai vidée de tout son code et ça continue à planter.....

désolé, tu as écrit anotherfont := Tfont.create;

et non

fanotherfont := Tfont.create;

en effet, vraiment désolé

mais ça ne résoud pas le problème....



En fait, après déclenchement de cette exception, delphi me fait une grosse plantée qui ne me laisse même pas le temps d'enregistrer mon projet..... et toujours le même message d'erreur...

Je poste le code complet, pour que vous puissiez tester chez vous (il est pas très long...):

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
 
unit TranslationStringGrid;
 
interface
 
uses
  Menus, Windows, Graphics, Messages, SysUtils, Classes, Controls, Grids;
 
type
  TTranslationStringGrid = class(TStringGrid)
    private
      APopupMenu:TPopupMenu;
      StandardFont:TFont;
      fTranslationColFont: TFont;
      fOnMouseUp: TMouseEvent;
      fOnDrawCell: TDrawCellEvent;
      fOnSetEditText: TSetEditEvent;
 
      procedure DoSortData(AColIndex:Integer);
      procedure SetColCount(AColCount:Integer);
      procedure SetOptions(ANewOptions:TGridOptions);
      procedure DoMouseUp(Sender:TObject; Button:TMouseButton;Shift:TShiftState;
                                                                   X,Y:Integer);
      procedure DoPaint(Sender:TObject; ACol,ARow:Longint; Rect:TRect;
                                                          State:TGridDrawState);
      procedure DoSetEditText(Sender:TObject; ACol,ARow:Longint;
                                                            const Value:String);
    public
      constructor Create(AOwner:TComponent); override;
      destructor Destroy; override;
      procedure Load(FileName:String);
      procedure Save(FileName:String);
    published
      property TranslationColFont:TFont read fTranslationColFont
                                       write fTranslationColFont;
 
      {Overrided properties}
      property ColCount write SetColCount;
      property Options write SetOptions;
 
      {Inherited overrided events}
      property OnMouseUp:TMouseEvent read fOnMouseUp write fOnMouseUp;
      property OnDrawCell:TDrawCellEvent read fOnDrawCell write fOnDrawCell;
      property OnSetEditText:TSetEditEvent read fOnSetEditText write fOnSetEditText;
  end;
 
procedure Register;
 
implementation
  uses
    Dialogs, UnitExceptions, UnitTools;
  const
    {Ne pas définir 2 valeurs identiques pour ces constantes !}
    ID_COLINDEX = 0;
    CLASSNAME_COLINDEX = 1;
    ORIGINALVAL_COLINDEX = 2;
    TRANSLATEDVAL_COLINDEX = 3;
    COMMENT_COLINDEX = 4;
    TRANSLATED_STATE_COLINDEX = 5;
 
    COLS_ARRAY:array[0..5] of Integer=(ID_COLINDEX,
                                 CLASSNAME_COLINDEX,
                                 ORIGINALVAL_COLINDEX,
                                 TRANSLATEDVAL_COLINDEX,
                                 COMMENT_COLINDEX,
                                 TRANSLATED_STATE_COLINDEX);
 
procedure Inform(Msg:String); begin 
    ShowMessage(Msg);
end;
{ TTranslationStringGrid }
constructor TTranslationStringGrid.Create(AOwner:TComponent);
  var
    AMenuItem:TMenuItem;
  begin
    inherited;
 
    StandardFont:=Font;
    fTranslationColFont:=TFont.Create;
 
    {Ajout du menu popup}
    APopupMenu:=TPopupMenu.Create(Self);
    AMenuItem:=NewItem('Sort...', TShortCut(nil), false, true, nil, 0, '');
    AMenuItem.Add(NewItem('by identifier', TShortCut(nil), false, true, nil, 0, ''));
    AMenuItem.Add(NewItem('by type', TShortCut(nil), false, true, nil, 0, ''));
    AMenuItem.Add(NewItem('by original value', TShortCut(nil), false, true, nil, 0, ''));
    AMenuItem.Add(NewItem('by translated value', TShortCut(nil), false, true, nil, 0, ''));
    AMenuItem.Add(NewItem('by comment', TShortCut(nil), false, true, nil, 0, ''));
    AMenuItem.Add(NewItem('by translated state', TShortCut(nil), false, true, nil, 0, ''));
    APopupMenu.Items.Add(AMenuItem);
    PopupMenu:=APopupMenu;
 
    ColCount:=Succ(High(COLS_ARRAY)-Low(COLS_ARRAY));
    RowCount:=50;
    FixedCols:=0;
    FixedRows:=1;
 
    {Attribution des largeurs}
    ColWidths[ID_COLINDEX]:=200;
    ColWidths[CLASSNAME_COLINDEX]:=100;
    ColWidths[ORIGINALVAL_COLINDEX]:=200;
    ColWidths[TRANSLATEDVAL_COLINDEX]:=200;
    ColWidths[COMMENT_COLINDEX]:=200;
    ColWidths[TRANSLATED_STATE_COLINDEX]:=75;
 
    {Lignes fines}
    DefaultRowHeight:=16;
 
    {Activation des options utiles.
     Les colonnes et les lignes ne sont pas déplaçables ! (trop de problèmes
     pour l'implémentation !)}
    Options:=[goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
              goDrawFocusSelected, goColSizing, goEditing, goTabs,
              goThumbTracking];
 
    {Gestion evénementielle}
    inherited OnMouseUp:=DoMouseUp;{tri par colonne}
    inherited OnDrawCell:=DoPaint;{dessin du contenu}
    inherited OnSetEditText:=DoSetEditText;{modif. d'une valeur de cellule}
    //inherited OnGetEditText {lorsque le composant demande le contenu des cellules, sous forme de texte !}
end;
 
 
destructor TTranslationStringGrid.Destroy; begin
    APopupMenu.Free;
    TranslationColFont.Free;
    inherited;
end;
 
 
procedure TTranslationStringGrid.Save(FileName:String); begin
    Inform('Saved ! (not implemented...)');
end;
 
 
procedure TTranslationStringGrid.Load(FileName:String); begin
    Inform('Project file loaded ! (but not implemented yet...)');
end;
 
 
procedure TTranslationStringGrid.DoSortData(AColIndex: Integer); begin
    Inform('Sort by colindex '+IntToStr(AColIndex)+
                  ' ! (but not implemented yet...)');
end;
 
 
{Overrided properties implementation}
procedure TTranslationStringGrid.SetColCount(AColCount: Integer); begin
    {Impossible d'assigner une autre valeur que le nombre de colonnes
     disponible}
    if AColCount <> Succ(High(COLS_ARRAY)-Low(COLS_ARRAY)) then
      raise TIllegalArgumentException.Create(IntToStr(AColCount));
 
    inherited ColCount:=AColCount;
end;
 
 
procedure TTranslationStringGrid.SetOptions(ANewOptions:TGridOptions); begin
    {On supprime la possibilité d'activer les déplacements de lignes ou
     colonnes: le reste de l'implémentation n'a pas été conçu afin que les
     colonnes soient variables !}
    inherited Options:=ANewOptions-[goRowMoving, goColMoving];
end;
 
 
{Events implementation}
procedure TTranslationStringGrid.DoMouseUp(Sender:TObject; Button:TMouseButton;
                                               Shift:TShiftState; X,Y: Integer);
  var
    ARow, ACol:Integer;
  begin
    MouseToCell(X, Y, ACol, ARow);
 
    {Clique gauche sur la ligne des titres ?}
    if(ARow=0)and(Button=mbLeft)then
      DoSortData(ACol);
 
    if Assigned(fOnMouseUp) then
      fOnMouseUp(Sender, Button, Shift, X, Y);
end;
 
 
procedure TTranslationStringGrid.DoPaint(Sender:TObject; ACol,ARow:Longint;
                                        Rect:TRect; State:TGridDrawState); begin
    {Ligne de titres ?}
    if ARow=0 then{oui}
      case ACol of
        ID_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'Identifier');
        CLASSNAME_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'Type');
        ORIGINALVAL_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'Original value');
        TRANSLATEDVAL_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'Translated value');
        COMMENT_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'Comment');
        TRANSLATED_STATE_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'Translated ?');
      end
    else{non}
      case ACol of
        ID_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'A leaf identifier');
        CLASSNAME_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'A class identifier');
        ORIGINALVAL_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'Leaf original value');
        TRANSLATEDVAL_COLINDEX: begin
          //Canvas.Font:=TranslationColFont; {font spéciale}
          Canvas.TextOut(Rect.Left, Rect.Top, 'Leaf translated value');
          //Canvas.Font:=StandardFont; {font normale}
        end;
        COMMENT_COLINDEX:
          Canvas.TextOut(Rect.Left, Rect.Top, 'A leaf comment');
        TRANSLATED_STATE_COLINDEX: begin
          Canvas.Brush.Color:=clRed;
          Canvas.FillRect(Rect);
        end;
      end;
 
    if Assigned(fOnDrawCell) then
      fOnDrawCell(Sender, ACol, ARow, Rect, State);
end;
 
 
procedure TTranslationStringGrid.DoSetEditText(Sender:TObject; ACol,ARow: Integer;
                                                      const Value:String); begin
    {Les seules colonnes éditables sont celles de valeur traduite et de
     commentaire !}
    case ACol of
      COMMENT_COLINDEX:
        Inform('DoSetEditText a comment cell ! (not implemented...)');
      TRANSLATEDVAL_COLINDEX:
        Inform('DoSetEditText a translated cell ! (not implemented...)');
    end;
 
    if Assigned(fOnSetEditText) then
      fOnSetEditText(Sender, ACol, ARow, Value);
end;
 
procedure Register;
begin
  RegisterComponents('S.Piller', [TTranslationStringGrid]);
end;
 
end.

désolé, ça risque de pas compiler, étant donné que vous avez pas toutes les unités... virez les lignes qui lèvent des exceptions, elles ne sont pas utiles dans notre cas

Merci d'avance....

[bjl]

Je n'ai pas delphi sur ce PC. j'essaierais ce soir.

par contre quelques petits commentaires

Si tu n'utilises "StandardFont" que dans le DoPaint, utilises plutôt une variable locale.

de plus, je ne suis pas sur qu'avec les font, il ne faille pas plutôt utiliser "assign" que ":=" qui va affecter ton aussi ton pointeur sur le font.

de plus, je ne suis pas sur que les procedures DoPaint et DoMouseUp n'existent pas déjà dans des ancêtres de TStringGrid

[Pill_S]

Je n'ai pas delphi sur ce PC. j'essaierais ce soir.

pas de problème, je ne te presse pas

Si tu n'utilises "StandardFont" que dans le DoPaint, utilises plutôt une variable locale.

c'est pas faux.... je modifie

de plus, je ne suis pas sur qu'avec les font, il ne faille pas plutôt utiliser "assign" que ":=" qui va affecter ton aussi ton pointeur sur le font.

ah bon ??! alors faut qu'on m'explique là, parce que TFont est une classe comme les autres me semble-t-il... Quelle serait la raison et où est-ce que j'aurais pu le découvrir par moi-même ?

de plus, je ne suis pas sur que les procedures DoPaint et DoMouseUp n'existent pas déjà dans des ancêtres de TStringGrid

Je viens de faire une recherche dans l'aide, et il n'y a aucune trace de ces identificateurs dans la VCL. Et delphi ne me fait aucun warning du genre "la méthode x masque machin truc".

Merci de ton (votre) aide

[RamDevTeam]

bjl a écrit:

de plus, je ne suis pas sur qu'avec les font, il ne faille pas plutôt utiliser "assign" que ":=" qui va affecter ton aussi ton pointeur sur le font.

ah bon ??! alors faut qu'on m'explique là, parce que TFont est une classe comme les autres me semble-t-il... Quelle serait la raison et où est-ce que j'aurais pu découvrir par moi-même ?

J'utiliserais aussi assign
Si tu fais standartfont := font; les 2 variables pointent sur le même objet.

[Pill_S]

Si tu fais standartfont := font; les 2 variables pointent sur le même objet.

c'était pourtant le but !

je stocke 2 objets font, qui sont instanciés qu'une seule fois. StandardFont pointe sur la font de base du composant, hérité de TStringGrid

Ensuite, en fonction de la police qu'il me faut, je l'applique sur la propriété "font" que j'ai besoin de modifier...

Est-ce que cela pose un problème ?

[bjl]

est ce utile ?

j'ai chargé ton composant sur delphi6. en statique aucune erreur. par contre en dynamique en utilisant une boite TfontDialog, j'ai une erreur à la destruction.

je te propose de faire ainsi

Code :

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

1
2
3
4
5
6
7
8
9
10
11
   private
      fTranslationColFont: TFont;
      .
      .
      Procedure setTranslationColFont( Value : Tfont);
      .
      .
 
    published 
      property TranslationColFont:TFont read fTranslationColFont
                                       write SetTranslationColFont;

Code :

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

1
2
3
4
Procedure TTranslationStringGrid.setTranslationColFont( Value : Tfont);
Begin
  fTranslationColFont.Assign(Value); {assigne le contenu d'un font à ftranslationFont}
End;

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
procedure TTranslationStringGrid.DoPaint(Sender:TObject; ACol,ARow:Longint;
                                        Rect:TRect; State:TGridDrawState); begin
.
.
.
      case ACol of
        .
        .
        .
        TRANSLATEDVAL_COLINDEX: begin
          Canvas.Font.assign(FTranslationColFont); {font spéciale}
          Canvas.TextOut(Rect.Left, Rect.Top, 'Leaf translated value');
          Canvas.Font.Assign(Font); {font normale}
.
.

et de supprimer standartFont à moins sue tu ne l'utilises ailleurs.

si tu utilises directement write fTranslationColFont, tu assignes aussi l'adresse du font : si c'est en dynamique et que tu supprimes le font que tu viens d'assigner, tu supprimes aussi l'adresse de fTranslationColFont

[Pill_S]

j'ai mis en place ce que tu m'as proposé et... ça marche

franchement MERCI, je n'aurais pas pensé que l'ancien objet TFont soit détruit avec le code que j'utilisais......

étant fraichement arrivé depuis le monde du java, je n'ai pas l'habitude que mes objets puissent être détruits volontairement... en java, y'a le Garbage Collector qui s'occupe de recycler la mémoire, et quand on reçoit une référence, et qu'elle n'est pas null (nil), on est sûr d'avoir une instance à l'autre bout, et ce jusqu'à ce qu'on la perde (affectation à null)...

enfin bref, merci de m'avoir dépatouillé si t'as besoin de conseils en java, n'hésite pas !