mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-26 22:03:48 +02:00
807 lines
23 KiB
ObjectPascal
807 lines
23 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Authors: Werner Pamler, Alexander Klenin
|
|
|
|
Usage:
|
|
- Add the ChartListbox to a form with a TChart
|
|
- Connect the chart to the listbox by setting the chart property of the
|
|
TChartlistbox. The ChartListbox will be populated with the series in the
|
|
chart and will automatically track changes of the series.
|
|
- Check/uncheck series in the ChartListbox to show/hide them in the chart.
|
|
As usual, checking is done by mouse clicks or by pressing the space bar.
|
|
- Play with the properties to modify the standard behavior, e.g. set
|
|
CheckStyle to cbsRadioButton in order to get a radiobutton behavior, i.e. to
|
|
allow only one visible series.
|
|
}
|
|
|
|
unit TAChartListbox;
|
|
|
|
{$MODE objfpc}{$H+}
|
|
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
|
|
|
|
{$IFDEF DARWIN}
|
|
{$DEFINE USE_BITMAPS}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Controls, SysUtils, Types, Math,
|
|
StdCtrls, Graphics, LCLIntf, LCLType, Themes,
|
|
IntegerList, LazUTF8,
|
|
TAChartUtils, TACustomSeries, TALegend, TAGraph,
|
|
TACustomSource, TADrawerCanvas, TADrawUtils, TAEnumerators, TAGeometry;
|
|
|
|
|
|
type
|
|
TChartListbox = class;
|
|
|
|
TChartListboxIndexEvent = procedure (
|
|
ASender: TObject; AIndex: Integer) of object;
|
|
|
|
TChartListboxAddSeriesEvent = procedure (
|
|
ASender: TChartListbox; ASeries: TCustomChartSeries;
|
|
AItems: TChartLegendItems; var ASkip: Boolean
|
|
) of object;
|
|
|
|
TCheckBoxesStyle = (cbsCheckbox, cbsRadiobutton);
|
|
|
|
TChartListOption = (cloShowCheckboxes, cloShowIcons, cloRefreshOnSourceChange);
|
|
TChartListOptions = set of TChartListOption;
|
|
|
|
const
|
|
SHOW_ALL = [cloShowCheckboxes, cloShowIcons];
|
|
|
|
type
|
|
TChartListbox = class(TCustomListbox)
|
|
private
|
|
FChart: TChart;
|
|
FCheckBoxSize: TSize;
|
|
FCheckStyle: TCheckBoxesStyle;
|
|
FDown: Boolean;
|
|
FHot: Boolean;
|
|
FLegendItems: TChartLegendItems;
|
|
FListener: TListener;
|
|
FOnAddSeries: TChartListboxAddSeriesEvent;
|
|
FOnCheckboxClick: TChartListboxIndexEvent;
|
|
FOnItemClick: TChartListboxIndexEvent;
|
|
FOnPopulate: TNotifyEvent;
|
|
FOnSeriesIconDblClick: TChartListboxIndexEvent;
|
|
FOptions: TChartListOptions;
|
|
FSeriesIconClicked: Integer;
|
|
function GetChecked(AIndex: Integer): Boolean;
|
|
function GetSeries(AIndex: Integer): TCustomChartSeries;
|
|
function GetSeriesCount: Integer;
|
|
procedure EnsureSingleChecked(AIndex: Integer = -1);
|
|
procedure SetChart(AValue: TChart);
|
|
procedure SetChecked(AIndex: Integer; AValue: Boolean);
|
|
procedure SetCheckStyle(AValue: TCheckBoxesStyle);
|
|
procedure SetOnAddSeries(AValue: TChartListboxAddSeriesEvent);
|
|
procedure SetOnPopulate(AValue: TNotifyEvent);
|
|
procedure SetOptions(AValue: TChartListOptions);
|
|
|
|
protected
|
|
procedure DblClick; override;
|
|
procedure DrawItem(
|
|
AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); override;
|
|
procedure KeyDown(var AKey: Word; AShift: TShiftState); override;
|
|
procedure MouseDown(AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); override;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
procedure MouseUp(AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); override;
|
|
protected
|
|
procedure CalcRects(
|
|
const AItemRect: TRect; out ACheckboxRect, ASeriesIconRect: TRect);
|
|
procedure ClickedCheckbox(AIndex: Integer); virtual;
|
|
procedure ClickedItem(AIndex: Integer); virtual;
|
|
procedure ClickedSeriesIcon(AIndex: Integer); virtual;
|
|
function CreateLegendItems: TChartLegendItems;
|
|
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
|
|
procedure SetBiDiMode(AValue: TBiDiMode); override;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ExchangeSeries(AIndex1, AIndex2: Integer);
|
|
function FindSeriesIndex(ASeries: TCustomChartSeries): Integer;
|
|
procedure MeasureItem(AIndex: Integer; var AHeight: Integer); override;
|
|
procedure Populate;
|
|
procedure RemoveSeries(ASeries: TCustomChartSeries);
|
|
procedure SeriesChanged(ASender: TObject);
|
|
procedure Sort(Descending: Boolean = false);
|
|
|
|
property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked;
|
|
property Series[AIndex: Integer]: TCustomChartSeries read GetSeries;
|
|
property SeriesCount: Integer read GetSeriesCount;
|
|
|
|
published
|
|
property Chart: TChart read FChart write SetChart;
|
|
property CheckStyle: TCheckBoxesStyle
|
|
read FCheckStyle write SetCheckStyle default cbsCheckbox;
|
|
property Options: TChartListOptions
|
|
read FOptions write SetOptions default SHOW_ALL;
|
|
published
|
|
property OnAddSeries: TChartListboxAddSeriesEvent
|
|
read FOnAddSeries write SetOnAddSeries;
|
|
property OnCheckboxClick: TChartListboxIndexEvent
|
|
read FOnCheckboxClick write FOnCheckboxClick;
|
|
property OnItemClick: TChartListboxIndexEvent
|
|
read FOnItemClick write FOnItemClick;
|
|
property OnPopulate: TNotifyEvent read FOnPopulate write SetOnPopulate;
|
|
property OnSeriesIconDblClick: TChartListboxIndexEvent
|
|
read FOnSeriesIconDblClick write FOnSeriesIconDblClick;
|
|
published
|
|
property Align;
|
|
// property AllowGrayed;
|
|
property Anchors;
|
|
property BidiMode;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property Color;
|
|
property Columns;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ExtendedSelect;
|
|
property Font;
|
|
property IntegralHeight;
|
|
// property Items;
|
|
property ItemHeight default 0;
|
|
property MultiSelect;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
// property OnClickCheck;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawItem;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
// property OnItemClick;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnShowHint;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
property ParentBidiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Sorted;
|
|
// property Style;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property TopIndex;
|
|
property Visible;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
|
|
implementation
|
|
|
|
type
|
|
TThemedStatesUsed = {%H-}tbRadioButtonUnCheckedNormal..tbCheckboxCheckedDisabled;
|
|
|
|
{$IFDEF USE_BITMAPS}
|
|
var
|
|
ThemedBitmaps: Array[TThemedStatesUsed] of TBitmap;
|
|
|
|
function CreateBitmap(AThemedButton: TThemedButton; ABkColor: TColor): TBitmap;
|
|
var
|
|
s: TSize;
|
|
details: TThemedElementDetails;
|
|
begin
|
|
Result := ThemedBitmaps[AThemedButton];
|
|
if Assigned(Result) and (Result.Canvas.Pixels[0, 0] = ABkColor) then
|
|
exit;
|
|
FreeAndNil(Result);
|
|
Result := TBitmap.Create;
|
|
details := ThemeServices.GetElementDetails(AThemedButton);
|
|
s := ThemeServices.GetDetailSize(details);
|
|
Result.SetSize(s.CX, s.CY);
|
|
Result.Canvas.Brush.Color := ABkColor;
|
|
Result.Canvas.FillRect(0, 0, Result.Width, Result.Height);
|
|
ThemeServices.DrawElement(Result.Canvas.Handle, details, Rect(0, 0, Result.Width, Result.Height));
|
|
ThemedBitmaps[AThemedButton] := Result;
|
|
end;
|
|
|
|
procedure InitBitmaps;
|
|
var
|
|
tb: TThemedButton;
|
|
begin
|
|
for tb in TThemedStatesUsed do
|
|
ThemedBitmaps[tb] := nil;
|
|
end;
|
|
|
|
procedure FreeBitmaps;
|
|
var
|
|
tb: TThemedButton;
|
|
begin
|
|
for tb in TThemedStatesUsed do
|
|
FreeAndNil(ThemedBitmaps[tb]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TChartListbox }
|
|
|
|
constructor TChartListbox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Style := lbOwnerDrawFixed;
|
|
FListener := TListener.Create(@FChart, @SeriesChanged);
|
|
FOptions := SHOW_ALL;
|
|
end;
|
|
|
|
destructor TChartListbox.Destroy;
|
|
begin
|
|
FreeAndNil(FListener);
|
|
FreeAndNil(FLegendItems);
|
|
inherited;
|
|
end;
|
|
|
|
{ Based on the rect of a listbox item, calculates the locations of the
|
|
checkbox and of the series icon }
|
|
procedure TChartListbox.CalcRects(
|
|
const AItemRect: TRect; out ACheckboxRect, ASeriesIconRect: TRect);
|
|
const
|
|
MARGIN = 4;
|
|
var
|
|
x, y, h: Integer;
|
|
isRTL: Boolean;
|
|
begin
|
|
ACheckBoxRect := ZeroRect;
|
|
ASeriesIconRect := ZeroRect;
|
|
isRTL := IsRightToLeft;
|
|
|
|
x := IfThen(isRTL, AItemRect.Right - MARGIN, AItemRect.Left + MARGIN);
|
|
|
|
if cloShowCheckboxes in Options then begin
|
|
ACheckBoxRect := Rect(0, 0, FCheckboxSize.CX, FCheckboxSize.CY);
|
|
if isRTL then dec(x, FCheckboxSize.CX);
|
|
OffsetRect(ACheckboxRect, x, (AItemRect.Top + AItemRect.Bottom - FCheckboxSize.CY) div 2);
|
|
if cloShowIcons in Options then
|
|
x := IfThen(isRTL, ACheckboxRect.Left - MARGIN, ACheckboxRect.Right + MARGIN);
|
|
end;
|
|
|
|
if cloShowIcons in Options then
|
|
begin
|
|
h := CalculateStandardItemHeight;
|
|
y := (AItemRect.Top + AItemRect.Bottom - h) div 2;
|
|
if isRTL then
|
|
ASeriesIconRect := Rect(x - FChart.Legend.SymbolWidth, y, x, y + h)
|
|
else
|
|
ASeriesIconRect := Rect(x, y, x + FChart.Legend.SymbolWidth, y + h);
|
|
end;
|
|
end;
|
|
|
|
procedure TChartListbox.ClickedCheckbox(AIndex: Integer);
|
|
begin
|
|
Checked[AIndex] := not Checked[AIndex];
|
|
if Assigned(OnCheckboxClick) then
|
|
OnCheckboxClick(Self, AIndex);
|
|
end;
|
|
|
|
procedure TChartListbox.ClickedItem(AIndex: Integer);
|
|
begin
|
|
if Assigned(OnItemClick) then
|
|
OnItemClick(Self, AIndex);
|
|
end;
|
|
|
|
procedure TChartListbox.ClickedSeriesIcon(AIndex: Integer);
|
|
begin
|
|
if Assigned(OnSeriesIconDblClick) then
|
|
OnSeriesIconDblClick(Self, AIndex);
|
|
end;
|
|
|
|
function TChartListbox.CreateLegendItems: TChartLegendItems;
|
|
{ Creates a TLegendItems list and populates it with information for
|
|
all series contained in the Chart. In case of MultiLegend items, only
|
|
a single legend item is used }
|
|
var
|
|
skip: Boolean;
|
|
s: TCustomChartSeries;
|
|
begin
|
|
Result := TChartLegendItems.Create;
|
|
try
|
|
if FChart = nil then exit;
|
|
for s in CustomSeries(Chart) do begin
|
|
if Assigned(OnAddSeries) then begin
|
|
skip := false;
|
|
FOnAddSeries(Self, s, Result, skip);
|
|
if skip then continue;
|
|
end;
|
|
s.GetSingleLegendItem(Result);
|
|
end;
|
|
except
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TChartListbox.DblClick;
|
|
begin
|
|
inherited DblClick;
|
|
if FSeriesIconClicked <> -1 then
|
|
ClickedSeriesIcon(FSeriesIconClicked);
|
|
end;
|
|
|
|
function GetThemedButtonOffset(Hot, Pressed, Disabled: Boolean): Integer;
|
|
begin
|
|
Result := 0;
|
|
if Disabled then
|
|
Result := 3
|
|
else if Hot then
|
|
Result := 1
|
|
else if Pressed then
|
|
Result := 2;
|
|
end;
|
|
|
|
{ Draws the listbox item }
|
|
procedure TChartListbox.DrawItem(
|
|
AIndex: Integer; ARect: TRect; AState: TOwnerDrawState);
|
|
const
|
|
THEMED_BASE: array [TCheckboxesStyle, Boolean] of TThemedButton = (
|
|
(tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal),
|
|
(tbRadioButtonUnCheckedNormal, tbRadioButtonCheckedNormal)
|
|
);
|
|
var
|
|
id: IChartDrawer;
|
|
rcb, ricon: TRect;
|
|
x, y, w: Integer;
|
|
tb: TThemedButton;
|
|
tbBase, tbOffs: Integer;
|
|
isRTL: Boolean;
|
|
{$IFDEF USE_BITMAPS}
|
|
bmp: TBitmap;
|
|
{$ELSE}
|
|
ted: TThemedElementDetails;
|
|
{$ENDIF}
|
|
begin
|
|
if Assigned(OnDrawItem) then begin
|
|
OnDrawItem(Self, AIndex, ARect, AState);
|
|
exit;
|
|
end;
|
|
|
|
if (FChart = nil) or not InRange(AIndex, 0, Count - 1) then
|
|
exit;
|
|
|
|
isRTL := IsRightToLeft;
|
|
|
|
Canvas.FillRect(ARect);
|
|
if cloShowCheckboxes in Options then begin
|
|
tbBase := ord(THEMED_BASE[FCheckStyle, Checked[AIndex]]);
|
|
tbOffs := GetThemedButtonOffset(FHot, FDown, false);
|
|
tb := TThemedButton(ord(tbBase) + tbOffs);
|
|
{$IFDEF USE_BITMAPS}
|
|
bmp := CreateBitmap(tb, Canvas.Brush.Color);
|
|
FCheckboxSize := Size(bmp.Width, bmp.Height);
|
|
{$ELSE}
|
|
ted := ThemeServices.GetElementDetails(tb);
|
|
FCheckboxSize := ThemeServices.GetDetailSize(ted);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
CalcRects(ARect, rcb, ricon);
|
|
|
|
if cloShowCheckboxes in Options then begin
|
|
{$IFDEF USE_BITMAPS}
|
|
Canvas.Draw(rcb.Left, rcb.Top, bmp);
|
|
{$ELSE}
|
|
ThemeServices.DrawElement(Canvas.Handle, ted, rcb);
|
|
{$ENDIF}
|
|
x := IfThen(isRTL, rcb.Left, rcb.Right);
|
|
end
|
|
else
|
|
x := IfThen(isRTL, ARect.Right, ARect.Left);
|
|
|
|
Canvas.Brush.Style := bsClear;
|
|
if cloShowIcons in Options then begin
|
|
id := TCanvasDrawer.Create(Canvas);
|
|
id.Pen := Chart.Legend.SymbolFrame;
|
|
id.SetRightToLeft(isRTL);
|
|
FLegendItems[AIndex].Draw(id, ricon);
|
|
end
|
|
else begin
|
|
y := (ARect.Top + ARect.Bottom - Canvas.TextHeight('Tg')) div 2;
|
|
if IsRightToLeft then begin
|
|
w := Canvas.TextWidth(FLegendItems.Items[AIndex].Text);
|
|
Canvas.TextOut(x - 2 - w, y, FLegendItems.Items[AIndex].Text);
|
|
end else
|
|
Canvas.TextOut(x + 2, y, FLegendItems.Items[AIndex].Text);
|
|
end;
|
|
end;
|
|
|
|
procedure TChartListbox.EnsureSingleChecked(AIndex: Integer);
|
|
var
|
|
i: Integer;
|
|
ser: TCustomChartSeries;
|
|
begin
|
|
if (FCheckStyle <> cbsRadioButton) or not (cloShowCheckboxes in Options) then
|
|
exit;
|
|
if FLegendItems = nil then
|
|
exit;
|
|
|
|
FListener.OnNotify := nil;
|
|
try
|
|
for i := 0 to FLegendItems.Count - 1 do begin
|
|
ser := GetSeries(i);
|
|
if ser = nil then continue;
|
|
if (AIndex < 0) and ser.Active then
|
|
AIndex := i
|
|
else
|
|
ser.Active := AIndex = i;
|
|
end;
|
|
finally
|
|
FListener.OnNotify := @SeriesChanged;
|
|
end;
|
|
end;
|
|
|
|
{ Exchanges the series at the specified listbox indices . }
|
|
procedure TChartListbox.ExchangeSeries(AIndex1, AIndex2: Integer);
|
|
var
|
|
serIndex1, serIndex2: Integer;
|
|
begin
|
|
FChart.DisableRedrawing;
|
|
serIndex1 := Series[AIndex1].Index;
|
|
serIndex2 := Series[AIndex2].Index;
|
|
Series[AIndex1].Index := serIndex2;
|
|
Series[AIndex2].Index := serIndex1;
|
|
Populate;
|
|
FChart.EnableRedrawing;
|
|
end;
|
|
|
|
function TChartListbox.FindSeriesIndex(ASeries: TCustomChartSeries): Integer;
|
|
{ searches the internal legend items list for the specified series }
|
|
begin
|
|
for Result := 0 to FLegendItems.Count - 1 do
|
|
if GetSeries(Result) = ASeries then exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TChartListbox.GetChecked(AIndex: Integer): Boolean;
|
|
{ report the checked status. This is determined by the visibility of the
|
|
series with the given index. }
|
|
var
|
|
ser: TBasicChartSeries;
|
|
begin
|
|
ser := GetSeries(AIndex);
|
|
Result := (ser <> nil) and ser.Active;
|
|
end;
|
|
|
|
function TChartListbox.GetSeries(AIndex: Integer): TCustomChartSeries;
|
|
{ extracts, for the given index, the series from the internal
|
|
legend items list. }
|
|
var
|
|
legitem: TLegendItem;
|
|
begin
|
|
legitem := FLegendItems[AIndex];
|
|
if (legitem <> nil) and (legitem.Owner is TCustomChartSeries) then
|
|
Result := TCustomChartSeries(legitem.Owner)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TChartListbox.GetSeriesCount : Integer;
|
|
{ determines the number of series displayed in the listbox.
|
|
Note that this may be different from the Chart.SeriesCount if
|
|
RemoveSeries has been called }
|
|
begin
|
|
Result := FLegendItems.Count;
|
|
end;
|
|
|
|
procedure TChartListbox.KeyDown(var AKey: Word; AShift: TShiftState);
|
|
{ allows checking/unchecking of items by means of pressing the space bar }
|
|
begin
|
|
if
|
|
(AKey = VK_SPACE) and (AShift = []) and
|
|
(cloShowCheckboxes in Options) and (ItemIndex >= 0)
|
|
then begin
|
|
ClickedCheckbox(ItemIndex);
|
|
AKey := VK_UNKNOWN;
|
|
end
|
|
else
|
|
inherited KeyDown(AKey, AShift);
|
|
end;
|
|
|
|
// Item height is determined as maximum of:
|
|
// checkbox height, text height, ItemHeight property value.
|
|
procedure TChartListbox.MeasureItem(AIndex: Integer; var AHeight: Integer);
|
|
var
|
|
hText: Integer;
|
|
begin
|
|
inherited MeasureItem(AIndex, AHeight);
|
|
hText := CalculateStandardItemHeight;
|
|
if Options * [cloShowIcons, cloShowCheckboxes] <> [] then
|
|
inc(hText, 4);
|
|
AHeight := Max(AHeight, hText);
|
|
if cloShowCheckboxes in Options then
|
|
AHeight := Max(AHeight, GetSystemMetrics(SM_CYMENUCHECK) + 2);
|
|
end;
|
|
|
|
{ standard MouseDown handler: checks if the click occurred on the checkbox,
|
|
on the series icon, or on the text.
|
|
The visibility state of the item's series is changed when clicking on the
|
|
checkbox, and an event OnCheckboxClick is generated.
|
|
An event OnSeriesIconClick is generated when double-clicking on the
|
|
series icon; the method stores the series list index here.
|
|
An event OnItemClick is generated when the click occurred neither on the
|
|
checkbox nor the series icon.
|
|
}
|
|
procedure TChartListbox.MouseDown(
|
|
AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer);
|
|
var
|
|
R, rcb, ricon: TRect;
|
|
index: Integer;
|
|
p: TPoint;
|
|
begin
|
|
FDown := true;
|
|
FSeriesIconClicked := -1;
|
|
try
|
|
if AButton <> mbLeft then exit;
|
|
p := Point(AX, AY);
|
|
index := GetIndexAtXY(AX, AY);
|
|
if index < 0 then exit;
|
|
R := ItemRect(index);
|
|
{$IFDEF DARWIN}
|
|
{ Workaround for ItemRect returning something different than what is
|
|
passed to DrawItem in macOS Monterey.
|
|
See discussion in https://forum.lazarus.freepascal.org/index.php/topic,61074.0.html
|
|
The consequence of this workaround is that there can only be a single
|
|
column, but Columns > 1 does not work on cocoa anyway. }
|
|
R.Left := 0;
|
|
R.Right := ClientWidth;
|
|
{$ENDIF}
|
|
CalcRects(R, rcb, ricon);
|
|
if (cloShowCheckboxes in Options) and IsPointInRect(p, rcb) then
|
|
ClickedCheckbox(index)
|
|
else if (cloShowIcons in Options) and IsPointInRect(p, ricon) then
|
|
// Remember clicked index for the double click event.
|
|
FSeriesIconClicked := index
|
|
else
|
|
ClickedItem(index);
|
|
finally
|
|
inherited MouseDown(AButton, AShift, AX, AY);
|
|
end;
|
|
end;
|
|
|
|
procedure TChartListbox.MouseEnter;
|
|
begin
|
|
FHot := true;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TChartListbox.MouseLeave;
|
|
begin
|
|
FHot := false;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TChartListBox.MouseUp(
|
|
AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer);
|
|
begin
|
|
FDown := false;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TChartListbox.Notification(AComponent: TComponent; AOperation: TOperation);
|
|
begin
|
|
if (AOperation = opRemove) and (AComponent = FChart) then
|
|
FChart := nil;
|
|
inherited Notification(AComponent, AOperation);
|
|
end;
|
|
|
|
procedure TChartListbox.Populate;
|
|
{ Populates the listbox with all series contained in the chart. Use the event
|
|
OnPopulate if you don't omit special series from the listbox (RemoveSeries) }
|
|
var
|
|
li: TLegendItem;
|
|
list: TIntegerList;
|
|
i, idx: Integer;
|
|
begin
|
|
if (csDestroying in ComponentState) then
|
|
exit;
|
|
|
|
Items.BeginUpdate;
|
|
list := TIntegerList.Create;
|
|
try
|
|
// In case of multiselect, the selected items would get lost here.
|
|
// Store series belonging to selected items in temporary list
|
|
for i:=0 to Items.Count-1 do
|
|
if Selected[i] then
|
|
list.Add(i);
|
|
|
|
Items.Clear;
|
|
if (FChart = nil) or (FChart.Series = nil) then exit;
|
|
FreeAndNil(FLegendItems);
|
|
FLegendItems := CreateLegendItems;
|
|
Chart.Legend.SortItemsByOrder(FLegendItems);
|
|
for li in FLegendItems do begin
|
|
// The caption is owner-drawn, but add it anyway for user convenience.
|
|
idx := Items.AddObject(li.Text, li);
|
|
// Restore selected state from temporary list
|
|
if (li.Owner is TCustomChartSeries) and (list.IndexOf(idx) <> -1) then
|
|
Selected[idx] := true;
|
|
end;
|
|
if Assigned(OnPopulate) then
|
|
OnPopulate(Self);
|
|
finally
|
|
list.Free;
|
|
Items.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TChartListbox.RemoveSeries(ASeries: TCustomChartSeries);
|
|
{ removes the series from the listbox, but keeps it in the chart }
|
|
var
|
|
index: Integer;
|
|
begin
|
|
index := FindSeriesIndex(ASeries);
|
|
if index = -1 then exit;
|
|
FLegendItems.Delete(index);
|
|
Items.Delete(index);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TChartListbox.SeriesChanged(ASender: TObject);
|
|
{ Notification procedure of the listener. Responds to chart broadcasts
|
|
by populating the listbox with the chart's series }
|
|
begin
|
|
if
|
|
(ASender is TCustomChartSource) and
|
|
not (cloRefreshOnSourceChange in Options)
|
|
then
|
|
exit;
|
|
Populate;
|
|
{ in case of radiobutton mode, it is necessary to uncheck the other
|
|
series; there can be only one active series in this mode }
|
|
if
|
|
(ASender is TCustomChartSeries) and TCustomChartSeries(ASender).Active
|
|
then
|
|
EnsureSingleChecked(FindSeriesIndex(TCustomChartSeries(ASender)))
|
|
else
|
|
EnsureSingleChecked;
|
|
end;
|
|
|
|
procedure TChartListbox.SetBiDiMode(AValue: TBiDiMode);
|
|
begin
|
|
inherited SetBiDiMode(AValue);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TChartListbox.SetChart(AValue: TChart);
|
|
{ connects the ListBox to the chart }
|
|
begin
|
|
if FChart = AValue then exit;
|
|
|
|
if FListener.IsListening then
|
|
FChart.Broadcaster.Unsubscribe(FListener);
|
|
FChart := AValue;
|
|
if FChart <> nil then
|
|
FChart.Broadcaster.Subscribe(FListener);
|
|
SeriesChanged(Self);
|
|
end;
|
|
|
|
procedure TChartListbox.SetChecked(AIndex: Integer; AValue: Boolean);
|
|
{ shows/hides the series with the specified index of its listbox item.
|
|
In case of radiobutton style, all other series are hidden if AValue=true }
|
|
var
|
|
ser: TCustomChartSeries;
|
|
begin
|
|
ser := GetSeries(AIndex);
|
|
if (ser = nil) or (ser.Active = AValue) then exit;
|
|
// Do not listen to this change since we know what changed.
|
|
FListener.OnNotify := nil;
|
|
try
|
|
ser.Active := AValue;
|
|
finally
|
|
FListener.OnNotify := @SeriesChanged;
|
|
end;
|
|
if AValue then
|
|
EnsureSingleChecked(FindSeriesIndex(ser));
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TChartListbox.SetCheckStyle(AValue: TCheckBoxesStyle);
|
|
{ selects "checkbox" or "radiobutton" styles. In radiobutton mode, only
|
|
one series can be visible }
|
|
begin
|
|
if FCheckStyle = AValue then exit;
|
|
FCheckStyle := AValue;
|
|
EnsureSingleChecked;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TChartListbox.SetOnAddSeries(AValue: TChartListboxAddSeriesEvent);
|
|
begin
|
|
if TMethod(FOnAddSeries) = TMethod(AValue) then exit;
|
|
FOnAddSeries := AValue;
|
|
Populate;
|
|
end;
|
|
|
|
procedure TChartListbox.SetOnPopulate(AValue: TNotifyEvent);
|
|
begin
|
|
if TMethod(FOnPopulate) = TMethod(AValue) then exit;
|
|
FOnPopulate := AValue;
|
|
Populate;
|
|
end;
|
|
|
|
procedure TChartListbox.SetOptions(AValue: TChartListOptions);
|
|
begin
|
|
if FOptions = AValue then exit;
|
|
FOptions := AValue;
|
|
EnsureSingleChecked;
|
|
RecreateWnd(Self);
|
|
Invalidate;
|
|
end;
|
|
|
|
{ Sorts the listbox by the series names in ascending or descending order.
|
|
Note that only series with Legend.Order = -1 are considered, i.e.
|
|
series having a given legend position are ignored. }
|
|
procedure TChartListbox.Sort(Descending: Boolean = false);
|
|
var
|
|
list: TStringListUTF8Fast;
|
|
ser: TCustomChartSeries;
|
|
i: Integer;
|
|
selSeries: TCustomChartSeries = nil;
|
|
begin
|
|
if ItemIndex > -1 then
|
|
selSeries := Series[ItemIndex];
|
|
|
|
list := TStringListUTF8Fast.Create;
|
|
try
|
|
for ser in CustomSeries(FChart) do
|
|
list.AddObject(ser.Title, ser);
|
|
list.Sort;
|
|
|
|
FChart.DisableRedrawing;
|
|
try
|
|
for i := 0 to list.Count-1 do
|
|
begin
|
|
ser := TCustomChartSeries(list.Objects[i]);
|
|
ser.Index := IfThen(Descending, list.Count - 1 - i, i);
|
|
end;
|
|
Populate;
|
|
if selSeries <> nil then ItemIndex := FindSeriesIndex(selSeries);
|
|
finally
|
|
FChart.EnableRedrawing;
|
|
end;
|
|
finally
|
|
list.Free;
|
|
end
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(CHART_COMPONENT_IDE_PAGE, [TChartListbox]);
|
|
end;
|
|
|
|
{$IFDEF USE_BITMAPS}
|
|
initialization
|
|
InitBitmaps;
|
|
|
|
finalization
|
|
FreeBitmaps;
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|