← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/tachart/editors/tasubcomponentseditor.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/tachart/editors/tasubcomponentseditor.pas
 
1
{
 
2
 *****************************************************************************
 
3
 *                                                                           *
 
4
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 
5
 *  for details about the copyright.                                         *
 
6
 *                                                                           *
 
7
 *  This program is distributed in the hope that it will be useful,          *
 
8
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 
9
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 
10
 *                                                                           *
 
11
 *****************************************************************************
 
12
 
 
13
Author: Alexander Klenin
 
14
 
 
15
}
 
16
unit TASubcomponentsEditor;
 
17
 
 
18
{$H+}
 
19
 
 
20
interface
 
21
 
 
22
uses
 
23
  Classes, ComCtrls, ComponentEditors, Forms, Menus, PropEdits, StdCtrls;
 
24
 
 
25
type
 
26
 
 
27
  { TSubComponentListEditor }
 
28
 
 
29
  TSubComponentListEditor = class(TComponentEditor)
 
30
  protected
 
31
    function MakeEditorForm: TForm; virtual; abstract;
 
32
  public
 
33
    procedure ExecuteVerb(Index: Integer); override;
 
34
    function GetVerbCount: Integer; override;
 
35
  end;
 
36
 
 
37
  { TComponentListPropertyEditor }
 
38
 
 
39
  TComponentListPropertyEditor = class(TPropertyEditor)
 
40
  protected
 
41
    function GetChildrenCount: Integer; virtual; abstract;
 
42
    function MakeEditorForm: TForm; virtual; abstract;
 
43
  public
 
44
    procedure Edit; override;
 
45
    function GetAttributes: TPropertyAttributes; override;
 
46
    function GetValue: AnsiString; override;
 
47
  end;
 
48
 
 
49
  { TComponentListEditorForm }
 
50
 
 
51
  TComponentListEditorForm = class(TForm)
 
52
    ChildrenListBox: TListBox;
 
53
    menuAddItem: TPopupMenu;
 
54
    tbAdd: TToolButton;
 
55
    tbCommands: TToolBar;
 
56
    tbDelete: TToolButton;
 
57
    tbMoveDown: TToolButton;
 
58
    tbMoveUp: TToolButton;
 
59
    procedure ChildrenListBoxClick(Sender: TObject);
 
60
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
 
61
    procedure FormCreate(Sender: TObject);
 
62
    procedure FormDestroy(Sender: TObject);
 
63
    procedure miAddClick(Sender: TObject);
 
64
    procedure tbDeleteClick(Sender: TObject);
 
65
    procedure tbMoveDownClick(Sender: TObject);
 
66
    procedure tbMoveUpClick(Sender: TObject);
 
67
  private
 
68
    FComponentEditor: TSubComponentListEditor;
 
69
    FDesigner: TComponentEditorDesigner;
 
70
    FParent: TComponent;
 
71
    FPropertyEditor: TComponentListPropertyEditor;
 
72
    function FindChild(ACandidate: TPersistent; out AIndex: Integer): Boolean;
 
73
    procedure MoveSelection(AStart, ADir: Integer);
 
74
    procedure OnComponentRenamed(AComponent: TComponent);
 
75
    procedure OnGetSelection(const ASelection: TPersistentSelectionList);
 
76
    procedure OnPersistentAdded(APersistent: TPersistent; ASelect: Boolean);
 
77
    procedure OnPersistentDeleting(APersistent: TPersistent);
 
78
    procedure OnSetSelection(const ASelection: TPersistentSelectionList);
 
79
    procedure RefreshList;
 
80
    procedure SelectionChanged(AOrderChanged: Boolean = false);
 
81
  protected
 
82
    procedure AddSubcomponent(AParent, AChild: TComponent); virtual; abstract;
 
83
    procedure AddSubcomponentClass(const ACaption: String; ATag: Integer);
 
84
    procedure BuildCaption; virtual; abstract;
 
85
    function ChildClass: TComponentClass; virtual; abstract;
 
86
    procedure EnumerateSubcomponentClasses; virtual; abstract;
 
87
    function GetChildrenList: TFPList; virtual; abstract;
 
88
    function MakeSubcomponent(
 
89
      AOwner: TComponent; ATag: Integer): TComponent; virtual; abstract;
 
90
    property Parent: TComponent read FParent;
 
91
  public
 
92
    constructor Create(
 
93
      AOwner, AParent: TComponent; AComponentEditor: TSubComponentListEditor;
 
94
      APropertyEditor: TComponentListPropertyEditor); reintroduce;
 
95
    destructor Destroy; override;
 
96
  end;
 
97
 
 
98
implementation
 
99
 
 
100
uses
 
101
  IDEImagesIntf, Math, SysUtils, TAChartUtils;
 
102
 
 
103
{$R *.lfm}
 
104
 
 
105
{ TComponentListPropertyEditor }
 
106
 
 
107
procedure TComponentListPropertyEditor.Edit;
 
108
var
 
109
  propValue: TPersistent;
 
110
  editorForm: TForm;
 
111
begin
 
112
  propValue := GetComponent(0);
 
113
  if propValue = nil then
 
114
    raise Exception.Create('TComponentListPropertyEditor.Component=nil');
 
115
  editorForm := FindEditorForm(propValue) as TForm;
 
116
  if editorForm = nil then begin
 
117
    editorForm := MakeEditorForm;
 
118
    RegisterEditorForm(editorForm, propValue);
 
119
  end;
 
120
  editorForm.EnsureVisible;
 
121
end;
 
122
 
 
123
function TComponentListPropertyEditor.GetAttributes: TPropertyAttributes;
 
124
begin
 
125
  Result := [paDialog, paReadOnly];
 
126
end;
 
127
 
 
128
function TComponentListPropertyEditor.GetValue: ansistring;
 
129
var
 
130
  c: Integer;
 
131
begin
 
132
  c := GetChildrenCount;
 
133
  if c = 1 then
 
134
    Result := '1 item'
 
135
  else
 
136
    Result := IntToStr(c) + ' items';
 
137
end;
 
138
 
 
139
{ TSubComponentListEditor }
 
140
 
 
141
procedure TSubComponentListEditor.ExecuteVerb(Index: Integer);
 
142
var
 
143
  propValue: TPersistent;
 
144
  editorForm: TForm;
 
145
begin
 
146
  if Index <> 0 then exit;
 
147
  propValue := GetComponent;
 
148
  if propValue = nil then
 
149
    raise Exception.Create('TSubComponentListEditor.Component=nil');
 
150
  editorForm := FindEditorForm(propValue) as TForm;
 
151
  if editorForm = nil then begin
 
152
    editorForm := MakeEditorForm;
 
153
    RegisterEditorForm(editorForm, propValue);
 
154
  end;
 
155
  editorForm.ShowOnTop;
 
156
end;
 
157
 
 
158
function TSubComponentListEditor.GetVerbCount: Integer;
 
159
begin
 
160
  Result := 1;
 
161
end;
 
162
 
 
163
{ TComponentListEditorForm }
 
164
 
 
165
procedure TComponentListEditorForm.AddSubcomponentClass(
 
166
  const ACaption: String; ATag: Integer);
 
167
var
 
168
  mi: TMenuItem;
 
169
begin
 
170
  if ACaption = '' then exit; // Empty names denote deprecated components.
 
171
  mi := TMenuItem.Create(Self);
 
172
  mi.OnClick := @miAddClick;
 
173
  mi.Caption := ACaption;
 
174
  mi.Tag := ATag;
 
175
  menuAddItem.Items.Add(mi);
 
176
end;
 
177
 
 
178
procedure TComponentListEditorForm.ChildrenListBoxClick(Sender: TObject);
 
179
begin
 
180
  SelectionChanged;
 
181
end;
 
182
 
 
183
constructor TComponentListEditorForm.Create(
 
184
  AOwner, AParent: TComponent; AComponentEditor: TSubComponentListEditor;
 
185
  APropertyEditor: TComponentListPropertyEditor);
 
186
begin
 
187
  inherited Create(AOwner);
 
188
  FParent := AParent;
 
189
  FComponentEditor := AComponentEditor;
 
190
  FPropertyEditor := APropertyEditor;
 
191
  if FComponentEditor <> nil then
 
192
    FDesigner := FComponentEditor.Designer
 
193
  else
 
194
    FDesigner := FindRootDesigner(FParent) as TComponentEditorDesigner;
 
195
  BuildCaption;
 
196
  EnumerateSubcomponentClasses;
 
197
 
 
198
  RefreshList;
 
199
 
 
200
  GlobalDesignHook.AddHandlerComponentRenamed(@OnComponentRenamed);
 
201
  GlobalDesignHook.AddHandlerPersistentDeleting(@OnPersistentDeleting);
 
202
  GlobalDesignHook.AddHandlerGetSelection(@OnGetSelection);
 
203
  GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
 
204
  GlobalDesignHook.AddHandlerPersistentAdded(@OnPersistentAdded);
 
205
 
 
206
  SelectionChanged;
 
207
end;
 
208
 
 
209
destructor TComponentListEditorForm.Destroy;
 
210
begin
 
211
  UnregisterEditorForm(Self);
 
212
  inherited Destroy;
 
213
end;
 
214
 
 
215
function TComponentListEditorForm.FindChild(
 
216
  ACandidate: TPersistent; out AIndex: Integer): Boolean;
 
217
begin
 
218
  if ACandidate is ChildClass then
 
219
    AIndex := ChildrenListBox.Items.IndexOfObject(ACandidate)
 
220
  else
 
221
    AIndex := -1;
 
222
  Result := AIndex >= 0;
 
223
end;
 
224
 
 
225
procedure TComponentListEditorForm.FormClose(
 
226
  Sender: TObject; var CloseAction: TCloseAction);
 
227
begin
 
228
  CloseAction := caFree;
 
229
end;
 
230
 
 
231
procedure TComponentListEditorForm.FormCreate(Sender: TObject);
 
232
begin
 
233
  tbCommands.Images := IDEImages.Images_16;
 
234
  tbAdd.ImageIndex := IDEImages.LoadImage(16, 'laz_add');
 
235
  tbDelete.ImageIndex := IDEImages.LoadImage(16, 'laz_delete');
 
236
  tbMoveDown.ImageIndex := IDEImages.LoadImage(16, 'arrow_down');
 
237
  tbMoveUp.ImageIndex := IDEImages.LoadImage(16, 'arrow_up');
 
238
end;
 
239
 
 
240
procedure TComponentListEditorForm.FormDestroy(Sender: TObject);
 
241
begin
 
242
  if
 
243
    (FComponentEditor <> nil) and (FParent <> nil) and
 
244
    (not (csDestroying in FParent.ComponentState)) and
 
245
    (ChildrenListBox.SelCount > 0)
 
246
  then
 
247
    GlobalDesignHook.SelectOnlyThis(FParent);
 
248
  if Assigned(GlobalDesignHook) then
 
249
    GlobalDesignHook.RemoveAllHandlersForObject(Self);
 
250
end;
 
251
 
 
252
procedure TComponentListEditorForm.miAddClick(Sender: TObject);
 
253
var
 
254
  s: TComponent;
 
255
  n: String;
 
256
begin
 
257
  s := MakeSubcomponent(FParent.Owner, (Sender as TMenuItem).Tag);
 
258
  try
 
259
    n := Copy(s.ClassName, 2, Length(s.ClassName) - 1);
 
260
    s.Name := FDesigner.CreateUniqueComponentName(FParent.Name + n);
 
261
    AddSubcomponent(FParent, s);
 
262
    FDesigner.PropertyEditorHook.PersistentAdded(s, true);
 
263
    FDesigner.Modified;
 
264
    RefreshList;
 
265
  except
 
266
    s.Free;
 
267
    raise;
 
268
  end;
 
269
end;
 
270
 
 
271
procedure TComponentListEditorForm.MoveSelection(AStart, ADir: Integer);
 
272
var
 
273
  i: Integer;
 
274
begin
 
275
  if not ChildrenListBox.SelCount = 0 then exit;
 
276
  i := AStart - ADir;
 
277
  with ChildrenListBox do
 
278
    while InRange(i, 0, Count - 1) and InRange(i + ADir, 0, Count - 1) do begin
 
279
      if Selected[i] and not Selected[i + ADir] then begin
 
280
        with TIndexedComponent(Items.Objects[i]) do
 
281
          Index := Index + ADir;
 
282
        Items.Move(i, i + ADir);
 
283
        Selected[i + ADir] := true;
 
284
        Selected[i] := false;
 
285
      end;
 
286
      i -= ADir;
 
287
    end;
 
288
  FDesigner.Modified;
 
289
  SelectionChanged(true);
 
290
end;
 
291
 
 
292
procedure TComponentListEditorForm.OnComponentRenamed(AComponent: TComponent);
 
293
var
 
294
  i: Integer;
 
295
begin
 
296
  if AComponent = nil then exit;
 
297
  if FindChild(AComponent, i) then
 
298
    ChildrenListBox.Items[i] := AComponent.Name
 
299
  else if AComponent = FParent then
 
300
    BuildCaption;
 
301
end;
 
302
 
 
303
procedure TComponentListEditorForm.OnGetSelection(
 
304
  const ASelection: TPersistentSelectionList);
 
305
var
 
306
  i: Integer;
 
307
begin
 
308
  if ASelection = nil then exit;
 
309
  ASelection.Clear;
 
310
  with ChildrenListBox do
 
311
    for i := 0 to Items.Count - 1 do
 
312
      if Selected[i] then
 
313
        ASelection.Add(TPersistent(Items.Objects[i]));
 
314
end;
 
315
 
 
316
procedure TComponentListEditorForm.OnPersistentAdded(
 
317
  APersistent: TPersistent; ASelect: Boolean);
 
318
var
 
319
  s: TComponent;
 
320
begin
 
321
  if (APersistent = nil) or not (APersistent is ChildClass) then exit;
 
322
  s := APersistent as TComponent;
 
323
  if s.GetParentComponent <> FParent then exit;
 
324
  with ChildrenListBox do
 
325
    Selected[Items.AddObject(s.Name, s)] := ASelect;
 
326
end;
 
327
 
 
328
procedure TComponentListEditorForm.OnPersistentDeleting(
 
329
  APersistent: TPersistent);
 
330
var
 
331
  i, wasSelected: Integer;
 
332
begin
 
333
  if not FindChild(APersistent, i) then exit;
 
334
  with ChildrenListBox do begin
 
335
    wasSelected := ItemIndex;
 
336
    Items.Delete(i);
 
337
    ItemIndex := Min(wasSelected, Count - 1);
 
338
  end;
 
339
end;
 
340
 
 
341
procedure TComponentListEditorForm.OnSetSelection(
 
342
  const ASelection: TPersistentSelectionList);
 
343
var
 
344
  i, j: Integer;
 
345
begin
 
346
  if ASelection = nil then exit;
 
347
  ChildrenListBox.ClearSelection;
 
348
  for i := 0 to ASelection.Count - 1 do
 
349
    if FindChild(ASelection.Items[i], j) then
 
350
      ChildrenListBox.Selected[j] := true;
 
351
end;
 
352
 
 
353
procedure TComponentListEditorForm.RefreshList;
 
354
var
 
355
  ci: TStrings;
 
356
  i: Integer;
 
357
begin
 
358
  ci := ChildrenListBox.Items;
 
359
  try
 
360
    ci.BeginUpdate;
 
361
    ci.Clear;
 
362
    with GetChildrenList do
 
363
      for i := 0 to Count - 1 do
 
364
        ci.AddObject(TComponent(Items[i]).Name, TObject(Items[i]));
 
365
  finally
 
366
    ci.EndUpdate;
 
367
  end;
 
368
end;
 
369
 
 
370
procedure TComponentListEditorForm.SelectionChanged(AOrderChanged: Boolean);
 
371
var
 
372
  sel: TPersistentSelectionList;
 
373
begin
 
374
  GlobalDesignHook.RemoveHandlerSetSelection(@OnSetSelection);
 
375
  try
 
376
    sel := TPersistentSelectionList.Create;
 
377
    sel.ForceUpdate := AOrderChanged;
 
378
    try
 
379
      OnGetSelection(sel);
 
380
      FDesigner.PropertyEditorHook.SetSelection(sel);
 
381
    finally
 
382
      sel.Free;
 
383
    end;
 
384
  finally
 
385
    GlobalDesignHook.AddHandlerSetSelection(@OnSetSelection);
 
386
  end;
 
387
end;
 
388
 
 
389
procedure TComponentListEditorForm.tbDeleteClick(Sender: TObject);
 
390
begin
 
391
  if ChildrenListBox.SelCount = 0 then exit;
 
392
  FDesigner.DeleteSelection;
 
393
  SelectionChanged;
 
394
end;
 
395
 
 
396
procedure TComponentListEditorForm.tbMoveDownClick(Sender: TObject);
 
397
begin
 
398
  MoveSelection(ChildrenListBox.Count - 1, 1);
 
399
end;
 
400
 
 
401
procedure TComponentListEditorForm.tbMoveUpClick(Sender: TObject);
 
402
begin
 
403
  MoveSelection(0, -1);
 
404
end;
 
405
 
 
406
end.
 
407