File: tachartimagelist.pas

package info (click to toggle)
lazarus 4.0%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 275,760 kB
  • sloc: pascal: 2,341,904; xml: 509,420; makefile: 348,726; cpp: 93,608; sh: 3,387; java: 609; perl: 297; sql: 222; ansic: 137
file content (246 lines) | stat: -rw-r--r-- 6,360 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
{

 *****************************************************************************
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

  An ImageList with TCustomChartSeries icons

  Authors: Werner Pamler, Alexander Klenin

  Notes:
  - The image list can be used like any other image list.
  - Assigning the Chart property to a TChart adds the series icons of all
    series to the image list. Series created at run-time will be added automatically
    to the end of the list.
  - Make sure to populate toolbar icons etc. before assigning the chart since the
    series images are added to the end of the list; otherwise image indices of
    these icons will change.
}

unit TAChartImageList;

{$MODE ObjFPC}{$H+}

interface

uses
  LCLIntf, Classes, Graphics, Controls,
  TAChartUtils, TACustomSeries, TAGraph;

type
  TChartImageList = class(TImageList)
  private
    FChart: TChart;
    FChartPending: Boolean;
    FFirstSeriesIndex: Integer;
    FListener: TListener;
    FOnPopulate: TNotifyEvent;
    FSeriesCount: Integer;
    procedure SetChart(AValue: TChart);
  protected
    procedure ClearAllSeries;
    procedure Loaded; override;
    procedure Populate;
  public
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetSeries(AImgIndex: Integer): TCustomChartSeries;
    function ImageIndexOfSeries(ASeries: TCustomChartSeries): Integer;
    procedure SeriesChanged(ASender: TObject);
    property FirstSeriesIndex: Integer read FFirstSeriesIndex;
    property SeriesCount: Integer read FSeriesCount;
  published
    property Chart: TChart read FChart write SetChart;
    property OnPopulate: TNotifyEvent read FOnPopulate write FOnPopulate;
  end;

procedure Register;

implementation

uses
  Math, SysUtils, ImgList,
  TADrawUtils, TADrawerCanvas, TAEnumerators, TALegend;


procedure Register;
begin
  RegisterComponents(CHART_COMPONENT_IDE_PAGE, [TChartImageList]);
end;


{ TChartImageList }

procedure TChartImageList.ClearAllSeries;
var
  i: Integer;
begin
  if FFirstSeriesIndex < 0 then exit;
  for i := FFirstSeriesIndex + FSeriesCount - 1 downto FFirstSeriesIndex do
    Delete(i);
  FFirstSeriesIndex := -1;
  FSeriesCount := 0;
end;

constructor TChartImageList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FListener := TListener.Create(@FChart, @SeriesChanged);
  FFirstSeriesIndex := -1;
  FSeriesCount := 0;
end;

destructor TChartImageList.Destroy;
begin
  FreeAndNil(FListener);
  inherited Destroy;
end;

{ We don't want to write the series images to stream.
  They will be recreated automatically when the chart is assigned on loading. }
procedure TChartImageList.DefineProperties(Filer: TFiler);
var
  ch: TChart;
begin
  ch := FChart;
  SetChart(nil);  // This removes the series images
  inherited;
  SetChart(ch);
end;

function TChartImageList.GetSeries(AImgIndex: Integer): TCustomChartSeries;
begin
  Result := nil;
  AImgIndex -= FFirstSeriesIndex;
  if
    (FFirstSeriesIndex > -1) and (FChart <> nil) and
    InRange(AImgIndex, 0, FSeriesCount - 1)
  then
    Result := FChart.Series[AImgIndex] as TCustomChartSeries;
end;

function TChartImageList.ImageIndexOfSeries(ASeries: TCustomChartSeries): Integer;
begin
  Result := -1;
  if ASeries = nil then exit;
  for Result := 0 to Count - 1 do
    if GetSeries(Result) = ASeries then exit;
end;

procedure TChartImageList.Loaded;
var
  ch: TChart;
begin
  inherited;
  if FChartPending then
  begin
    ch := FChart;
    FChart := nil;
    SetChart(ch);
    FChartPending := false;
  end;
end;

procedure TChartImageList.Populate;
var
  legendItems: TChartLegendItems = nil;
  res: TCustomImageListResolution;
  bmp: array of TCustomBitmap = nil;
  r: TRect;
  s: TCustomChartSeries;
  id: IChartDrawer;
  li: TLegendItem;
  i, n, idx: Integer;
begin
  ClearAllSeries;
  if FChart = nil then exit;

  FFirstSeriesIndex := Count;
  FSeriesCount := 0;

  legendItems := TChartLegendItems.Create;
  try
    for s in CustomSeries(FChart) do
      s.GetSingleLegendItem(legendItems);
    if ResolutionCount = 0 then
      n := 1
    else
      n := ResolutionCount;
    SetLength(bmp, n);
    for i := 0 to n-1 do
      bmp[i] := TBitmap.Create;
    try
      for li in legendItems do
      begin
        for i := 0 to n-1 do
        begin
          if ResolutionCount = 0 then
            r := Rect(0, 0, Width, Height)
          else
          begin
            res := ResolutionByIndex[i];
            r := Rect(0, 0, res.Width, res.Height);
          end;
          id := TCanvasDrawer.Create(bmp[i].Canvas);
          id.Pen := FChart.Legend.SymbolFrame;
          bmp[i].SetSize(r.Width, r.Height);
          bmp[i].Canvas.Brush.Style := bsSolid;
          bmp[i].Canvas.Brush.Color := BkColor;
          bmp[i].Canvas.Pen.Style := psSolid;
          bmp[i].Canvas.Pen.Width := 1;
          bmp[i].Transparent := true;
          bmp[i].TransparentMode := tmAuto;
          bmp[i].Canvas.FillRect(r);
          InflateRect(r, -1, -1);
          li.Draw(id, r);
        end;
        idx := AddMasked(TBitmap(bmp[0]), bmp[0].TransparentColor);
        for i := 1 to n-1 do
          ReplaceMasked(idx, bmp[i], bmp[i].TransparentColor, false);
        inc(FSeriesCount);
      end;
      if Assigned(FOnPopulate) then FOnPopulate(self);
    finally
      for i := 0 to high(bmp) do
        bmp[i].Free;
    end;
  finally
    legendItems.Free;
  end;
end;

// Notification procedure of the listener. Responds to chart broadcasts
// by populating the imagelist with the chart's series icons.
procedure TChartImageList.SeriesChanged(ASender:TObject);
begin
  Unused(ASender);
  Populate;
end;

procedure TChartImageList.SetChart(AValue:TChart);
begin
  if FChart = AValue then exit;
  if csLoading in ComponentState then
  begin
    // During lfm reading wait with assigning the chart until the static images
    // have been loaded.
    FChart := AValue;
    FChartPending := true;
    exit;
  end;

  if FListener.IsListening then
    FChart.Broadcaster.Unsubscribe(FListener);
  FChart := AValue;
  if FChart <> nil then
    FChart.Broadcaster.Subscribe(FListener);

  SeriesChanged(Self);
end;

end.