Discussion :

[firejocker]

Slt,
la je seche,
j'utilise une collection d'element comportant un liste de mot (tstringlist) de Tfont particuliere.

mon probleme est qu'il faut que j'effectue une mise à jour du composant lorsque celles ci change (a tout moment)

j'ai donc besoin d'un evenement que chaque list va implemter,

voila un bout de mon code :

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
 
  type
 
        TFireColorSynth = class;
        TChangeItemEvent = procedure of object;
 
        TCustomStringList = class
        private
              FList : TStringList;
 
        public
              OnChange : TChangeItemEvent;
              constructor create;
              destructor destroy;
              function Add(S : String) : Integer;
              function Count : Integer;
              function Strings : TStrings;
              procedure CLear;
              procedure Del(S : String);
              procedure Assign(SL : TStringList);
              procedure Replace(OldS, NewS : String);
        end;
 
 
        TCustomFont = class
        private
          FFont, FTmpFont : TFont;
        public
          OnChange : TChangeItemEvent;
          constructor create;
          destructor destroy;
          procedure Assign(F : TFont);
          function GetFont : TFont;
          procedure Color(C : TColor);
        end;
 
 
 
        TColorSyntItem = class(TCollectionItem)
        private
          FName: string;
          FWordList : TCustomStringList;
          FFont : TCustomFont;
          function GetDisplayName: string; override;
          procedure SetName(const Value: string);
        public
          OnChangeFont : TChangeItemEvent;
          OnChangeWordList : TChangeItemEvent;
          constructor Create(Collection: TCollection); override;
          destructor Destroy; override;
          Procedure ClassementDecroissant;
        published
          property Name: string read FName write SetName;
          property ListColorMot : TCustomStringList read FWordList;
          property ColorFont : TCustomFont read FFont;
        end;
 
        TColorSyntCollection = class(TCollection)
        private
          FMyComponent: TFireColorSynth;
          function GetItem(Index: Integer): TColorSyntItem;
          procedure SetItem(Index: Integer; Value: TColorSyntItem);
        protected
          function GetOwner: TPersistent; override;
        public
          OnChangeFont : TChangeItemEvent;
          OnChangeWordList : TChangeItemEvent;
          constructor Create(MyComponent: TFireColorSynth);
          function Add: TColorSyntItem;
          property ColorSynt[Index: Integer]: TColorSyntItem read GetItem write SetItem; default;
        end;
 
 
        TFireColorSynth = class(TRichEdit)
        private
          FMotEntier : Boolean;
          OkToWork : Boolean;
          FColorSyntBlocked : Boolean;
          FormAowner : TForm;
          FormOldOnshow : TNotifyEvent;
          FColorSynt: TColorSyntCollection;
          FlistColorSynt : TStringList;
 
          procedure RefreshLiskKnownWord;
          function GetFontOfWord(Mot : string) : Tfont;
          procedure SetItems(Value: TColorSyntCollection);
          procedure FCSyntShow(sender: TObject);
          procedure Coloration_Syntaxique(TexteEntier : Boolean);
          procedure Coloriser(deb, longueur : Integer; couleur : Tfont);
          function CheckList(InString: string; var deb : Integer; var LongMot : integer): boolean;
          function SearchDebMot(Text : String; SelStart : Integer) : Integer;
          function SearchFinMot(Text : String; SelStart : Integer) : Integer;
          Procedure writeMotEntier(value : Boolean);
          procedure ProcOnChangeWordList;
          procedure ProcOnChangeFont;
 
        public
 
          constructor Create(AOwner:TComponent); override;
          destructor Destroy; override;
          procedure InitialiseList;
          procedure Loaded; override;
 
        published
          property MotEntier : Boolean read FMotEntier write writeMotEntier;
          property ColorSynt: TColorSyntCollection read FColorSynt write SetItems;
 
        protected
            procedure Change; override;
        End;
 
 
procedure Register;
 
implementation

cela marche tres bien en dynamique, je peux faire ca :

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
    F := TFireColorSynth.create(Form1);
    F.Parent := form1;
 
    F.Name := 'FC';
 
    f.Width := 400;
    f.Height := 400;
 
    F.MotEntier := false;
 
    F.Text := 'if1then 1 2 3';
 
    F.ColorSynt.Add;
 
    F.ColorSynt[0].ColorFont.Color(clBlue);
    F.ColorSynt[0].ListColorMot.Add('if');
    F.ColorSynt[0].ListColorMot.Add('then');
    F.ColorSynt[0].ListColorMot.Add('else');
 
    F.ColorSynt.Add;
    F.ColorSynt[1].ColorFont.Color(clRed);
    F.ColorSynt[1].ListColorMot.Add('0');
    F.ColorSynt[1].ListColorMot.Add('1');
    F.ColorSynt[1].ListColorMot.Add('2');

et tout va bien, le probleme c'est que quand j'installe ce composant et que je veux l'instancier dans sur une fiche,
les propriete colorfont et ListColorMot sont bien visible mais on ne peux les editer.

j'ai bien tenter cette modif :

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
       TCustomStringList = class(TPersistent)
        private
              FList : TStringList;
              procedure SetStringList(S : TStringList);
 
        public
              OnChange : TChangeItemEvent;
              constructor create;
              destructor destroy;
        published
              property WordList : TStringList read FList write SetStringList;
        end;
 
 
        TCustomFont = class(TPersistent)
        private
          FFont : TFont;
          procedure SetFont(F : Tfont);
        public
          OnChange : TChangeItemEvent;
          constructor create;
          destructor destroy;
        published
          property Font : Tfont read FFont write SetFont;
        end;

mais la je perd commme l'a dit yarocco la possibilité d'acceder au SetFont

que faire alors ??? jsuis largué la

[phplive]

Bjr

Dans le première version il est normale que tu ne puisses pas modifier les propriétés ListColorMot et ColorFont dans la mesure où tu ne définies aucun spécificateur d'accès en écriture write .

Dans la seconde (qui est meilleure) tu dois normalement pouvoir éditer WordList et Font.

Pourquoi définies-tu ColorFont alors que nativement Font.Color existe ?

mais la je perd commme l'a dit yarocco la possibilité d'acceder au SetFont

Comment ca tu perds l'accès à SetFont ? Qu'entends-tu par là ?

@+
Php

[firejocker]

ben, un TCollection semble faire ca de façon inée,
figure toi que la premiere version fonctionne et ca sans mettre le write mais de la, je ne peux implementer d'evenement lors de modif

[Pedro]

Salut
Tu peux aussi essayer d'intercepter l'évenement CM_FONTCHANGED... Il me semble que j'avais eu un problème de cet ordre-là et que je l'ai résolu comme ça...
Bon dev'

[firejocker]

le probleme, c'est que la collection comporte X element qui possede 1 font, ce sera possible de les dissocier alors ?
et puis, j'ai une TStringList aussi avec laquel je dois faire la meme chose

[phplive]

Désolé mais je comprends rien !

Que fait un TCollection de façon innée selon toi ?

Le probleme, c'est que la collection comporte X element qui possede 1 font, ce sera possible de les dissocier alors ?

????

Chaque item tel que tu l'implémente comporte une font qui lui est propre.
C'est pas ce que tu veux ?

Tu veux faire quoi lorsque la police mettons de l'item nr 10 change ?
Informer ta collection du changement qui elle même informera à son tour le composant RichEdit ???

[firejocker]

oui, c exactement ca

[firejocker]

oups, jai oublié le début de ton post

ben au debut j'avais mis

property ListColorMot : TStringList read FWordList Write SetListWord;

et javais voulu debugger dans SetListWord seulement le code présent dedans n'est jamais executé, alors que la liste est quand meme affecte, du coup, j'enleve la methode write et c'est pareil, la liste est quan meme affecté,

c trop louche !

[phplive]

Bizarre quoique l'éditeur de propriété ne fait qu'écrire le contenu de l'objet pas le contenu du pointeur vers l'objet ...

Mais passons,

Parce ce que ca tombe bien et que je bosse en ce moment même sur ces p.. de TCollection et parce que c'est mon jour de bonté voici un code qui répond en partie à tes souhaits

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
unit UnitTest;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Dialogs, ComCtrls;
 
 
type
 
 
  TCustomFont = class(TPersistent)
  private
    FFont : TFont;
    FOnChange : TNotifyEvent;
    procedure FontChanged(Sender: TObject);
    procedure SetFont(Value : TFont);
  public
    constructor Create;
    destructor destroy; override;
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
  published
    property Font : TFont read FFont write SetFont;
  end;
 
 
  TColorSyntItem = class;
 
  TChangeItemEvent = procedure(Sender : TObject; ColorSyntItem : TColorSyntItem) of object;
 
  TColorSyntItem = class(TCollectionItem)
  private
    FName: string;
    FCustomFont : TCustomFont;
    FOnChangeFont : TChangeItemEvent;
    procedure FontChanged(Sender: TObject);
    function GetDisplayName: string; override;
    function GetName : string;
    procedure SetName(const Value: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property OnChangeFont : TChangeItemEvent read FOnChangeFont
      write FOnChangeFont;
  published
    property Name: string read GetName write SetName;
    property CustomFont : TCustomFont read FCustomFont write FCustomFont;
  end;
 
 
  TColorSyntCollection = class(TCollection)
  private
    FOwner : TComponent;
    FOnChangeFont : TChangeItemEvent;
    procedure CustomFontChanged(Sender: TObject;
      ColorSyntItem : TColorSyntItem);
  protected
    function GetOwner : TPersistent; override;
    function GetItem(Index: Integer): TColorSyntItem;
    procedure SetItem(Index: Integer; Item : TColorSyntItem);
    procedure Update(Item: TColorSyntItem);
  public
    constructor Create(AOwner : TComponent);
    function Add : TColorSyntItem;
    function Insert(Index: Integer): TColorSyntItem;
    property Items[Index: Integer]: TColorSyntItem  read GetItem
      write SetItem;  default;
    property OnChangeFont : TChangeItemEvent read FOnChangeFont
      write FOnChangeFont;
  end;
 
 
 
  TTestComponent = Class(TRichEdit)
  private
    FColorSyntCollection : TColorSyntCollection;
    FOnChangeFont : TChangeItemEvent;
    procedure CustomFontChanged(Sender: TObject;
      ColorSyntItem : TColorSyntItem);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
 
  published
    property ColorSyntCollection : TColorSyntCollection
      read FColorSyntCollection write FColorSyntCollection;
    property OnChangeFont : TChangeItemEvent read FOnChangeFont
      write FOnChangeFont;
  end;
 
  procedure Register;
 
 
implementation
 
procedure Register;
begin
  RegisterComponents('Test',[TTestComponent]);
end;  
 
 
{ TTestComponent }
constructor TTestComponent.Create(AOwner : TComponent);
begin
  inherited;
  FColorSyntCollection := TColorSyntCollection.Create(Self);
  FColorSyntCollection.OnChangeFont := CustomFontChanged;
end;
 
destructor TTestComponent.Destroy;
begin
  FreeAndNil(FColorSyntCollection);
  inherited;
end;
 
procedure TTestComponent.CustomFontChanged(Sender: TObject;
  ColorSyntItem : TColorSyntItem);
begin
  if Assigned(FOnChangeFont) then OnChangeFont(Self,ColorSyntItem);
end;
 
{ TCustomFont }
constructor TCustomFont.Create;
begin
  inherited Create;
  FFont := TFont.Create;
  FFont.OnChange := FontChanged;
end;
 
destructor TCustomFont.Destroy;
begin
  FreeAndNil(FFont);
  inherited;
end;
 
procedure TCustomFont.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;
 
procedure TCustomFont.FontChanged(Sender: TObject);
begin
  if Assigned(FOnChange) then OnChange(Self);
end;
 
 
{ TColorSyntItem }
 
function TColorSyntItem.GetDisplayName: string;
begin
  if FName <> '' then
  begin
    Result := FName;
  end
  else
    Result := SysUtils.Format('Item %d',[Index]);
end;
 
function TColorSyntItem.GetName : string;
begin
  Result := GetDisplayName;
end;
 
procedure TColorSyntItem.SetName(const Value: string);
begin
  if Value <> FName then
    FName := Value;
end;
 
constructor TColorSyntItem.Create(Collection: TCollection);
begin
  inherited;
  FCustomFont := TCustomFont.Create;
  FCustomFont.OnChange := FontChanged;
 
end;
 
destructor TColorSyntItem.Destroy;
begin
  FreeAndNil(FCustomFont);
  inherited;
end;
 
procedure TColorSyntItem.FontChanged(Sender: TObject);
begin
  if Assigned(Collection) then
  begin
    if Collection is TColorSyntCollection then
      TColorSyntCollection(Collection).CustomFontChanged(Self,Self);
  end;
  if Assigned(FOnChangeFont) then OnChangeFont(Self,Self);
end;
 
 
{ TColorSyntCollection }
 
function TColorSyntCollection.Add: TColorSyntItem;
begin
  Result := TColorSyntItem(inherited Add);
end;
 
constructor TColorSyntCollection.Create(AOwner: TComponent);
begin
  inherited Create(TColorSyntItem);
  FOwner := AOwner;
end;
 
function TColorSyntCollection.GetItem(Index: Integer): TColorSyntItem;
begin
  Result := TColorSyntItem(inherited GetItem(Index));
end;
 
function TColorSyntCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
function TColorSyntCollection.Insert(Index: Integer): TColorSyntItem;
begin
  Result := TColorSyntItem(inherited Insert(Index));
end;
 
procedure TColorSyntCollection.SetItem(Index: Integer; Item : TColorSyntItem);
begin
  inherited SetItem(Index, Item);
end;
 
procedure TColorSyntCollection.Update(Item: TColorSyntItem);
begin
  inherited Update(Item);
end;
 
procedure TColorSyntCollection.CustomFontChanged(Sender: TObject;
  ColorSyntItem : TColorSyntItem);
begin
  if Assigned(FOnChangeFont) then OnChangeFont(Self,ColorSyntItem);
end;
 
 
end.

Ordre des événements : modification de Font dans TCustomFont

FFont.OnChange -> TCustomFont.FontChanged -> TCustomFont.OnChange -> TColorSyntItem.FontChanged ->
TColorSyntCollection.CustomFontChanged ->
TColorSyntCollection.OnChangeFont ->
TTestComponent.CustomFontChanged ->
TTestComponent.OnChangeFont Ouf !

Note que l'item pourrait appeller directement
TTestComponent.CustomFontChanged depuis
TColorSyntItem.FontChanged ainsi :
TTestComponent(TColorSyntCollection(Collection)).CustomFontChanged


Voilà à toi d'adapter

@+
Php




Le TCustomFont notifie

[firejocker]

Trop fort, ca marche !

merci bien ! je craquais !