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

« back to all changes in this revision

Viewing changes to components/tachart/talegend.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
[ 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:
20
20
interface
21
21
 
22
22
uses
23
 
  Classes, Contnrs, SysUtils, Graphics, TAChartUtils, TATypes;
 
23
  Classes, Contnrs, FPCanvas, Graphics, SysUtils,
 
24
  TAChartUtils, TADrawUtils, TATypes;
24
25
 
25
26
const
26
27
  DEF_LEGEND_SPACING = 4;
27
28
  DEF_LEGEND_MARGIN = 4;
28
29
  DEF_LEGEND_SYMBOL_WIDTH = 20;
 
30
  LEGEND_ITEM_ORDER_AS_ADDED = -1;
 
31
  LEGEND_ITEM_NO_GROUP = -1;
29
32
 
30
33
type
31
34
  { TLegendItem }
32
35
 
33
36
  TLegendItem = class
34
 
  private
 
37
  strict private
35
38
    FColor: TColor;
 
39
    FFont: TFont;
 
40
    FGroupIndex: Integer;
 
41
    FOrder: Integer;
 
42
    FOwner: TIndexedComponent;
36
43
    FText: String;
37
44
  public
38
45
    constructor Create(const AText: String; AColor: TColor = clTAColor);
39
 
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); virtual;
 
46
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); virtual;
 
47
    function HasSymbol: Boolean; virtual;
 
48
    procedure UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont);
40
49
  public
41
50
    property Color: TColor read FColor write FColor;
 
51
    property Font: TFont read FFont write FFont;
 
52
    property GroupIndex: Integer read FGroupIndex write FGroupIndex;
 
53
    property Order: Integer read FOrder write FOrder;
 
54
    property Owner: TIndexedComponent read FOwner write FOwner;
 
55
    property Text: String read FText write FText;
 
56
  end;
 
57
 
 
58
  { TLegendItemGroupTitle }
 
59
 
 
60
  TLegendItemGroupTitle = class(TLegendItem)
 
61
  public
 
62
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
 
63
    function HasSymbol: Boolean; override;
42
64
  end;
43
65
 
44
66
  TLegendItemDrawEvent = procedure (
45
 
    ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; var AText: String
 
67
    ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; AItem: TLegendItem
46
68
  ) of object;
47
69
 
48
70
  { TLegendItemUserDrawn }
49
71
 
50
72
  TLegendItemUserDrawn = class(TLegendItem)
51
 
  private
 
73
  strict private
52
74
    FIndex: Integer;
53
75
    FOnDraw: TLegendItemDrawEvent;
54
76
  public
55
77
    constructor Create(
56
78
      AIndex: Integer; AOnDraw: TLegendItemDrawEvent; const AText: String);
57
 
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
 
79
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
58
80
    property OnDraw: TLegendItemDrawEvent read FOnDraw;
59
81
  end;
60
82
 
61
83
  { TLegendItemLine }
62
84
 
63
85
  TLegendItemLine = class(TLegendItem)
64
 
  private
65
 
    FPen: TPen;
 
86
  strict private
 
87
    FPen: TFPCustomPen;
66
88
  public
67
 
    constructor Create(APen: TPen; const AText: String);
68
 
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
69
 
    property Pen: TPen read FPen;
 
89
    constructor Create(APen: TFPCustomPen; const AText: String);
 
90
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
70
91
  end;
71
92
 
72
93
  { TLegendItemLinePointer }
73
94
 
74
95
  TLegendItemLinePointer = class(TLegendItemLine)
75
 
  protected
 
96
  strict protected
76
97
    FPointer: TSeriesPointer;
77
98
  public
78
99
    constructor Create(
79
100
      APen: TPen; APointer: TSeriesPointer; const AText: String);
80
 
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
 
101
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
81
102
  end;
82
103
 
83
104
  { TLegendItemBrushRect }
84
105
 
85
106
  TLegendItemBrushRect = class(TLegendItem)
86
 
  private
87
 
    FBrush: TBrush;
88
 
  public
89
 
    constructor Create(ABrush: TBrush; const AText: String);
90
 
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
91
 
  end;
92
 
 
93
 
  { TLegendItemPieSlice }
94
 
 
95
 
  TLegendItemPieSlice = class(TLegendItem)
96
 
  public
97
 
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
98
 
  end;
99
 
 
100
 
  TChartLegendItems = TObjectList;
 
107
  strict private
 
108
    FBrush: TFPCustomBrush;
 
109
  public
 
110
    constructor Create(ABrush: TFPCustomBrush; const AText: String);
 
111
    procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
 
112
  end;
 
113
 
 
114
  TLegendItemsEnumerator = class(TListEnumerator)
 
115
  public
 
116
    function GetCurrent: TLegendItem;
 
117
    property Current: TLegendItem read GetCurrent;
 
118
  end;
 
119
 
 
120
  { TChartLegendItems }
 
121
 
 
122
  TChartLegendItems = class(TObjectList)
 
123
  strict private
 
124
    function GetItem(AIndex: Integer): TLegendItem;
 
125
    procedure SetItem(AIndex: Integer; AValue: TLegendItem);
 
126
  public
 
127
    function GetEnumerator: TLegendItemsEnumerator;
 
128
    property Items[AIndex: Integer]: TLegendItem
 
129
      read GetItem write SetItem; default;
 
130
  end;
101
131
 
102
132
  TChartLegendBrush = class(TBrush)
103
133
  published
104
134
    property Color default clWhite;
105
135
  end;
106
136
 
107
 
  TLegendAlignment = (laTopLeft, laBottomLeft, laTopRight, laBottomRight);
 
137
  TLegendAlignment = (
 
138
    laTopLeft, laCenterLeft, laBottomLeft,
 
139
    laTopCenter, laBottomCenter, // laCenterCenter makes no sense.
 
140
    laTopRight, laCenterRight, laBottomRight);
 
141
 
 
142
  TChartLegendDrawingData = record
 
143
    FBounds: TRect;
 
144
    FColCount: Integer;
 
145
    FDrawer: IChartDrawer;
 
146
    FItems: TChartLegendItems;
 
147
    FItemSize: TPoint;
 
148
    FRowCount: Integer;
 
149
  end;
 
150
 
 
151
  TLegendColumnCount = 1..MaxInt;
 
152
  TLegendItemFillOrder = (lfoColRow, lfoRowCol);
108
153
 
109
154
  { TChartLegend }
110
155
 
111
156
  TChartLegend = class(TChartElement)
112
 
  private
 
157
  strict private
113
158
    FAlignment: TLegendAlignment;
114
159
    FBackgroundBrush: TChartLegendBrush;
 
160
    FColumnCount: TLegendColumnCount;
115
161
    FFont: TFont;
116
162
    FFrame: TChartPen;
 
163
    FGroupFont: TFont;
 
164
    FGroupTitles: TStrings;
 
165
    FItemFillOrder: TLegendItemFillOrder;
117
166
    FMarginX: TChartDistance;
118
167
    FMarginY: TChartDistance;
119
168
    FSpacing: TChartDistance;
 
169
    FSymbolFrame: TChartPen;
120
170
    FSymbolWidth: TChartDistance;
121
171
    FUseSidebar: Boolean;
122
172
 
 
173
    // Not includes the margins around item.
 
174
    function MeasureItem(
 
175
      ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint;
123
176
    procedure SetAlignment(AValue: TLegendAlignment);
124
177
    procedure SetBackgroundBrush(AValue: TChartLegendBrush);
 
178
    procedure SetColumnCount(AValue: TLegendColumnCount);
125
179
    procedure SetFont(AValue: TFont);
126
180
    procedure SetFrame(AValue: TChartPen);
 
181
    procedure SetGroupFont(AValue: TFont);
 
182
    procedure SetGroupTitles(AValue: TStrings);
 
183
    procedure SetItemFillOrder(AValue: TLegendItemFillOrder);
127
184
    procedure SetMargin(AValue: TChartDistance);
128
185
    procedure SetMarginX(AValue: TChartDistance);
129
186
    procedure SetMarginY(AValue: TChartDistance);
130
187
    procedure SetSpacing(AValue: TChartDistance);
 
188
    procedure SetSymbolFrame(AValue: TChartPen);
131
189
    procedure SetSymbolWidth(AValue: TChartDistance);
132
190
    procedure SetUseSidebar(AValue: Boolean);
133
191
  public
135
193
    destructor Destroy; override;
136
194
 
137
195
  public
 
196
    procedure AddGroups(AItems: TChartLegendItems);
138
197
    procedure Assign(Source: TPersistent); override;
139
 
    procedure Draw(
140
 
      ACanvas: TCanvas; AItems: TObjectList; const ABounds: TRect);
141
 
    function Prepare(
142
 
      ACanvas: TCanvas; AItems: TObjectList; var AClipRect: TRect): TRect;
 
198
    procedure Draw(var AData: TChartLegendDrawingData);
 
199
    procedure Prepare(var AData: TChartLegendDrawingData; var AClipRect: TRect);
 
200
    procedure SortItemsByOrder(AItems: TChartLegendItems);
143
201
  published
144
202
    property Alignment: TLegendAlignment
145
203
      read FAlignment write SetAlignment default laTopRight;
146
204
    property BackgroundBrush: TChartLegendBrush
147
205
      read FBackgroundBrush write SetBackgroundBrush;
 
206
    property ColumnCount: TLegendColumnCount
 
207
      read FColumnCount write SetColumnCount default 1;
148
208
    property Font: TFont read FFont write SetFont;
149
209
    property Frame: TChartPen read FFrame write SetFrame;
 
210
    property GroupFont: TFont read FGroupFont write SetGroupFont;
 
211
    property GroupTitles: TStrings read FGroupTitles write SetGroupTitles;
 
212
    property ItemFillOrder: TLegendItemFillOrder
 
213
      read FItemFillOrder write SetItemFillOrder default lfoColRow;
150
214
    property Margin: TChartDistance
151
215
      read FMarginX write SetMargin stored false; deprecated;
152
216
    property MarginX: TChartDistance
155
219
      read FMarginY write SetMarginY default DEF_LEGEND_MARGIN;
156
220
    property Spacing: TChartDistance
157
221
      read FSpacing write SetSpacing default DEF_LEGEND_SPACING;
 
222
    property SymbolFrame: TChartPen read FSymbolFrame write SetSymbolFrame;
158
223
    property SymbolWidth: TChartDistance
159
224
      read FSymbolWidth write SetSymbolWidth default DEF_LEGEND_SYMBOL_WIDTH;
160
225
    property UseSidebar: Boolean read FUseSidebar write SetUseSidebar default true;
163
228
 
164
229
  TLegendMultiplicity = (lmSingle, lmPoint);
165
230
 
 
231
  TLegendItemCreateEvent = procedure (
 
232
    AItem: TLegendItem; AIndex: Integer) of object;
 
233
 
166
234
  { TChartSeriesLegend }
167
235
 
168
236
  TChartSeriesLegend = class(TChartElement)
169
 
  private
 
237
  strict private
 
238
    FFormat: String;
 
239
    FGroupIndex: Integer;
170
240
    FMultiplicity: TLegendMultiplicity;
 
241
    FOnCreate: TLegendItemCreateEvent;
171
242
    FOnDraw: TLegendItemDrawEvent;
 
243
    FOrder: Integer;
172
244
    FUserItemsCount: Integer;
 
245
    procedure SetFormat(AValue: String);
 
246
    procedure SetGroupIndex(AValue: Integer);
173
247
    procedure SetMultiplicity(AValue: TLegendMultiplicity);
 
248
    procedure SetOnCreate(AValue: TLegendItemCreateEvent);
174
249
    procedure SetOnDraw(AValue: TLegendItemDrawEvent);
 
250
    procedure SetOrder(AValue: Integer);
175
251
    procedure SetUserItemsCount(AValue: Integer);
176
252
  public
177
253
    constructor Create(AOwner: TCustomChart);
178
254
  public
179
255
    procedure Assign(Source: TPersistent); override;
 
256
    procedure InitItem(
 
257
      AItem: TLegendItem; AIndex: Integer; ALegend: TChartLegend);
180
258
  published
 
259
    property Format: String read FFormat write SetFormat;
 
260
    property GroupIndex: Integer
 
261
      read FGroupIndex write SetGroupIndex default LEGEND_ITEM_NO_GROUP;
181
262
    property Multiplicity: TLegendMultiplicity
182
263
      read FMultiplicity write SetMultiplicity default lmSingle;
183
 
    property OnDraw: TLegendItemDrawEvent read FOnDraw write SetOnDraw;
 
264
    property Order: Integer
 
265
      read FOrder write SetOrder default LEGEND_ITEM_ORDER_AS_ADDED;
184
266
    property UserItemsCount: Integer
185
267
      read FUserItemsCount write SetUserItemsCount default 1;
186
268
    property Visible default true;
 
269
 
 
270
  published
 
271
    property OnCreate: TLegendItemCreateEvent read FOnCreate write SetOnCreate;
 
272
    property OnDraw: TLegendItemDrawEvent read FOnDraw write SetOnDraw;
187
273
  end;
188
274
 
189
275
implementation
190
276
 
191
277
uses
192
 
  Math, PropEdits, Types, TADrawUtils;
 
278
  Math, PropEdits, Types, TADrawerCanvas, TAGeometry;
193
279
 
194
280
const
195
281
  SYMBOL_TEXT_SPACING = 4;
196
282
 
 
283
function LegendItemCompare(AItem1, AItem2: Pointer): Integer;
 
284
var
 
285
  li1: TLegendItem absolute AItem1;
 
286
  li2: TLegendItem absolute AItem2;
 
287
begin
 
288
  Result := Sign(li1.GroupIndex - li2.GroupIndex);
 
289
  if Result = 0 then
 
290
    Result := Sign(li1.Order - li2.Order);
 
291
end;
 
292
 
 
293
{ TLegendItemsEnumerator }
 
294
 
 
295
function TLegendItemsEnumerator.GetCurrent: TLegendItem;
 
296
begin
 
297
  Result := TLegendItem(inherited GetCurrent);
 
298
end;
 
299
 
 
300
{ TChartLegendItems }
 
301
 
 
302
function TChartLegendItems.GetEnumerator: TLegendItemsEnumerator;
 
303
begin
 
304
  Result := TLegendItemsEnumerator.Create(Self);
 
305
end;
 
306
 
 
307
function TChartLegendItems.GetItem(AIndex: Integer): TLegendItem;
 
308
begin
 
309
  Result := TLegendItem(inherited GetItem(AIndex));
 
310
end;
 
311
 
 
312
procedure TChartLegendItems.SetItem(AIndex: Integer; AValue: TLegendItem);
 
313
begin
 
314
  inherited SetItem(AIndex, AValue);
 
315
end;
 
316
 
197
317
{ TLegendItem }
198
318
 
199
319
constructor TLegendItem.Create(const AText: String; AColor: TColor);
200
320
begin
201
321
  FColor := AColor;
 
322
  FGroupIndex := LEGEND_ITEM_NO_GROUP;
 
323
  FOrder := LEGEND_ITEM_ORDER_AS_ADDED;
202
324
  FText := AText;
203
325
end;
204
326
 
205
 
procedure TLegendItem.Draw(ACanvas: TCanvas; const ARect: TRect);
206
 
begin
207
 
  ACanvas.TextOut(ARect.Right + SYMBOL_TEXT_SPACING, ARect.Top, FText);
 
327
procedure TLegendItem.Draw(ADrawer: IChartDrawer; const ARect: TRect);
 
328
begin
 
329
  ADrawer.TextOut.
 
330
    Pos(ARect.Right + SYMBOL_TEXT_SPACING, ARect.Top).Text(FText).Done;
 
331
end;
 
332
 
 
333
function TLegendItem.HasSymbol: Boolean;
 
334
begin
 
335
  Result := true;
 
336
end;
 
337
 
 
338
procedure TLegendItem.UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont);
 
339
begin
 
340
  if APrevFont = Font then exit;
 
341
  ADrawer.Font := Font;
 
342
  APrevFont := Font;
 
343
end;
 
344
 
 
345
{ TLegendItemGroupTitle }
 
346
 
 
347
procedure TLegendItemGroupTitle.Draw(ADrawer: IChartDrawer; const ARect: TRect);
 
348
begin
 
349
  ADrawer.TextOut.Pos(ARect.Left, ARect.Top).Text(Text).Done;
 
350
end;
 
351
 
 
352
function TLegendItemGroupTitle.HasSymbol: Boolean;
 
353
begin
 
354
  Result := false;
208
355
end;
209
356
 
210
357
{ TLegendItemUserDrawn }
217
364
  FOnDraw := AOnDraw;
218
365
end;
219
366
 
220
 
procedure TLegendItemUserDrawn.Draw(ACanvas: TCanvas; const ARect: TRect);
 
367
procedure TLegendItemUserDrawn.Draw(ADrawer: IChartDrawer; const ARect: TRect);
 
368
var
 
369
  ic: IChartTCanvasDrawer;
221
370
begin
222
 
  if Assigned(FOnDraw) then
223
 
    FOnDraw(ACanvas, ARect, FIndex, FText);
224
 
  inherited Draw(ACanvas, ARect);
 
371
  if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(FOnDraw) then
 
372
    FOnDraw(ic.Canvas, ARect, FIndex, Self);
 
373
  inherited Draw(ADrawer, ARect);
225
374
end;
226
375
 
227
376
{ TLegendItemLine }
228
377
 
229
 
constructor TLegendItemLine.Create(APen: TPen; const AText: String);
 
378
constructor TLegendItemLine.Create(APen: TFPCustomPen; const AText: String);
230
379
begin
231
380
  inherited Create(AText);
232
381
  FPen := APen;
233
382
end;
234
383
 
235
 
procedure TLegendItemLine.Draw(ACanvas: TCanvas; const ARect: TRect);
 
384
procedure TLegendItemLine.Draw(ADrawer: IChartDrawer; const ARect: TRect);
236
385
var
237
386
  y: Integer;
238
387
begin
239
 
  inherited Draw(ACanvas, ARect);
 
388
  inherited Draw(ADrawer, ARect);
240
389
  if FPen = nil then exit;
241
 
  ACanvas.Pen.Assign(FPen);
 
390
  ADrawer.Pen := FPen;
242
391
  y := (ARect.Top + ARect.Bottom) div 2;
243
 
  ACanvas.Line(ARect.Left, y, ARect.Right, y);
 
392
  ADrawer.Line(ARect.Left, y, ARect.Right, y);
244
393
end;
245
394
 
246
395
{ TLegendItemLinePointer }
252
401
  FPointer := APointer;
253
402
end;
254
403
 
255
 
procedure TLegendItemLinePointer.Draw(ACanvas: TCanvas; const ARect: TRect);
 
404
procedure TLegendItemLinePointer.Draw(
 
405
  ADrawer: IChartDrawer; const ARect: TRect);
256
406
var
257
407
  c, sz: TPoint;
258
408
begin
259
 
  inherited Draw(ACanvas, ARect);
 
409
  inherited Draw(ADrawer, ARect);
260
410
  if FPointer = nil then exit;
261
411
  c := CenterPoint(ARect);
262
412
  // Max width slightly narrower then ARect to leave place for the line.
263
413
  sz.X := Min(FPointer.HorizSize, (ARect.Right - ARect.Left) div 3);
264
414
  sz.Y := Min(FPointer.VertSize, (ARect.Bottom - ARect.Top) div 2);
265
 
  FPointer.DrawSize(ACanvas, c, sz, Color);
 
415
  FPointer.DrawSize(ADrawer, c, sz, Color);
266
416
end;
267
417
 
268
418
{ TLegendItemBrushRect }
269
419
 
270
 
constructor TLegendItemBrushRect.Create(ABrush: TBrush; const AText: String);
 
420
constructor TLegendItemBrushRect.Create(
 
421
  ABrush: TFPCustomBrush; const AText: String);
271
422
begin
272
423
  inherited Create(AText);
273
424
  FBrush := ABrush;
274
425
end;
275
426
 
276
 
procedure TLegendItemBrushRect.Draw(ACanvas: TCanvas; const ARect: TRect);
 
427
procedure TLegendItemBrushRect.Draw(ADrawer: IChartDrawer; const ARect: TRect);
277
428
begin
278
 
  inherited Draw(ACanvas, ARect);
 
429
  inherited Draw(ADrawer, ARect);
279
430
  if FBrush = nil then
280
 
    ACanvas.Brush.Style := bsSolid
281
 
  else
282
 
    ACanvas.Brush.Assign(FBrush);
283
 
  if Color <> clTAColor then
284
 
    ACanvas.Brush.Color := Color;
285
 
  ACanvas.Rectangle(ARect);
286
 
end;
287
 
 
288
 
{ TLegendItemPieSlice }
289
 
 
290
 
procedure TLegendItemPieSlice.Draw(ACanvas: TCanvas; const ARect: TRect);
291
 
const
292
 
  ANGLE = 30 * 16;
293
 
begin
294
 
  inherited Draw(ACanvas, ARect);
295
 
  ACanvas.Brush.Style := bsSolid;
296
 
  if Color <> clTAColor then
297
 
    ACanvas.Brush.Color := Color;
298
 
  ACanvas.RadialPie(
299
 
    2 * ARect.Left - ARect.Right, ARect.Top, ARect.Right, ARect.Bottom,
300
 
    -ANGLE, 2 * ANGLE);
 
431
    ADrawer.SetBrushParams(bsSolid, ColorDef(Color, clRed))
 
432
  else begin
 
433
    ADrawer.Brush := FBrush;
 
434
    if Color <> clTAColor then
 
435
      ADrawer.SetBrushParams(FBrush.Style, Color);
 
436
  end;
 
437
  ADrawer.Rectangle(ARect);
301
438
end;
302
439
 
303
440
{ TChartLegend }
304
441
 
 
442
procedure TChartLegend.AddGroups(AItems: TChartLegendItems);
 
443
var
 
444
  i, gi: Integer;
 
445
  g: TLegendItemGroupTitle;
 
446
begin
 
447
  for i := AItems.Count - 1 downto 0 do begin
 
448
    gi := AItems[i].GroupIndex;
 
449
    if
 
450
      InRange(gi, 0, GroupTitles.Count - 1) and
 
451
      ((i = 0) or (AItems[i - 1].GroupIndex <> gi))
 
452
    then begin
 
453
      g := TLegendItemGroupTitle.Create(GroupTitles[gi]);
 
454
      g.GroupIndex := gi;
 
455
      g.Font := GroupFont;
 
456
      AItems.Insert(i, g);
 
457
    end;
 
458
  end;
 
459
end;
 
460
 
305
461
procedure TChartLegend.Assign(Source: TPersistent);
306
462
begin
307
463
  if Source is TChartLegend then
308
 
    with TChartLegend(Source) do
309
 
      Self.FAlignment := FAlignment;
 
464
    with TChartLegend(Source) do begin
 
465
      Self.FAlignment := Alignment;
 
466
      Self.FBackgroundBrush.Assign(BackgroundBrush);
 
467
      Self.FColumnCount := ColumnCount;
 
468
      Self.FFont.Assign(Font);
 
469
      Self.FFrame.Assign(Frame);
 
470
      Self.FGroupFont.Assign(GroupFont);
 
471
      Self.FGroupTitles.Assign(GroupTitles);
 
472
      Self.FMarginX := MarginX;
 
473
      Self.FMarginY := MarginY;
 
474
      Self.FSpacing := Spacing;
 
475
      Self.FSymbolFrame.Assign(SymbolFrame);
 
476
      Self.FSymbolWidth := SymbolWidth;
 
477
      Self.FUseSidebar := UseSidebar;
 
478
    end;
310
479
 
311
480
  inherited Assign(Source);
312
481
end;
315
484
begin
316
485
  inherited Create(AOwner);
317
486
  FAlignment := laTopRight;
 
487
  FColumnCount := 1;
 
488
  FGroupTitles := TStringList.Create;
318
489
  FMarginX := DEF_LEGEND_MARGIN;
319
490
  FMarginY := DEF_LEGEND_MARGIN;
320
491
  FSpacing := DEF_LEGEND_SPACING;
325
496
  InitHelper(FBackgroundBrush, TChartLegendBrush);
326
497
  InitHelper(FFont, TFont);
327
498
  InitHelper(FFrame, TChartPen);
 
499
  InitHelper(FGroupFont, TFont);
 
500
  InitHelper(FSymbolFrame, TChartPen);
328
501
end;
329
502
 
330
503
destructor TChartLegend.Destroy;
332
505
  FreeAndNil(FBackgroundBrush);
333
506
  FreeAndNil(FFont);
334
507
  FreeAndNil(FFrame);
 
508
  FreeAndNil(FGroupFont);
 
509
  FreeAndNil(FGroupTitles);
 
510
  FreeAndNil(FSymbolFrame);
335
511
 
336
512
  inherited;
337
513
end;
338
514
 
339
 
procedure TChartLegend.Draw(
340
 
  ACanvas: TCanvas; AItems: TObjectList; const ABounds: TRect);
 
515
procedure TChartLegend.Draw(var AData: TChartLegendDrawingData);
341
516
var
342
 
  i, h: Integer;
343
 
  pbf: TPenBrushFontRecall;
 
517
  i, x, y: Integer;
344
518
  r: TRect;
 
519
  prevFont: TFont = nil;
 
520
  drawer: IChartDrawer;
345
521
begin
346
 
  pbf := TPenBrushFontRecall.Create(ACanvas, [pbfPen, pbfBrush, pbfFont]);
347
 
  try
348
 
    // Draw the background and the border.
349
 
    ACanvas.Font.Assign(Font);
350
 
    ACanvas.Brush.Assign(BackgroundBrush);
351
 
    if Frame.Visible then
352
 
      ACanvas.Pen.Assign(Frame)
353
 
    else
354
 
      ACanvas.Pen.Style := psClear;
355
 
    ACanvas.Rectangle(ABounds);
356
 
 
357
 
    r := ABounds;
358
 
    r.Right -= 1;
359
 
    ACanvas.ClipRect :=  r;
360
 
    ACanvas.Clipping := true;
361
 
    // Draw items.
362
 
    h := TypicalTextHeight(ACanvas);
363
 
    r := Bounds(ABounds.Left + Spacing, ABounds.Top + Spacing, SymbolWidth, h);
364
 
    for i := 0 to AItems.Count - 1 do begin
365
 
      ACanvas.Brush.Assign(BackgroundBrush);
366
 
      ACanvas.Pen.Assign(Frame);
367
 
      (AItems[i] as TLegendItem).Draw(ACanvas, r);
368
 
      OffsetRect(r, 0, h + Spacing);
 
522
  drawer := AData.FDrawer;
 
523
  // Draw the background and the border.
 
524
  drawer.Brush := BackgroundBrush;
 
525
  if Frame.Visible then
 
526
    drawer.Pen := Frame
 
527
  else
 
528
    drawer.SetPenParams(psClear, clTAColor);
 
529
  r := AData.FBounds;
 
530
  drawer.Rectangle(r);
 
531
  if AData.FItems.Count = 0 then exit;
 
532
 
 
533
  r.Right -= 1;
 
534
  drawer.ClippingStart(r);
 
535
 
 
536
  with AData do try
 
537
    for i := 0 to FItems.Count - 1 do begin
 
538
      FItems[i].UpdateFont(drawer, prevFont);
 
539
      drawer.Brush := BackgroundBrush;
 
540
      if SymbolFrame.Visible then
 
541
        drawer.Pen := SymbolFrame
 
542
      else
 
543
        drawer.SetPenParams(psClear, clTAColor);
 
544
      x := 0;
 
545
      y := 0;
 
546
      case ItemFillOrder of
 
547
        lfoColRow: DivMod(i, FRowCount, x, y);
 
548
        lfoRowCol: DivMod(i, FColCount, y, x);
 
549
      end;
 
550
      r := Bounds(
 
551
        FBounds.Left + Spacing + x * (FItemSize.X + Spacing),
 
552
        FBounds.Top + Spacing + y * (FItemSize.Y + Spacing),
 
553
        SymbolWidth, FItemSize.Y);
 
554
      FItems[i].Draw(drawer, r);
 
555
      OffsetRect(r, 0, FItemSize.Y + Spacing);
369
556
    end;
370
557
  finally
371
 
    pbf.Free;
372
 
    ACanvas.Clipping := false;
373
 
  end;
374
 
end;
375
 
 
376
 
function TChartLegend.Prepare(
377
 
  ACanvas: TCanvas; AItems: TObjectList; var AClipRect: TRect): TRect;
378
 
var
379
 
  w, x, y, i, textHeight, legendWidth, legendHeight: Integer;
380
 
  f: TPenBrushFontRecall;
381
 
begin
382
 
  f := TPenBrushFontRecall.Create(ACanvas, [pbfFont]);
383
 
  try
384
 
    ACanvas.Font.Assign(Font);
385
 
 
386
 
    // Measure the legend.
387
 
    legendWidth := 0;
388
 
    for i := 0 to AItems.Count - 1 do
389
 
      with AItems[i] as TLegendItem do
390
 
        legendWidth := Max(ACanvas.TextWidth(FText), legendWidth);
391
 
    legendWidth += 2 * Spacing + SYMBOL_TEXT_SPACING + SymbolWidth;
392
 
    w := 2 * MarginX;
393
 
    with AClipRect do
394
 
      legendWidth := EnsureRange(legendWidth, 0, Right - Left - w);
395
 
    w += legendWidth;
396
 
 
397
 
    textHeight := TypicalTextHeight(ACanvas);
398
 
    legendHeight := Spacing + AItems.Count * (textHeight + Spacing);
399
 
 
400
 
    // Determine position according to the alignment.
401
 
    if Alignment in [laTopLeft, laBottomLeft] then begin
 
558
    drawer.ClippingStop;
 
559
  end;
 
560
end;
 
561
 
 
562
function TChartLegend.MeasureItem(
 
563
  ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint;
 
564
var
 
565
  p: TPoint;
 
566
  prevFont: TFont = nil;
 
567
  li: TLegendItem;
 
568
begin
 
569
  Result := Point(0, 0);
 
570
  for li in AItems do begin
 
571
    li.UpdateFont(ADrawer, prevFont);
 
572
    if li.Text = '' then
 
573
      p := Point(0, ADrawer.TextExtent('I').Y)
 
574
    else
 
575
      p := ADrawer.TextExtent(li.Text);
 
576
    if li.HasSymbol then
 
577
      p.X += SYMBOL_TEXT_SPACING + SymbolWidth;
 
578
    Result := MaxPoint(p, Result);
 
579
  end;
 
580
end;
 
581
 
 
582
procedure TChartLegend.Prepare(
 
583
  var AData: TChartLegendDrawingData; var AClipRect: TRect);
 
584
var
 
585
  x, y: Integer;
 
586
  sidebar, legendSize: TPoint;
 
587
begin
 
588
  with AData do begin
 
589
    FColCount := Max(Min(ColumnCount, FItems.Count), 1);
 
590
    FRowCount := (FItems.Count - 1) div FColCount + 1;
 
591
    FItemSize := MeasureItem(FDrawer, FItems);
 
592
    legendSize.X := (FItemSize.X + Spacing) * FColCount + Spacing;
 
593
    legendSize.Y := (FItemSize.Y + Spacing) * FRowCount + Spacing;
 
594
  end;
 
595
 
 
596
  sidebar.X := 2 * MarginX;
 
597
  with AClipRect do
 
598
    legendSize.X := EnsureRange(legendSize.X, 0, Right - Left - sidebar.X);
 
599
  sidebar.X += legendSize.X;
 
600
 
 
601
  sidebar.Y := 2 * MarginX;
 
602
  with AClipRect do
 
603
    legendSize.Y := EnsureRange(legendSize.Y, 0, Bottom - Top - sidebar.Y);
 
604
  sidebar.Y += legendSize.Y;
 
605
 
 
606
  // Determine position according to the alignment.
 
607
  case Alignment of
 
608
    laTopLeft, laCenterLeft, laBottomLeft:
402
609
      x := AClipRect.Left + MarginX;
403
 
      if UseSidebar then
404
 
        AClipRect.Left += w;
405
 
    end
406
 
    else begin
407
 
      x := AClipRect.Right - legendWidth - MarginX;
408
 
      if UseSidebar then
409
 
        AClipRect.Right -= w;
 
610
    laTopRight, laCenterRight, laBottomRight:
 
611
      x := AClipRect.Right - legendSize.X - MarginX;
 
612
    laTopCenter, laBottomCenter:
 
613
      x := (AClipRect.Right + AClipRect.Left - legendSize.X) div 2;
 
614
  end;
 
615
  case Alignment of
 
616
    laTopLeft, laTopCenter, laTopRight:
 
617
      y := AClipRect.Top + MarginY;
 
618
    laBottomLeft, laBottomCenter, laBottomRight:
 
619
      y := AClipRect.Bottom - MarginY - legendSize.Y;
 
620
    laCenterLeft, laCenterRight:
 
621
      y := (AClipRect.Top + AClipRect.Bottom - legendSize.Y) div 2;
 
622
  end;
 
623
  if UseSidebar then
 
624
    case Alignment of
 
625
      laTopLeft, laCenterLeft, laBottomLeft:
 
626
        AClipRect.Left += sidebar.X;
 
627
      laTopRight, laCenterRight, laBottomRight:
 
628
        AClipRect.Right -= sidebar.X;
 
629
      laTopCenter:
 
630
        AClipRect.Top += legendSize.Y + 2 * MarginY;
 
631
      laBottomCenter:
 
632
        AClipRect.Bottom -= legendSize.Y + 2 * MarginY;
410
633
    end;
411
 
    if Alignment in [laTopLeft, laTopRight] then
412
 
      y := AClipRect.Top + MarginY
413
 
    else
414
 
      y := AClipRect.Bottom - MarginY - legendHeight;
415
 
 
416
 
    Result := Bounds(x, y, legendWidth, legendHeight);
417
 
  finally
418
 
    f.Free;
419
 
  end;
 
634
  AData.FBounds := Bounds(x, y, legendSize.X, legendSize.Y);
420
635
end;
421
636
 
422
637
procedure TChartLegend.SetAlignment(AValue: TLegendAlignment);
432
647
  StyleChanged(Self);
433
648
end;
434
649
 
 
650
procedure TChartLegend.SetColumnCount(AValue: TLegendColumnCount);
 
651
begin
 
652
  if FColumnCount = AValue then exit;
 
653
  FColumnCount := AValue;
 
654
  StyleChanged(Self);
 
655
end;
 
656
 
435
657
procedure TChartLegend.SetFont(AValue: TFont);
436
658
begin
437
659
  FFont.Assign(AValue);
444
666
  StyleChanged(Self);
445
667
end;
446
668
 
 
669
procedure TChartLegend.SetGroupFont(AValue: TFont);
 
670
begin
 
671
  FGroupFont.Assign(AValue);
 
672
  StyleChanged(Self);
 
673
end;
 
674
 
 
675
procedure TChartLegend.SetGroupTitles(AValue: TStrings);
 
676
begin
 
677
  FGroupTitles.Assign(AValue);
 
678
  StyleChanged(Self);
 
679
end;
 
680
 
 
681
procedure TChartLegend.SetItemFillOrder(AValue: TLegendItemFillOrder);
 
682
begin
 
683
  if FItemFillOrder = AValue then exit;
 
684
  FItemFillOrder := AValue;
 
685
  StyleChanged(Self);
 
686
end;
 
687
 
447
688
procedure TChartLegend.SetMargin(AValue: TChartDistance);
448
689
begin
449
690
  SetMarginX(AValue);
471
712
  StyleChanged(Self);
472
713
end;
473
714
 
 
715
procedure TChartLegend.SetSymbolFrame(AValue: TChartPen);
 
716
begin
 
717
  if FSymbolFrame = AValue then exit;
 
718
  FSymbolFrame := AValue;
 
719
  StyleChanged(Self);
 
720
end;
 
721
 
474
722
procedure TChartLegend.SetSymbolWidth(AValue: TChartDistance);
475
723
begin
476
724
  if FSymbolWidth = AValue then exit;
485
733
  StyleChanged(Self);
486
734
end;
487
735
 
 
736
procedure TChartLegend.SortItemsByOrder(AItems: TChartLegendItems);
 
737
var
 
738
  i: Integer;
 
739
  j: Integer = MaxInt;
 
740
begin
 
741
  for i := AItems.Count - 1 downto 0 do
 
742
    if AItems[i].Order = LEGEND_ITEM_ORDER_AS_ADDED then begin
 
743
      AItems[i].Order := j;
 
744
      j -= 1;
 
745
    end;
 
746
  AItems.Sort(@LegendItemCompare);
 
747
end;
 
748
 
488
749
{ TChartSeriesLegend }
489
750
 
490
751
procedure TChartSeriesLegend.Assign(Source: TPersistent);
493
754
    with TChartSeriesLegend(Source) do begin
494
755
      Self.FMultiplicity := FMultiplicity;
495
756
      Self.FOnDraw := FOnDraw;
496
 
      Self.FVisible := FVisible;
 
757
      Self.FUserItemsCount := FUserItemsCount;
497
758
    end;
498
759
 
499
760
  inherited Assign(Source);
502
763
constructor TChartSeriesLegend.Create(AOwner: TCustomChart);
503
764
begin
504
765
  inherited Create(AOwner);
 
766
  FGroupIndex := LEGEND_ITEM_NO_GROUP;
 
767
  FOrder := LEGEND_ITEM_ORDER_AS_ADDED;
505
768
  FVisible := true;
506
769
  FUserItemsCount := 1;
507
770
end;
508
771
 
 
772
procedure TChartSeriesLegend.InitItem(
 
773
  AItem: TLegendItem; AIndex: Integer; ALegend: TChartLegend);
 
774
begin
 
775
  if Assigned(OnCreate) then
 
776
    OnCreate(AItem, AIndex);
 
777
  if AItem.Font = nil then
 
778
    AItem.Font := ALegend.Font;
 
779
  if AItem.GroupIndex = LEGEND_ITEM_NO_GROUP then
 
780
    AItem.GroupIndex := GroupIndex;
 
781
  if AItem.Order = LEGEND_ITEM_ORDER_AS_ADDED then
 
782
    AItem.Order := Order;
 
783
end;
 
784
 
 
785
procedure TChartSeriesLegend.SetFormat(AValue: String);
 
786
begin
 
787
  if FFormat = AValue then exit;
 
788
  FFormat := AValue;
 
789
  StyleChanged(Self);
 
790
end;
 
791
 
 
792
procedure TChartSeriesLegend.SetGroupIndex(AValue: Integer);
 
793
begin
 
794
  if FGroupIndex = AValue then exit;
 
795
  FGroupIndex := AValue;
 
796
  StyleChanged(Self);
 
797
end;
 
798
 
509
799
procedure TChartSeriesLegend.SetMultiplicity(AValue: TLegendMultiplicity);
510
800
begin
511
801
  if FMultiplicity = AValue then exit;
520
810
  StyleChanged(Self);
521
811
end;
522
812
 
 
813
procedure TChartSeriesLegend.SetOnCreate(AValue: TLegendItemCreateEvent);
 
814
begin
 
815
  if TMethod(FOnCreate) = TMethod(AValue) then exit;
 
816
  FOnCreate := AValue;
 
817
  StyleChanged(Self);
 
818
end;
 
819
 
 
820
procedure TChartSeriesLegend.SetOrder(AValue: Integer);
 
821
begin
 
822
  if FOrder = AValue then exit;
 
823
  FOrder := AValue;
 
824
  StyleChanged(Self);
 
825
end;
 
826
 
523
827
procedure TChartSeriesLegend.SetUserItemsCount(AValue: Integer);
524
828
begin
525
829
  if FUserItemsCount = AValue then exit;