{ /*************************************************************************** TAChartListbox.pas ------------------ Component Library Standard Graph Listbox ***************************************************************************/ ***************************************************************************** * * * See the file COPYING.modifiedLGPL.txt, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** 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 und 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+} interface uses Classes, Controls, SysUtils, LCLType, StdCtrls, TAChartUtils, TACustomSeries, TALegend, TAGraph; type TChartListboxIndexEvent = procedure(Sender:TObject; Index:integer) of object; TCheckBoxesStyle = (cbsCheckbox, cbsRadiobutton); TChartListbox = class(TCustomListbox) private FChart : TChart; FListener : TListener; FLegendItems : TChartLegendItems; FShowSeriesIcons : boolean; FShowCheckboxes : boolean; FCheckStyle : TCheckBoxesStyle; FLockCount : integer; FSeriesIconClicked : integer; FOnCheckboxClick : TChartListboxIndexEvent; FOnSeriesIconClick : TChartListboxIndexEvent; FOnItemClick : TChartListboxIndexEvent; FOnPopulate : TNotifyEvent; function GetChecked(AIndex:integer) : boolean; function GetLegendItem(AIndex:integer) : TLegendItem; function GetSeries(AIndex:integer) : TCustomChartSeries; function GetSeriesCount : integer; procedure SeriesChanged(ASender:TObject); procedure SetChart(AValue:TChart); procedure SetChecked(AIndex:integer; AValue:boolean); procedure SetCheckStyle(AValue:TCheckBoxesStyle); procedure SetShowCheckboxes(AValue:boolean); procedure SetShowSeriesIcons(AValue:boolean); protected procedure CalcRects(const AItemRect:TRect; out CheckboxRect,SeriesIconRect: TRect); procedure ClickedCheckbox(AIndex:integer); virtual; procedure ClickedItem(AIndex:integer); virtual; procedure ClickedSeriesIcon(AIndex:integer); virtual; function CreateLegendItems : TChartLegendItems; procedure DblClick; override; procedure DrawItem(Index: Integer; ARect: TRect; AState: TOwnerDrawState); override; function FirstCheckedIndex : integer; function IsLocked : boolean; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Lock; procedure MouseDown(AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); override; procedure Notification(AComponent: TComponent; AOperation: TOperation); override; procedure Populate; procedure Unlock; public constructor Create(AOwner:TComponent); override; destructor Destroy; override; function FindSeriesIndex(ASeries:TCustomChartSeries) : integer; procedure MeasureItem(Index: Integer; var AHeight: Integer); override; procedure RemoveSeries(ASeries:TCustomChartSeries); 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 ShowCheckboxes : boolean read FShowCheckboxes write SetShowCheckboxes default true; property ShowSeriesIcons : boolean read FShowSeriesIcons write SetShowSeriesIcons default true; property OnCheckboxClick : TChartListboxIndexEvent read FOnCheckboxClick write FOnCheckboxClick; property OnItemClick : TChartListboxIndexEvent read FOnItemClick write FOnItemClick; property OnSeriesIconClick : TChartListboxIndexEvent read FOnSeriesIconClick write FOnSeriesIconClick; property OnPopulate : TNotifyEvent read FOnPopulate write FOnPopulate; property Align; // property AllowGrayed; property Anchors; property BidiMode; property BorderSpacing; property BorderStyle; property Color; property Columns; property Constraints; property DragCursor; property DragMode; property ExtendedSelect; property Enabled; property Font; property IntegralHeight; // property Items; property ItemHeight; property MultiSelect; property OnChangeBounds; property OnClick; // property OnClickCheck; property OnContextPopup; property OnDblClick; property OnDrawItem; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; // property OnItemClick; property OnKeyPress; property OnKeyDown; property OnKeyUp; property OnMouseMove; property OnMouseDown; property OnMouseUp; property OnMouseEnter; property OnMouseLeave; 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 uses math, LCLIntf, Themes, TAGeometry, TADrawUtils, TADrawerCanvas; procedure Register; begin RegisterComponents(CHART_COMPONENT_IDE_PAGE, [TChartListbox]); end; constructor TChartListbox.Create(AOwner:TComponent); begin inherited Create(AOwner); Style := lbOwnerDrawFixed; FListener := TListener.Create(@FChart, @SeriesChanged); FShowSeriesIcons := true; FShowCheckboxes := true; end; destructor TChartListbox.Destroy; begin FreeAndNil(FListener); FreeAndNil(FLegendItems); inherited Destroy; end; procedure TChartListbox.CalcRects(const AItemRect:TRect; out CheckboxRect,SeriesIconRect: TRect); { based on the rect of a listbox item, calculates the locations of the checkbox and of the series icon } var w, x: integer; begin CheckBoxRect := Rect(-1, -1, -1, -1); SeriesIconRect := Rect(-1, -1, -1, -1); w := GetSystemMetrics(SM_CYMENUCHECK); x := 2; if FShowCheckboxes then begin CheckboxRect := Bounds(AItemRect.Left+1, AItemRect.Top+1, w, w); if FShowSeriesIcons then inc(x, CheckboxRect.Right); end else begin if FShowSeriesIcons then inc(x, AItemRect.Left); end; if FShowSeriesIcons then SeriesIconRect := Rect(x, AItemRect.Top+2, x+FChart.Legend.SymbolWidth, AItemRect.Bottom-2); 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(OnSeriesIconClick) then OnSeriesIconClick(self, AIndex); end; function TChartListbox.CreateLegendItems : TChartLegendItems; { creates the 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 i : integer; j : integer = MaxInt; begin result := TChartLegendItems.Create; try if FChart <> nil then for i:=0 to FChart.SeriesCount-1 do begin if (FChart.Series[i] is TCustomChartSeries) then begin TCustomChartSeries(FChart.Series[i]).GetSingleLegendItem(result); result[i].Owner := FChart.Series[i]; end; end; for i := Result.Count - 1 downto 0 do if Result[i].Order = LEGEND_ITEM_ORDER_AS_ADDED then begin Result[i].Order := j; j -= 1; end; except FreeAndNil(Result); raise; end; end; procedure TChartListbox.DblClick; begin inherited DblClick; if (FSeriesIconClicked <> -1) then ClickedSeriesIcon(FSeriesIconClicked); end; procedure TChartListbox.DrawItem(Index: Integer; ARect: TRect; AState: TOwnerDrawState); { draws the listbox item } const IsChecked : array[TCheckboxesStyle, Boolean] of integer = ( (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED), (DFCS_BUTTONRADIO, DFCS_BUTTONRADIO or DFCS_CHECKED) ); var id : IChartDrawer; Rcb, Ricon: TRect; te : TThemedElementDetails; x : integer; begin Unused(AState); if FChart = nil then exit; CalcRects(ARect, Rcb, Ricon); if FShowCheckboxes then begin if ThemeServices.ThemesEnabled then begin case FCheckStyle of cbsCheckbox : if Checked[Index] then te := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal) else te := ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal); cbsRadioButton : if Checked[Index] then te := ThemeServices.GetElementDetails(tbRadioButtonCheckedNormal) else te := ThemeServices.GetElementDetails(tbRadioButtonUnCheckedNormal); end; ThemeServices.DrawElement(Canvas.Handle, te, Rcb); end else DrawFrameControl(Canvas.Handle, Rcb, DFC_BUTTON, IsChecked[FCheckStyle, Checked[Index]]); x := Rcb.Right; end else x := ARect.Left; if FShowSeriesIcons then begin id := TCanvasDrawer.Create(Canvas); id.Pen := Chart.Legend.SymbolFrame; FLegendItems[Index].Draw(id, Ricon); end else Canvas.TextOut(x+2, ARect.Top, FLegendItems.Items[Index].Text); end; function TChartListbox.FindSeriesIndex(ASeries:TCustomChartSeries) : integer; { searches the internal legend items list for the specified series } var i : integer; ser : TBasicChartSeries; begin for i:=0 to FLegendItems.Count-1 do begin ser := GetSeries(i); if ser = ASeries then begin result := i; exit; end; end; result := -1; end; function TChartListbox.FirstCheckedIndex : integer; { Returns the index of the first listbox series that is active } var i : integer; begin for i:=0 to FLegendItems.Count-1 do if Checked[i] then begin result := i; exit; end; 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.Active; end; function TChartListbox.GetLegendItem(AIndex:integer) : TLegendItem; begin result := FLegendItems[AIndex]; 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 := GetLegendItem(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; function TChartListbox.IsLocked : boolean; begin result := FLockCount <> 0; end; procedure TChartListBox.KeyDown(var Key: Word; Shift: TShiftState); { allows checking/unchecking of items by means of pressing the space bar } begin if (Key = VK_SPACE) and (Shift=[]) and FShowCheckboxes then begin ClickedCheckbox(ItemIndex); Key := VK_UNKNOWN; end else inherited KeyDown(Key,Shift); end; procedure TChartListBox.Lock; { locking mechanism to avoid excessive broadcasting of chart changes. See also: IsLocked and UnLock } begin inc(FLockCount); end; procedure TChartListBox.MeasureItem(Index: Integer; var AHeight: Integer); { inherited from ancestor: measures the height of a listbox item taking into account the height of the checkbox } begin Unused(Index); AHeight := CalculateStandardItemHeight; if FShowCheckboxes then AHeight := Max(AHeight, GetSystemMetrics(SM_CYMENUCHECK) + 2); end; procedure TChartListbox.MouseDown(AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); { standard MouseDown handler: checks if the click occured 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 occured neither on the checkbox nor the series icon. } var Rcb, Ricon : TRect; index : integer; P : TPoint; done : boolean; begin if (AButton = mbLeft) then begin P := Point(AX, AY); index := GetIndexAtXY(AX, AY); CalcRects(ItemRect(index), Rcb, Ricon); FSeriesIconClicked := -1; done := false; if FShowCheckboxes and IsPointInRect(P, Rcb) then begin ClickedCheckbox(index); done := true; end; if FShowSeriesIcons and PtInRect(Ricon, P) then begin FSeriesIconClicked := index; // remember the clicked index for the double click event done := true; end; if not done then ClickedItem(index); end; inherited MouseDown(AButton, AShift, AX, AY); end; procedure TChartListbox.Notification(AComponent: TComponent; AOperation: TOperation); { avoids AV if Chart is deleted from its container form } begin if (AOperation = opRemove) and (AComponent = FChart) then SetChart(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 i : integer; begin try Items.BeginUpdate; Items.Clear; if FChart <> nil then begin FreeAndNil(FLegendItems); FLegendItems := CreateLegendItems; for i:=0 to FLegendItems.Count-1 do Items.Add(''); // the caption is owner-drawn using info from the FLegendItems // --> no need to pass the text here if Assigned(OnPopulate) then OnPopulate(self); end; finally 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 begin FLegendItems.Delete(index); Items.Delete(index); Invalidate; end; end; procedure TChartListbox.SeriesChanged(ASender:TObject); { Notification procedure of the listener. Responds to chart broadcasts by populating the listbox with the chart's series } var index : integer; begin if not IsLocked then begin 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 (FCheckStyle = cbsRadioButton) and (ASender is TBasicChartSeries) then begin index := FindSeriesIndex(ASender as TCustomChartSeries); if (index <> -1) then Checked[index] := (ASender as TCustomChartSeries).Active; end; end; 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(nil); 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 : TBasicChartSeries; i : integer; begin ser := GetSeries(AIndex); if ser <> nil then begin Lock; try ser.Active := AValue; if AValue and (FCheckStyle = cbsRadioButton) then for i:=0 to FLegendItems.Count-1 do begin ser := GetSeries(i); if (i <> AIndex) and (ser <> nil) then ser.Active := false; end; Invalidate; finally Unlock; end; end; end; procedure TChartlistbox.SetCheckStyle(AValue:TCheckBoxesStyle); { selects "checkbox" or "radiobutton" styles. In radiobutton mode, only one series can be visible } var j : integer; begin if AValue <> FCheckStyle then begin if AValue = cbsRadioButton then j := FirstCheckedIndex else j := -1; FCheckStyle := AValue; if (FCheckStyle = cbsRadioButton) and (j <> -1) then Checked[j] := true; Invalidate; end; end; procedure TChartListbox.SetShowCheckboxes(AValue:boolean); begin if AValue <> FShowCheckboxes then begin FShowCheckboxes := AValue; Invalidate; end; end; procedure TChartListbox.SetShowSeriesIcons(AValue:boolean); begin if AValue <> FShowSeriesIcons then begin FShowSeriesIcons := AValue; Invalidate; end; end; procedure TChartListbox.Unlock; begin dec(FLockCount); end; end.