Création de composant

**yannp** · 26/12/2014, 17h22

Bonjour,

Je cherche à développer un nouveau composant.
Voici le 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
 
TListColumnsLvGeneric = class (TListColumns)
  private
    sqlField  : string;
    nullAutor : boolean;
    function  getSqlField:string;
    procedure setSqlField(arg:string);
    function  getNullAutor:boolean;
    procedure setNullAutor(arg:boolean);
  published
    property sqlFieldName  : string  read getSqlField  write setSqlField;
    property nullAutorized : boolean read getNullAutor write setNullAutor;
  public
    constructor Create(AOwner:TCustomListView);
  end;
 
  TLvGeneric = class (TListView)
  private
    function  getColumns:TListColumnsLvGeneric;
    procedure setListColumns (arg:TListColumnsLvGeneric);
  published
    property LvColumns : TListColumnsLvGeneric read getColumns write setListColumns;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
  TListViewGeneric = class(TWinControl)
  private
    { Déclarations privées }
    lv        : TLvGeneric;
    btnAdd    : TBitBtn;
    btnEdit   : TBitBtn;
    btnDelete : TBitBtn;
 
    function  getListColumns:TListColumns;
    procedure setListColumns(arg:TListColumns);
    function  getFont:TFont;
    procedure setFont(arg:TFont);
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
  published
    { Déclarations publiées }
    property Font       : TFont         read getFont        write setFont;
    property LvColumns  : TListColumns  read getListColumns write setListColumns;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TListViewGeneric]);
end;
 
constructor TListColumnsLvGeneric.Create(AOwner:TCustomListView);
begin
  inherited Create(AOwner);
end;
 
function TListColumnsLvGeneric.getSqlField:string;
begin
  result:= sqlField;
end;
 
procedure TListColumnsLvGeneric.setSqlField(arg:string);
begin
  sqlField:=arg;
end;
 
function TListColumnsLvGeneric.getNullAutor:boolean;
begin
  result:= nullAutor;
end;
 
procedure TListColumnsLvGeneric.setNullAutor(arg:boolean);
begin
  nullAutor:=arg;
end;
 
constructor TLvGeneric.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
 
function TLvGeneric.getColumns:TListColumnsLvGeneric;
begin
  result:= LvColumns;
end;
 
procedure TLvGeneric.setListColumns (arg:TListColumnsLvGeneric);
begin
  LvColumns:= arg;
end;
 
constructor TListViewGeneric.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

Je me trouve devant le problème suivant : Les "nouvelles propriétés" sqlField et nullAutor n'apparaissent pas dans l'inspecteur d'objet...

Si quelqu'un peut m'aider ... Merci d'avance.

**yannp** · 27/12/2014, 11h18

Apres quelques recherches voici mon nouveau code, cette fois ci tout PLANTE HAHAHAHHAHA ....

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
 
  TlistColumnLvGeneric = class (TlistColumn)
  private
    sqlField  : string;
    nullAutor : boolean;
    function  getSqlField:string;
    procedure setSqlField(arg:string);
    function  getNullAutor:boolean;
    procedure setNullAutor(arg:boolean);
  published
    property sqlFieldName  : string  read getSqlField  write setSqlField;
    property nullAutorized : boolean read getNullAutor write setNullAutor;
  public
    constructor Create(AOwner:TlistColumn);
  end;
 
  TListColumnsLvGeneric = class (TListColumns)
  private
    function  getColumn:TListColumnLvGeneric;
    procedure setListColumn (arg:TListColumnLvGeneric);
  published
    property LvColumn : TListColumnLvGeneric read getColumn write setListColumn;
  public
    constructor Create(AOwner: TCustomListView);
  end;
 
  TLvGeneric = class (TListView)
  private
    function  getColumns:TListColumnsLvGeneric;
    procedure setListColumns (arg:TListColumnsLvGeneric);
  published
    property LvColumns : TListColumnsLvGeneric read getColumns write setListColumns;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
  TListViewGeneric = class(TWinControl)
  private
    { Déclarations privées }
    lv        : TLvGeneric;
    btnAdd    : TBitBtn;
    btnEdit   : TBitBtn;
    btnDelete : TBitBtn;
 
    function  getListColumns:TListColumnsLvGeneric;
    procedure setListColumns(arg:TListColumnsLvGeneric);
    function  getFont:TFont;
    procedure setFont(arg:TFont);
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
  published
    { Déclarations publiées }
    property Font       : TFont                   read getFont        write setFont;
    property LvColumns  : TListColumnsLvGeneric   read getListColumns write setListColumns;
  end;

**yannp** · 30/12/2014, 18h03

J'avance... enfin je pense.

Maintenant ca plante, j'ai le message d'erreur 'Internal Error in TLvCustomListView.Create()'. à la création de TLvCustomListView

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
 
unit ListViewGeneric;
 
interface
 
uses
  SysUtils, Classes, Controls, comCtrls, buttons, Graphics;
 
type
  TLvGeneric=class;
 
  TLvListColumns = class(TListColumns)
  private
    function  GetItem(Index: Integer): TListColumn;
    procedure SetItem(Index: Integer; Value: TListColumn);
  public
    constructor Create(AOwner: TCustomListView);
    function Add: TListColumn;
    function Owner: TLvGeneric;
    property Items[Index: Integer]: TListColumn read GetItem write SetItem; default;
  end;
 
  TLvCustomListView = class(TCustomListView)
  private
    function GetListColumns: TLvListColumns;
    procedure SetListColumns(const Value: TLvListColumns);
  protected
    property Columns: TLvListColumns read GetListColumns write SetListColumns;
  public
    constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
    //property Column[Index: Integer]: TTntListColumn read ColumnFromIndex;
    //procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
  end;
 
  TLvGeneric = class (TLvCustomListView)
  private
    function  getListColumns: TLvListColumns;
    procedure setListColumns(const Value: TLvListColumns);
  protected
    property Columns : TLvListColumns read getListColumns write setListColumns;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
  TListViewGeneric = class(TWinControl)
  private
    lv          : TLvGeneric;
    btnAdd      : TBitBtn;
    btnEdit     : TBitBtn;
    btnDelete   : TBitBtn;
 
    function  getListColumns:TLvListColumns;
    procedure setListColumns(arg:TLvListColumns);
    function  getFont:TFont;
    procedure setFont(arg:TFont);
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
  published
    { Déclarations publiées }
    property Font       : TFont           read getFont        write setFont;
    property Columns    : TLvListColumns  read getListColumns write setListColumns;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TListViewGeneric]);
end;       
 
constructor TListViewGeneric.Create(AOwner: TComponent);
begin
  width := 300;
  height:= 200;
  inherited Create(AOwner);
  lv:=TLvGeneric.Create(self);
  lv.Parent:=self;
  lv.ViewStyle:=vsReport;
  lv.left   := 0;
  lv.Top    := 0;
  lv.Width  := Width-30;
  lv.Height := Height;
  lv.Anchors:=[akLeft,akTop,akRight,akBottom];
 
  btnAdd:=TBitBtn.Create(self);
  btnAdd.Parent:=self;
  btnAdd.width:=25;
  btnAdd.height:=25;
  btnAdd.top:=0;
  btnAdd.left:=width-27;
  btnAdd.Anchors:=[akTop,akRight];
 
  btnEdit:=TBitBtn.Create(self);
  btnEdit.Parent:=self;
  btnEdit.width:=25;
  btnEdit.height:=25;
  btnEdit.top:=25;
  btnEdit.left:=width-27;
  btnEdit.Anchors:=[akTop,akRight];
 
  btnDelete:=TBitBtn.Create(self);
  btnDelete.Parent:=self;
  btnDelete.width:=25;
  btnDelete.height:=25;
  btnDelete.top:=50;
  btnDelete.left:=width-27;
  btnDelete.Anchors:=[akTop,akRight];
end;
 
procedure TListViewGeneric.setListColumns(arg:TLvListColumns);
begin
  Columns:= arg;
end;
 
function TListViewGeneric.getListColumns:TLvListColumns;
begin
  result:=Columns;
end;
 
function TListViewGeneric.getFont:TFont;
begin
  result:=lv.Font;
end;
 
procedure TListViewGeneric.setFont(arg:TFont);
begin
  lv.Font:=arg;
end;
 
constructor TLvGeneric.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
 
function TLvGeneric.getListColumns: TLvListColumns;
begin
  Result:= inherited Columns as TLvListColumns;
end;
 
procedure TLvGeneric.SetListColumns(const Value: TLvListColumns);
begin
  Columns:= Value;
end;
 
constructor TLvListColumns.Create(AOwner: TCustomListView);
begin
  inherited Create(AOwner);
end;
 
function TLvListColumns.Owner: TLvGeneric;
begin
  Result := inherited Owner as TLvGeneric;
end;
 
function TLvListColumns.Add: TListColumn;
begin
  Result := (inherited Add) as TListColumn;
end;
 
function TLvListColumns.GetItem(Index: Integer): TListColumn;
begin
  Result := inherited Items[Index] as TListColumn;
end;
 
procedure TLvListColumns.SetItem(Index: Integer; Value: TListColumn);
begin
  inherited SetItem(Index, Value);
end;
 
 
type
  THackCustomListView = class(TCustomMultiSelectListControl)
  protected
    FListColumns: TListColumns;
end;
 
constructor TLvCustomListView.Create(AOwner: TComponent);
begin
  inherited;
  Assert(THackCustomListView(Self).FListColumns = inherited Columns, 'Internal Error in TLvCustomListView.Create().');
  FreeAndNil(THackCustomListView(Self).FListColumns);
  THackCustomListView(Self).FListColumns := TLvListColumns.Create(Self);
end;
 
function TLvCustomListView.GetListColumns: TLvListColumns;
begin
  Result := inherited Columns as TLvListColumns;
end;
 
procedure TLvCustomListView.SetListColumns(const Value: TLvListColumns);
begin
  Columns := Value;
end;
 
end.

**Paul TOTH** · 30/12/2014, 20h22

je ne comprend pas bien pourquoi TLvCustomListView et TLvGeneric déclarent les mêmes choses...

ensuite ton setter n'est pas bon, quand tu publies un objets comme ça, le setListColumns() doit recopier le paramètre, généralement par un appel à la méthode Assign()

exemple:

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 TCustomListView.SetItems(Value: TListItems);
begin
  FListItems.Assign(Value);
end;
 
procedure TCustomListView.SetListColumns(Value: TListColumns);
begin
  FListColumns.Assign(Value);
end;
 
procedure TCustomListView.SetListGroups(Value: TListGroups);
begin
  FListGroups.Assign(Value);
end;

ensuite quand tu crées un composant parent d'autres, il faut ruser sinon le flux DFM va les enregistrer et les recréer alors que leur cycle de vie est indépendant du DFM....la solution de TDBNavigator est radicale pour protéger ses boutosn

Code :

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

1
2
3
4
 
procedure TDBNavigator.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;

**yannp** · 05/01/2015, 09h51

Merci pour ta réponse.
Tu constateras que je débute dans le domaine de création de composant, donc merci pour ton indulgence

En fait mon projet de composant est simple : un Tlistview et 3 boutons (qui agiront sur le TlistView). Mon premier problème est le suivant : je veux rajouter des propriétés pour chaque colonne du TListView, il me faut donc surcharger TListColumn avec mes nouvelles propriétés.

En m'inspirant des tes remarques, voici mon nouveau code. En le testant j'obtiens un débordement de pile ...

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
 
 
unit ListViewGeneric;
 
interface
 
uses
  SysUtils, Classes, Controls, comCtrls, buttons, Graphics;
 
type
 
  TLvListColumns = class(TListColumns)
  private
    function  GetItem(Index: Integer): TListColumn;
    procedure SetItem(Index: Integer; Value: TListColumn);
  public
    constructor Create(AOwner: TCustomListView);
    function Add: TListColumn;
    property Items[Index: Integer]: TListColumn read GetItem write SetItem; default;
  end;
 
  TLvCustomListView = class(TCustomListView)
  private
    FColumns : TLvListColumns;
    function  GetListColumns: TLvListColumns;
    procedure SetListColumns(Value: TLvListColumns);
  protected
    property Columns: TLvListColumns read GetListColumns write SetListColumns;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
  TListViewGeneric = class(TWinControl)
  private
    lv          : TLvCustomListView;
    btnAdd      : TBitBtn;
    btnEdit     : TBitBtn;
    btnDelete   : TBitBtn;
 
    function  getListColumns:TLvListColumns;
    procedure setListColumns(arg:TLvListColumns);
    function  getFont:TFont;
    procedure setFont(arg:TFont);
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
  published
    { Déclarations publiées }
    property Font       : TFont           read getFont        write setFont;
    property Columns    : TLvListColumns  read getListColumns write setListColumns;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TListViewGeneric]);
end;       
 
constructor TListViewGeneric.Create(AOwner: TComponent);
begin
  width := 300;
  height:= 200;
  inherited Create(AOwner);
  lv:=TLvCustomListView.Create(self);
  lv.Parent:=self;
  lv.ViewStyle:=vsReport;
  lv.left   := 0;
  lv.Top    := 0;
  lv.Width  := Width-30;
  lv.Height := Height;
  lv.Anchors:=[akLeft,akTop,akRight,akBottom];
 
  {
  btnAdd:=TBitBtn.Create(self);
  btnAdd.Parent:=self;
  btnAdd.width:=25;
  btnAdd.height:=25;
  btnAdd.top:=0;
  btnAdd.left:=width-27;
  btnAdd.Anchors:=[akTop,akRight];
 
  btnEdit:=TBitBtn.Create(self);
  btnEdit.Parent:=self;
  btnEdit.width:=25;
  btnEdit.height:=25;
  btnEdit.top:=25;
  btnEdit.left:=width-27;
  btnEdit.Anchors:=[akTop,akRight];
 
  btnDelete:=TBitBtn.Create(self);
  btnDelete.Parent:=self;
  btnDelete.width:=25;
  btnDelete.height:=25;
  btnDelete.top:=50;
  btnDelete.left:=width-27;
  btnDelete.Anchors:=[akTop,akRight];
  }
end;
 
procedure TListViewGeneric.setListColumns(arg:TLvListColumns);
begin
  Columns.Assign(arg);
end;
 
function TListViewGeneric.getListColumns:TLvListColumns;
begin
  result:=Columns;
end;
 
function TListViewGeneric.getFont:TFont;
begin
  result:=lv.Font;
end;
 
procedure TListViewGeneric.setFont(arg:TFont);
begin
  lv.Font:=arg;
end;
 
function TLvCustomListView.GetListColumns: TLvListColumns;
begin
  result:= FColumns;
end;
 
procedure TLvCustomListView.SetListColumns(Value: TLvListColumns);
begin
  FColumns.Assign(Value);
end;
 
constructor TLvCustomListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
 
constructor TLvListColumns.Create(AOwner: TCustomListView);
begin
  inherited Create(AOwner);
end;
 
function TLvListColumns.Add: TListColumn;
begin
  Result := (inherited Add) as TListColumn;
end;
 
function TLvListColumns.GetItem(Index: Integer): TListColumn;
begin
  Result := inherited Items[Index] as TListColumn;
end;
 
procedure TLvListColumns.SetItem(Index: Integer; Value: TListColumn);
begin
  inherited SetItem(Index, Value);
end;
 
end.

Merci pour ton aide.

Yann

**yannp** · 05/01/2015, 16h42

Après quelques modifs : ca plante plus, mais je n'arrive pas à ouvrir la fenêtre contenant le le TListColumn ......

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
 
 
 
unit ListViewGeneric;
 
interface
 
uses
  SysUtils, Classes, Controls, comCtrls, buttons, Graphics;
 
type
 
  TLvListColumns = class(TListColumns)
  private
    function  GetItem(Index: Integer): TListColumn;
    procedure SetItem(Index: Integer; Value: TListColumn);
  public
    constructor Create(AOwner: TCustomListView);
    function Add: TListColumn;
    property Items[Index: Integer]: TListColumn read GetItem write SetItem; default;
  end;
 
  TLvCustomListView = class(TCustomListView)
  private
    FColumns : TLvListColumns;
    function  GetListColumns: TLvListColumns;
    procedure SetListColumns(Value: TLvListColumns);
  protected
    property Columns: TLvListColumns read GetListColumns write SetListColumns;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
  TListViewGeneric = class(TWinControl)
  private
    lv          : TLvCustomListView;
    btnAdd      : TBitBtn;
    btnEdit     : TBitBtn;
    btnDelete   : TBitBtn;
 
    function  getListColumns:TLvListColumns;
    procedure setListColumns(arg:TLvListColumns);
    function  getFont:TFont;
    procedure setFont(arg:TFont);
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
  published
    { Déclarations publiées }
    property Font       : TFont           read getFont        write setFont;
    property Columns    : TLvListColumns  read getListColumns write setListColumns;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TListViewGeneric]);
end;       
 
constructor TListViewGeneric.Create(AOwner: TComponent);
begin
  width := 300;
  height:= 200;
  inherited Create(AOwner);
  lv:=TLvCustomListView.Create(self);
  lv.Parent:=self;
  lv.ViewStyle:=vsReport;
  lv.left   := 0;
  lv.Top    := 0;
  lv.Width  := Width-30;
  lv.Height := Height;
  lv.Anchors:=[akLeft,akTop,akRight,akBottom];
 
  {
  btnAdd:=TBitBtn.Create(self);
  btnAdd.Parent:=self;
  btnAdd.width:=25;
  btnAdd.height:=25;
  btnAdd.top:=0;
  btnAdd.left:=width-27;
  btnAdd.Anchors:=[akTop,akRight];
 
  btnEdit:=TBitBtn.Create(self);
  btnEdit.Parent:=self;
  btnEdit.width:=25;
  btnEdit.height:=25;
  btnEdit.top:=25;
  btnEdit.left:=width-27;
  btnEdit.Anchors:=[akTop,akRight];
 
  btnDelete:=TBitBtn.Create(self);
  btnDelete.Parent:=self;
  btnDelete.width:=25;
  btnDelete.height:=25;
  btnDelete.top:=50;
  btnDelete.left:=width-27;
  btnDelete.Anchors:=[akTop,akRight];
  }
end;
 
procedure TListViewGeneric.setListColumns(arg:TLvListColumns);
begin
  lv.Columns.Assign(arg);
end;
 
function TListViewGeneric.getListColumns:TLvListColumns;
begin
  result:=Lv.Columns;
end;
 
function TListViewGeneric.getFont:TFont;
begin
  result:=lv.Font;
end;
 
procedure TListViewGeneric.setFont(arg:TFont);
begin
  lv.Font:=arg;
end;
 
function TLvCustomListView.GetListColumns: TLvListColumns;
begin
  result:= FColumns;
end;
 
procedure TLvCustomListView.SetListColumns(Value: TLvListColumns);
begin
  FColumns.Assign(Value);
end;
 
constructor TLvCustomListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
 
constructor TLvListColumns.Create(AOwner: TCustomListView);
begin
  inherited Create(AOwner);
end;
 
function TLvListColumns.Add: TListColumn;
begin
  Result := (inherited Add) as TListColumn;
end;
 
function TLvListColumns.GetItem(Index: Integer): TListColumn;
begin
  Result := inherited Items[Index] as TListColumn;
end;
 
procedure TLvListColumns.SetItem(Index: Integer; Value: TListColumn);
begin
  inherited SetItem(Index, Value);
end;
 
end.

**Paul TOTH** · 06/01/2015, 13h10

pas le temps de regarder ton code, mais la fenêtre dont tu parles est probablement un PropertyEditor; il est déclaré dans une procédure RegistrerPropertyEditor (de tête) pour être associé à un composant et une propriété... comme ta propriété utilise un type différent, je ne suis pas surpris que l'association ne se fasse pas... de plus il est possible qu'il ne soit pas compatible avec ta classe dérivée... à vérifier dans les sources de la VCL.

**yannp** · 06/01/2015, 15h36

Merci pour tes explications, mais là j'avoue perdre pied.
J'essaie d'utiliser RegisterPropertyEditor en incluant design dans les uses et j'ai l'erreur suivante : designintf.dcu non trouvé.

Sinon je commence à me demander si ce projet est réalisable :
Je veux créer un composant contenant un TListView avec des propriétés en plus pour chaque colonne et 3 boutons qui agiront sur ce TListView....
Est-ce Faisable ?

Merci pour ton aide.

Yann

**yannp** · 06/01/2015, 16h25

J'ai réglé mon problème de dcu non trouvé... Par contre tu as raison c'est incompatible ... Je dois créer mon propre Property editor ?

Yann

**yannp** · 09/01/2015, 11h19

J'avance... Donc maintenant mon problème est le suivant :

Lorsque je crée un nouvel item (nouvelle colonne), je veux la créer "à la main" dans le listview. Mais là, "echec".

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
 
unit ListViewGeneric;
 
interface
 
uses
  Classes, SysUtils, Controls, comCtrls, dialogs;
 
type
  TColumnItem = class(TCollectionItem)
  private
    FStringProp: String;
  protected
    function GetDisplayName: String; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property StringProp: String read FStringProp write FStringProp;
  end;
 
  TLvListColumns = class(TCollection)
  private
    FOwner: TPersistent;
    function GetItem(Index: Integer): TColumnItem;
    procedure SetItem(Index: Integer; Value: TColumnItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    function Add: TColumnItem;
    function Insert(Index: Integer): TColumnItem;
    property Items[Index: Integer]: TColumnItem read GetItem write SetItem;
  end;
 
  TMyPersistent = class(TPersistent)
  private
    FOwner: TPersistent;
    FCollectionProp: TLvListColumns;
    procedure SetCollectionProp(Value: TLvListColumns);
  protected
    function GetOwner: TPersistent; override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
  published
    property Columns: TLvListColumns read FCollectionProp write SetCollectionProp;
  end;
 
  TLvGeneric = class(TWinControl)
  private
    lv : TListView;
    FPersistentProp: TMyPersistent;
    procedure SetPersistentProp(Value: TMyPersistent);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property PersistentProp: TMyPersistent read FPersistentProp write SetPersistentProp;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TLvGeneric]);
end;
 
{ TColumnItem }
 
procedure TColumnItem.Assign(Source: TPersistent);
begin
  if Source is TColumnItem then
    FStringProp := TColumnItem(Source).FStringProp
  else
    inherited Assign(Source);
end;
 
function TColumnItem.GetDisplayName: String;
begin
  Result := Format('Item %d',[Index]);
end;
 
{ TMyCollection }
 
function TLvListColumns.Add: TColumnItem;
begin
  Result := TColumnItem(inherited Add);
end;
 
constructor TLvListColumns.Create(AOwner: TPersistent);
begin
  inherited Create(TColumnItem);
  FOwner := AOwner;
end;
 
function TLvListColumns.GetItem(Index: Integer): TColumnItem;
begin
  Result := TColumnItem(inherited GetItem(Index));
end;
 
function TLvListColumns.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
function TLvListColumns.Insert(Index: Integer): TColumnItem;
begin
  Result := TColumnItem(inherited Insert(Index));
end;
 
procedure TLvListColumns.SetItem(Index: Integer; Value: TColumnItem);
begin
  inherited SetItem(Index, Value);
end;
 
{ TMyPersistent }
 
procedure TMyPersistent.Assign(Source: TPersistent);
begin
  if Source is TMyPersistent then
    columns := TMyPersistent(Source).FCollectionProp
  else
    inherited Assign(Source);
end;
 
constructor TMyPersistent.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FCollectionProp := TLvListColumns.Create(Self);
end;
 
destructor TMyPersistent.Destroy;
begin
  FCollectionProp.Free;
  inherited Destroy;
end;
 
function TMyPersistent.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
procedure TMyPersistent.SetCollectionProp(Value: TLvListColumns);
begin
  FCollectionProp.Assign(Value);
end;
 
{ TLvGeneric }
 
constructor TLvGeneric.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPersistentProp := TMyPersistent.Create(Self);
  width := 300;
  height:= 200;
  lv:=TListView.Create(self);
  lv.Parent:=self;
  lv.ViewStyle:=vsReport;
  lv.left   := 0;
  lv.Top    := 0;
  lv.Width  := Width-30;
  lv.Height := Height;
  lv.Anchors:=[akLeft,akTop,akRight,akBottom];
end;
 
destructor TLvGeneric.Destroy;
begin
  FPersistentProp.Free;
  inherited Destroy;
end;
 
procedure TLvGeneric.SetPersistentProp(Value: TMyPersistent);
begin
  FPersistentProp.Assign(Value);
end;
 
end.

**yannp** · 09/01/2015, 11h23

J'avance... Donc maintenant mon problème est le suivant :

Lorsque je crée un nouvel item (nouvelle colonne), je veux la créer "à la main" dans le listview. Mais là, "echec".

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
 
unit ListViewGeneric;
 
interface
 
uses
  Classes, SysUtils, Controls, comCtrls, dialogs;
 
type
  TColumnItem = class(TCollectionItem)
  private
    FStringProp: String;
  protected
    function GetDisplayName: String; override;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property StringProp: String read FStringProp write FStringProp;
  end;
 
  TLvListColumns = class(TCollection)
  private
    FOwner: TPersistent;
    function GetItem(Index: Integer): TColumnItem;
    procedure SetItem(Index: Integer; Value: TColumnItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    function Add: TColumnItem;
    function Insert(Index: Integer): TColumnItem;
    property Items[Index: Integer]: TColumnItem read GetItem write SetItem;
  end;
 
  TMyPersistent = class(TPersistent)
  private
    FOwner: TPersistent;
    FCollectionProp: TLvListColumns;
    procedure SetCollectionProp(Value: TLvListColumns);
  protected
    function GetOwner: TPersistent; override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
  published
    property Columns: TLvListColumns read FCollectionProp write SetCollectionProp;
  end;
 
  TLvGeneric = class(TWinControl)
  private
    lv : TListView;
    FPersistentProp: TMyPersistent;
    procedure SetPersistentProp(Value: TMyPersistent);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property PersistentProp: TMyPersistent read FPersistentProp write SetPersistentProp;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TLvGeneric]);
end;
 
{ TColumnItem }
 
procedure TColumnItem.Assign(Source: TPersistent);
begin
  if Source is TColumnItem then
    FStringProp := TColumnItem(Source).FStringProp
  else
    inherited Assign(Source);
end;
 
function TColumnItem.GetDisplayName: String;
begin
  Result := Format('Item %d',[Index]);
end;
 
{ TMyCollection }
 
function TLvListColumns.Add: TColumnItem;
begin
  Result := TColumnItem(inherited Add);
end;
 
constructor TLvListColumns.Create(AOwner: TPersistent);
begin
  inherited Create(TColumnItem);
  FOwner := AOwner;
end;
 
function TLvListColumns.GetItem(Index: Integer): TColumnItem;
begin
  Result := TColumnItem(inherited GetItem(Index));
end;
 
function TLvListColumns.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
function TLvListColumns.Insert(Index: Integer): TColumnItem;
begin
  Result := TColumnItem(inherited Insert(Index));
end;
 
procedure TLvListColumns.SetItem(Index: Integer; Value: TColumnItem);
begin
  inherited SetItem(Index, Value);
end;
 
{ TMyPersistent }
 
procedure TMyPersistent.Assign(Source: TPersistent);
begin
  if Source is TMyPersistent then
    columns := TMyPersistent(Source).FCollectionProp
  else
    inherited Assign(Source);
end;
 
constructor TMyPersistent.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FCollectionProp := TLvListColumns.Create(Self);
end;
 
destructor TMyPersistent.Destroy;
begin
  FCollectionProp.Free;
  inherited Destroy;
end;
 
function TMyPersistent.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
procedure TMyPersistent.SetCollectionProp(Value: TLvListColumns);
begin
  FCollectionProp.Assign(Value);
end;
 
{ TLvGeneric }
 
constructor TLvGeneric.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPersistentProp := TMyPersistent.Create(Self);
  width := 300;
  height:= 200;
  lv:=TListView.Create(self);
  lv.Parent:=self;
  lv.ViewStyle:=vsReport;
  lv.left   := 0;
  lv.Top    := 0;
  lv.Width  := Width-30;
  lv.Height := Height;
  lv.Anchors:=[akLeft,akTop,akRight,akBottom];
end;
 
destructor TLvGeneric.Destroy;
begin
  FPersistentProp.Free;
  inherited Destroy;
end;
 
procedure TLvGeneric.SetPersistentProp(Value: TMyPersistent);
begin
  FPersistentProp.Assign(Value);
end;
 
end.

**yannp** · 12/01/2015, 11h10

Bonjour,

J'ai presque réussi à faire ce que je voulais. Par contre, lorsque je crée mon composant ok, je crée mes colonnes ... Mais lorsque je supprime le composant j'ai une erreur qui apparait.

A L'AIDE :

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
 
 
unit ListViewGeneric;
 
interface
 
uses
  Classes, SysUtils, Controls, comCtrls, dialogs;
 
type
  TColumnItem = class(TCollectionItem)
  private
    FCaption  : String;
    FWidth    : integer;
    FWidthMin : integer;
    FWidthMax : integer;
  published
    property Caption    : String  read FCaption  write FCaption;
    property Width      : integer read FWidth    write FWidth;
    property WidthMin   : integer read FWidthMin write FWidthMin;
    property WidthMax   : integer read FWidthMax write FWidthMax;
  end;
 
  TLvListColumns = class(TCollection)
  private
    FOwner: TPersistent;
    function  GetItem(Index: Integer): TColumnItem;
    procedure SetItem(Index: Integer; Value: TColumnItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    function Add: TColumnItem;
    function Insert(Index: Integer): TColumnItem;
    property Items[Index: Integer]: TColumnItem read GetItem write SetItem;
  end;
 
  TMyPersistent = class(TPersistent)
  private
    FOwner: TPersistent;
    FCollectionProp: TLvListColumns;
    procedure SetCollectionProp(Value: TLvListColumns);
  protected
    function GetOwner: TPersistent; override;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(AOwner: TPersistent);
    destructor Destroy; override;
  published
    property Columns: TLvListColumns read FCollectionProp write SetCollectionProp;
  end;
 
  TLvGeneric = class(TWinControl)
  private
    lv : TListView;
    FPersistentProp: TMyPersistent;
    procedure SetPersistentProp(Value: TMyPersistent);
    function  GetPersistentProp:TMyPersistent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property PersistentProp: TMyPersistent read GetPersistentProp write SetPersistentProp;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Exemples', [TLvGeneric]);
end;
 
{ TMyCollection }
 
function TLvListColumns.Add: TColumnItem;
begin
  Result := TColumnItem(inherited Add);
end;
 
constructor TLvListColumns.Create(AOwner: TPersistent);
begin
  inherited Create(TColumnItem);
  FOwner := AOwner;
end;
 
function TLvListColumns.GetItem(Index: Integer): TColumnItem;
begin
  Result := TColumnItem(inherited GetItem(Index));
end;
 
function TLvListColumns.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
function TLvListColumns.Insert(Index: Integer): TColumnItem;
begin
  Result := TColumnItem(inherited Insert(Index));
end;
 
procedure TLvListColumns.SetItem(Index: Integer; Value: TColumnItem);
begin
  inherited SetItem(Index, Value);
end;
 
{ TMyPersistent }
 
procedure TMyPersistent.Assign(Source: TPersistent);
begin
  if Source is TMyPersistent then
    columns := TMyPersistent(Source).FCollectionProp
  else
    inherited Assign(Source);
end;
 
constructor TMyPersistent.Create(AOwner: TPersistent);
begin
  inherited Create;
  FOwner := AOwner;
  FCollectionProp := TLvListColumns.Create(Self);
end;
 
destructor TMyPersistent.Destroy;
begin
  FCollectionProp.Free;
  inherited Destroy;
end;
 
function TMyPersistent.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
 
procedure TMyPersistent.SetCollectionProp(Value: TLvListColumns);
begin
  FCollectionProp.Assign(Value);
end;
 
{ TLvGeneric }
 
constructor TLvGeneric.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPersistentProp := TMyPersistent.Create(Self);
  width := 300;
  height:= 200;
  lv:=TListView.Create(self);
  lv.Parent:=self;
  lv.ViewStyle:=vsReport;
  lv.left   := 0;
  lv.Top    := 0;
  lv.Width  := Width-30;
  lv.Height := Height;
  lv.Anchors:=[akLeft,akTop,akRight,akBottom];
end;
 
destructor TLvGeneric.Destroy;
begin
  FPersistentProp.Free;
  inherited Destroy;
end;
 
procedure TLvGeneric.SetPersistentProp(Value: TMyPersistent);
begin
  FPersistentProp.Assign(Value);
end;
 
function TLvGeneric.GetPersistentProp:TMyPersistent;
var i : integer;
begin
  result:= FPersistentProp;
 
  lv.Columns.Clear;
  for i:=0 to FPersistentProp.Columns.Count-1 do
  begin
    lv.Columns.Add;
    lv.Columns.Items[lv.Columns.Count-1].Width   :=FPersistentProp.Columns.Items[i].FWidth;
    lv.Columns.Items[lv.Columns.Count-1].Caption :=FPersistentProp.Columns.Items[i].FCaption;
  end;
end;
 
end.

Création de composant

Delphi

Discussions similaires

Partager

Partager