diff --git a/components/tachart/demo/combobox/main.lfm b/components/tachart/demo/combobox/main.lfm index 570bd377d9..8693d571a6 100644 --- a/components/tachart/demo/combobox/main.lfm +++ b/components/tachart/demo/combobox/main.lfm @@ -48,7 +48,11 @@ object Form1: TForm1 Title = 'Line' ZPosition = 1 LinePen.Color = clBlue + LinePen.Width = 2 Pointer.Brush.Color = clSkyBlue + Pointer.HorizSize = 5 + Pointer.Style = psCircle + Pointer.VertSize = 5 ShowPoints = True Source = RandomChartSource1 end @@ -144,7 +148,7 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 1 - OnChange = CbLineSerLinePenStyleChange + OnChange = LinePenChange end object CbLineSerLinePenWidth: TChartComboBox AnchorSideLeft.Control = CbLineSerLinePenStyle @@ -165,7 +169,7 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 2 - OnChange = CbLineSerLinePenWidthChange + OnChange = LinePenChange end object Label1: TLabel AnchorSideLeft.Control = GbLineSerLines @@ -192,7 +196,7 @@ object Form1: TForm1 ParentColor = False ParentFont = False end - object CbLineSerPenColor: TColorBox + object CbLineSerLinePenColor: TColorBox AnchorSideLeft.Control = CbLineSerLinePenWidth AnchorSideTop.Control = CbLineSerLinePenWidth AnchorSideTop.Side = asrBottom @@ -208,13 +212,13 @@ object Form1: TForm1 BorderSpacing.Top = 8 BorderSpacing.Bottom = 10 ItemHeight = 16 - OnChange = CbLineSerPenColorChange + OnChange = LinePenChange ParentFont = False TabOrder = 3 end object Label4: TLabel AnchorSideLeft.Control = Label1 - AnchorSideTop.Control = CbLineSerPenColor + AnchorSideTop.Control = CbLineSerLinePenColor AnchorSideTop.Side = asrCenter Left = 8 Height = 15 @@ -234,7 +238,7 @@ object Form1: TForm1 Anchors = [] Caption = 'Show' Checked = True - OnChange = CbShowLinesChange + OnChange = LinePenChange ParentFont = False State = cbChecked TabOrder = 0 @@ -272,7 +276,7 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 1 - OnChange = CbLineSerPointerStyleChange + OnChange = LinePointerChange end object Label5: TLabel AnchorSideLeft.Control = GbLineSerPointer @@ -326,7 +330,7 @@ object Form1: TForm1 Anchors = [akTop, akRight] BorderSpacing.Top = 8 ItemHeight = 16 - OnChange = CbLineSerPointerBorderColorChange + OnChange = LinePointerChange ParentFont = False TabOrder = 3 end @@ -344,7 +348,7 @@ object Form1: TForm1 Anchors = [akTop, akRight] BorderSpacing.Top = 8 ItemHeight = 16 - OnChange = CbLineSerPointerBrushColorChange + OnChange = LinePointerChange ParentFont = False TabOrder = 2 end @@ -360,7 +364,7 @@ object Form1: TForm1 Alignment = taRightJustify BorderSpacing.Top = 8 BorderSpacing.Bottom = 10 - OnChange = EdLineSerPointerSizeChange + OnChange = LinePointerChange ParentFont = False TabOrder = 4 Value = 4 @@ -387,7 +391,7 @@ object Form1: TForm1 Anchors = [] Caption = 'Show' Checked = True - OnChange = CbShowPointsChange + OnChange = LinePointerChange ParentFont = False State = cbChecked TabOrder = 0 @@ -424,7 +428,7 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 0 - OnChange = CbBarSerPenStyleChange + OnChange = BarPenChange end object CbBarSerPenWidth: TChartComboBox AnchorSideTop.Control = CbBarSerPenStyle @@ -443,7 +447,7 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 1 - OnChange = CbBarSerPenWidthChange + OnChange = BarPenChange end object Label8: TLabel AnchorSideLeft.Control = GbBarSerPen @@ -484,7 +488,7 @@ object Form1: TForm1 BorderSpacing.Top = 8 BorderSpacing.Bottom = 10 ItemHeight = 16 - OnChange = CbBarSerPenColorChange + OnChange = BarPenChange ParentFont = False TabOrder = 2 end @@ -543,7 +547,7 @@ object Form1: TForm1 BorderSpacing.Top = 8 BorderSpacing.Bottom = 10 ItemHeight = 16 - OnChange = CbBarSerBrushColorChange + OnChange = BarBrushChange ParentFont = False TabOrder = 1 end @@ -574,12 +578,12 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 0 - OnChange = CbBarSerBrushStyleChange + OnChange = BarBrushChange end end end object Page3: TPage - object GbBarSerBrush1: TGroupBox + object GbAreaSerBrush: TGroupBox Left = 0 Height = 82 Top = 4 @@ -595,7 +599,7 @@ object Form1: TForm1 ParentFont = False TabOrder = 0 object Label13: TLabel - AnchorSideLeft.Control = GbBarSerBrush1 + AnchorSideLeft.Control = GbAreaSerBrush AnchorSideTop.Control = CbAreaSerBrushColor AnchorSideTop.Side = asrCenter Left = 8 @@ -620,7 +624,7 @@ object Form1: TForm1 BorderSpacing.Top = 8 BorderSpacing.Bottom = 10 ItemHeight = 16 - OnChange = CbAreaSerBrushColorChange + OnChange = AreaBrushChange ParentFont = False TabOrder = 1 end @@ -637,7 +641,7 @@ object Form1: TForm1 ParentFont = False end object CbAreaSerBrushStyle: TChartComboBox - AnchorSideTop.Control = GbBarSerBrush1 + AnchorSideTop.Control = GbAreaSerBrush AnchorSideRight.Side = asrBottom Left = 80 Height = 22 @@ -651,10 +655,10 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 0 - OnChange = CbAreaSerBrushStyleChange + OnChange = AreaBrushChange end end - object GbBarSerPen1: TGroupBox + object GbAreaSerContour: TGroupBox Left = 0 Height = 112 Top = 94 @@ -670,7 +674,7 @@ object Form1: TForm1 ParentFont = False TabOrder = 1 object CbAreaSerContourStyle: TChartComboBox - AnchorSideTop.Control = GbBarSerPen1 + AnchorSideTop.Control = GbAreaSerContour AnchorSideRight.Side = asrBottom Left = 80 Height = 22 @@ -683,7 +687,7 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 0 - OnChange = CbAreaSerContourStyleChange + OnChange = AreaContourChange end object CbAreaSerContourWidth: TChartComboBox AnchorSideTop.Control = CbAreaSerContourStyle @@ -702,10 +706,10 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 1 - OnChange = CbAreaSerContourWidthChange + OnChange = AreaContourChange end object Label11: TLabel - AnchorSideLeft.Control = GbBarSerPen1 + AnchorSideLeft.Control = GbAreaSerContour AnchorSideTop.Control = CbAreaSerContourStyle AnchorSideTop.Side = asrCenter Left = 8 @@ -742,7 +746,7 @@ object Form1: TForm1 BorderSpacing.Top = 8 BorderSpacing.Bottom = 10 ItemHeight = 16 - OnChange = CbAreaSerContourColorChange + OnChange = AreaContourChange ParentFont = False TabOrder = 2 end @@ -759,7 +763,7 @@ object Form1: TForm1 ParentFont = False end end - object GbBarSerPen2: TGroupBox + object GbAreaSerLines: TGroupBox Left = 0 Height = 112 Top = 214 @@ -775,7 +779,7 @@ object Form1: TForm1 ParentFont = False TabOrder = 2 object CbAreaSerLinesStyle: TChartComboBox - AnchorSideTop.Control = GbBarSerPen2 + AnchorSideTop.Control = GbAreaSerLines AnchorSideRight.Side = asrBottom Left = 80 Height = 22 @@ -788,7 +792,7 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 0 - OnChange = CbAreaSerLinesStyleChange + OnChange = AreaLinesChange end object CbAreaSerLinesWidth: TChartComboBox AnchorSideTop.Control = CbAreaSerLinesStyle @@ -807,10 +811,10 @@ object Form1: TForm1 ItemIndex = 0 ParentFont = False TabOrder = 1 - OnChange = CbAreaSerLinesWidthChange + OnChange = AreaLinesChange end object Label18: TLabel - AnchorSideLeft.Control = GbBarSerPen2 + AnchorSideLeft.Control = GbAreaSerLines AnchorSideTop.Control = CbAreaSerLinesStyle AnchorSideTop.Side = asrCenter Left = 8 @@ -847,7 +851,7 @@ object Form1: TForm1 BorderSpacing.Top = 8 BorderSpacing.Bottom = 10 ItemHeight = 16 - OnChange = CbAreaSerLinesColorChange + OnChange = AreaLinesChange ParentFont = False TabOrder = 2 end diff --git a/components/tachart/demo/combobox/main.pas b/components/tachart/demo/combobox/main.pas index 484e6adbed..56fade55ee 100644 --- a/components/tachart/demo/combobox/main.pas +++ b/components/tachart/demo/combobox/main.pas @@ -40,13 +40,13 @@ type CbBarSerBrushStyle: TChartComboBox; ChartListbox1: TChartListbox; CbShow: TCheckBox; - CbLineSerPenColor: TColorBox; + CbLineSerLinePenColor: TColorBox; ChartToolset1: TChartToolset; ChartToolset1DataPointClickTool1: TDataPointClickTool; CbShowPoints: TCheckBox; - GbBarSerBrush1: TGroupBox; - GbBarSerPen1: TGroupBox; - GbBarSerPen2: TGroupBox; + GbAreaSerBrush: TGroupBox; + GbAreaSerContour: TGroupBox; + GbAreaSerLines: TGroupBox; GbLineSerLines: TGroupBox; GbBarSerPen: TGroupBox; GbLineSerPointer: TGroupBox; @@ -83,34 +83,20 @@ type RandomChartSource3: TRandomChartSource; EdLineSerPointerSize: TSpinEdit; Splitter1: TSplitter; - procedure CbAreaSerBrushColorChange(Sender: TObject); - procedure CbAreaSerBrushStyleChange(Sender: TObject); - procedure CbAreaSerContourColorChange(Sender: TObject); - procedure CbAreaSerContourStyleChange(Sender: TObject); - procedure CbAreaSerContourWidthChange(Sender: TObject); - procedure CbAreaSerLinesColorChange(Sender: TObject); - procedure CbAreaSerLinesStyleChange(Sender: TObject); - procedure CbAreaSerLinesWidthChange(Sender: TObject); - procedure CbBarSerBrushColorChange(Sender: TObject); - procedure CbBarSerBrushStyleChange(Sender: TObject); - procedure CbBarSerPenStyleChange(Sender: TObject); - procedure CbBarSerPenWidthChange(Sender: TObject); - procedure CbBarSerPenColorChange(Sender: TObject); - procedure CbLineSerPointerBorderColorChange(Sender: TObject); - procedure CbLineSerLinePenStyleChange(Sender: TObject); - procedure CbLineSerLinePenWidthChange(Sender: TObject); - procedure CbLineSerPenColorChange(Sender: TObject); - procedure CbLineSerPointerBrushColorChange(Sender: TObject); - procedure CbLineSerPointerStyleChange(Sender: TObject); + procedure AreaBrushChange(Sender: TObject); + procedure AreaContourChange(Sender: TObject); + procedure AreaLinesChange(Sender: TObject); + procedure BarBrushChange(Sender: TObject); + procedure BarPenChange(Sender: TObject); + procedure LinePenChange(Sender: TObject); + procedure LinePointerChange(Sender: TObject); procedure CbShowChange(Sender: TObject); - procedure CbShowLinesChange(Sender: TObject); - procedure CbShowPointsChange(Sender: TObject); procedure ChartListbox1Click(Sender: TObject); procedure ChartToolset1DataPointClickTool1PointClick(ATool: TChartTool; APoint: TPoint); - procedure EdLineSerPointerSizeChange(Sender: TObject); procedure FormShow(Sender: TObject); private + FLockChanges: Integer; public @@ -124,174 +110,115 @@ implementation {$R *.lfm} uses - FPCanvas, TACustomSeries; + FPCanvas, TAChartUtils, TACustomSeries; { TAreaSeries } -procedure TForm1.CbAreaSerBrushColorChange(Sender: TObject); +procedure TForm1.AreaBrushChange(Sender: TObject); var ser: TAreaSeries; begin + if FLockChanges > 0 then + exit; ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; ser.AreaBrush.Color := CbAreaSerBrushColor.Selected; -end; - -procedure TForm1.CbAreaSerBrushStyleChange(Sender: TObject); -var - ser: TAreaSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; - ser.AreaBrush.Style := CbAreaSerBrushStyle.BrushStyle; - if CbAreaSerBrushStyle.BrushStyle = bsImage then - // Must be AFTER assigning Brush.Style. + ser.AreaBrush.Style := CbAreaserBrushStyle.BrushStyle; + if CbAreaSerBrushStyle.BrushStyle in [bsImage, bsPattern] then + // Must be AFTER assigning brush style because that sets Brush.Bitmap to nil ser.AreaBrush.Bitmap := CbAreaSerBrushStyle.BrushBitmap; end; -procedure TForm1.CbAreaSerContourColorChange(Sender: TObject); +procedure TForm1.AreaContourChange(Sender: TObject); var ser: TAreaSeries; begin + if FLockChanges > 0 then + exit; ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; ser.AreaContourPen.Color := CbAreaSerContourColor.Selected; -end; - -procedure TForm1.CbAreaSerContourStyleChange(Sender: TObject); -var - ser: TAreaSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; - ser.AreaContourPen.Style := CbAreaSerContourStyle.PenStyle; -end; - -procedure TForm1.CbAreaSerContourWidthChange(Sender: TObject); -var - ser: TAreaSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; ser.AreaContourPen.Width := CbAreaSerContourWidth.PenWidth; + ser.AreaContourPen.Style := CbAreaSerContourStyle.PenStyle; + if ser.AreaContourPen.Style = psPattern then + CbAreaSerContourStyle.SetPenPattern(ser.AreaContourPen); end; -procedure TForm1.CbAreaSerLinesColorChange(Sender: TObject); +procedure TForm1.AreaLinesChange(Sender: TObject); var ser: TAreaSeries; begin + if FLockChanges > 0 then + exit; ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; ser.AreaLinesPen.Color := CbAreaSerLinesColor.Selected; -end; - -procedure TForm1.CbAreaSerLinesStyleChange(Sender: TObject); -var - ser: TAreaSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; - ser.AreaLinesPen.Style := CbAreaSerLinesStyle.PenStyle; -end; - -procedure TForm1.CbAreaSerLinesWidthChange(Sender: TObject); -var - ser: TAreaSeries; -begin ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; ser.AreaLinesPen.Width := CbAreaSerLinesWidth.PenWidth; + ser.AreaLinesPen.Style := CbAreaSerLinesStyle.PenStyle; + if ser.AreaLinesPen.Style = psPattern then + CbAreaSerLinesStyle.SetPenPattern(ser.AreaLinesPen); end; { TBarSeries } -procedure TForm1.CbBarSerBrushColorChange(Sender: TObject); +procedure TForm1.BarBrushChange(Sender: TObject); var - ser: TBarSeries; + ser: TbarSeries; begin + if FLockChanges > 0 then + exit; ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TBarSeries; ser.BarBrush.Color := CbBarSerBrushColor.Selected; -end; - -procedure TForm1.CbBarSerBrushStyleChange(Sender: TObject); -var - ser: TBarSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TBarSeries; ser.BarBrush.Style := CbBarSerBrushStyle.BrushStyle; - if CbBarSerBrushStyle.BrushStyle = bsImage then - // Must be AFTER assigning Brush.Style. + if CbBarSerBrushStyle.BrushStyle in [bsImage, bsPattern] then + // Must be AFTER assigning brush style ser.BarBrush.Bitmap := CbBarSerBrushStyle.BrushBitmap; end; -procedure TForm1.CbBarSerPenStyleChange(Sender: TObject); -var - ser: TBarSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TBarSeries; - ser.BarPen.Style := CbBarSerPenStyle.PenStyle; -end; - -procedure TForm1.CbBarSerPenWidthChange(Sender: TObject); +procedure TForm1.BarPenChange(Sender: TObject); var ser: TBarSeries; begin + if FLockChanges > 0 then + exit; ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TBarSeries; + ser.BarPen.Color := CbBarSerPenColor.Selected; ser.BarPen.Width := CbBarSerPenWidth.PenWidth; + ser.BarPen.Style := CbBarSerPenStyle.PenStyle; + if ser.BarPen.Style = psPattern then + CbBarSerPenStyle.SetPenPattern(ser.BarPen); end; { Line series } -procedure TForm1.CbLineSerLinePenStyleChange(Sender: TObject); -var - ser: TLineSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; - CbLineSerLinePenStyle.SetPenPattern(ser.LinePen); - ser.LinePen.Cosmetic := CbLineSerLinePenStyle.Cosmetic; - ser.LinePen.Style := CbLineSerLinePenStyle.PenStyle; -end; - -procedure TForm1.CbLineSerLinePenWidthChange(Sender: TObject); +procedure TForm1.LinePenChange(Sender: TObject); var ser: TLineSeries; begin + if FLockChanges > 0 then + exit; ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; + ser.LinePen.Color := CbLineSerLinePenColor.Selected; ser.LinePen.Width := CbLineSerLinePenWidth.PenWidth; + ser.LinePen.Style := CbLineSerLinePenStyle.PenStyle; + if ser.LinePen.Style = psPattern then + CbLineSerLinePenStyle.SetPenPattern(ser.LinePen); + ser.ShowLines := cbShowLines.Checked; end; -procedure TForm1.CbBarSerPenColorChange(Sender: TObject); -var - ser: TBarSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TBarSeries; - ser.BarPen.Color := CbBarSerPenColor.Selected; -end; - -procedure TForm1.CbLineSerPenColorChange(Sender: TObject); -var - ser: TLineSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; - ser.LinePen.Color := CbLineSerPenColor.Selected; -end; - -procedure TForm1.CbLineSerPointerBorderColorChange(Sender: TObject); +procedure TForm1.LinePointerChange(Sender: TObject); var ser: TLineSeries; begin + if FLockChanges > 0 then + exit; ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; ser.Pointer.Pen.Color := CbLineSerPointerBorderColor.Selected; -end; - -procedure TForm1.CbLineSerPointerBrushColorChange(Sender: TObject); -var - ser: TLineSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; ser.Pointer.Brush.Color := CbLineSerPointerBrushColor.Selected; -end; - -procedure TForm1.CbLineSerPointerStyleChange(Sender: TObject); -var - ser: TLineSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; ser.Pointer.Style := CbLineSerPointerStyle.PointerStyle; + ser.Pointer.HorizSize := EdLineSerPointerSize.Value; + ser.Pointer.VertSize := EdLineSerPointerSize.Value; + ser.ShowPoints := CbShowPoints.Checked; end; @@ -305,22 +232,6 @@ begin ser.Active := CbShow.Checked; end; -procedure TForm1.CbShowLinesChange(Sender: TObject); -var - ser: TLineSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; - ser.ShowLines := CbShowLines.Checked; -end; - -procedure TForm1.CbShowPointsChange(Sender: TObject); -var - ser: TLineSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; - ser.ShowPoints := CbShowPoints.Checked; -end; - procedure TForm1.ChartListbox1Click(Sender: TObject); var ser: TCustomChartSeries; @@ -328,26 +239,34 @@ begin ser := ChartListbox1.Series[ChartListbox1.ItemIndex]; if ser is TLineSeries then begin Notebook1.PageIndex := 0; + CbShowLines.Checked := TLineSeries(ser).ShowLines; CbLineSerLinePenStyle.SetPenPattern(TLineSeries(ser).LinePen); - CbLineSerLinePenstyle.Cosmetic := TLineSeries(ser).LinePen.Cosmetic; + CbLineSerLinePenStyle.Cosmetic := TLineSeries(ser).LinePen.Cosmetic; CbLineSerLinePenStyle.PenStyle := TLineSeries(ser).LinePen.Style; CbLineSerLinePenWidth.PenWidth := TLineSeries(ser).LinePen.Width; - CbLineSerPenColor.Selected := TLineSeries(ser).LinePen.Color; + CbLineSerLinePenColor.Selected := TLineSeries(ser).LinePen.Color; + + inc(FLockChanges); + CbShowPoints.Checked := TLineSeries(ser).ShowPoints; + EdLineSerPointerSize.Value := TLineSeries(ser).Pointer.HorizSize; CbLineSerPointerStyle.PointerStyle := TLineSeries(ser).Pointer.Style; CbLineSerPointerBorderColor.Selected := TLineSeries(ser).Pointer.Pen.Color; CblineSerPointerBrushColor.Selected := TLineSeries(ser).Pointer.Brush.Color; - EdLineSerPointerSize.Value := TLineSeries(ser).Pointer.HorizSize; + dec(FLockChanges); // Not clear why this is necessary - should work without it + // LinePointerChange(nil); end - else if ser is TBarSeries then begin + else + if ser is TBarSeries then begin Notebook1.PageIndex := 1; CbBarSerPenStyle.PenStyle := TBarSeries(ser).BarPen.Style; CbBarSerPenWidth.PenWidth := TBarseries(ser).BarPen.Width; CbBarSerPenColor.Selected := TBarSeries(ser).BarPen.Color; CbBarSerBrushColor.Selected := TBarSeries(ser).BarBrush.Color; CbBarSerBrushStyle.BrushStyle := TBarSeries(ser).BarBrush.Style; - end else if ser is TAreaSeries then begin + end + else if ser is TAreaSeries then begin Notebook1.PageIndex := 2; - CbAreaSerBrushColor.Selected := TAreaseries(ser).AreaBrush.Color; + CbAreaSerBrushColor.Selected := TAreaSeries(ser).AreaBrush.Color; CbAreaSerBrushStyle.BrushStyle := TAreaSeries(ser).AreaBrush.Style; CbAreaSerContourStyle.PenStyle := TAreaSeries(ser).AreaContourPen.Style; CbAreaSerContourWidth.PenWidth := TAreaSeries(ser).AreaContourPen.Width; @@ -365,6 +284,7 @@ procedure TForm1.ChartToolset1DataPointClickTool1PointClick(ATool: TChartTool; var ser: TChartSeries; begin + Unused(APoint); ser := TChartSeries(TDataPointClickTool(ATool).Series); if ser <> nil then begin ChartListbox1.ItemIndex := ChartListbox1.FindSeriesIndex(ser); @@ -372,16 +292,9 @@ begin end; end; -procedure TForm1.EdLineSerPointerSizeChange(Sender: TObject); -var - ser: TLineSeries; -begin - ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; - ser.Pointer.HorizSize := EdLineSerPointerSize.Value; - ser.Pointer.VertSize := EdLineSerPointerSize.Value; -end; - procedure TForm1.FormShow(Sender: TObject); +const + DEFAULT_PATTERN = '2|1|1|1|1|1|1|1'; var bmp: TBitmap; begin @@ -397,6 +310,25 @@ begin finally bmp.Free; end; + { + bmp := TBitmap.Create; + try + bmp.SetSize(2, 2); + bmp.Canvas.Pixels[0, 0] := clWhite; + bmp.Canvas.Pixels[1, 0] := clBlack; + bmp.Canvas.Pixels[0, 1] := clBlack; + bmp.Canvas.Pixels[1, 1] := clWhite; + finally + CbBarSerBrushStyle.BrushBitmap.Assign(bmp); + CbAreaserBrushStyle.BrushBitmap.Assign(bmp); + end; + } + + // Prepare user-defined line pattern + CbLineSerLinePenStyle.PenPattern := DEFAULT_PATTERN; + CbBarSerPenStyle.PenPattern := DEFAULT_PATTERN; + CbAreaSerLinesStyle.PenPattern := DEFAULT_PATTERN; + CbAreaSerContourStyle.PenPattern := DEFAULT_PATTERN; ChartListbox1.ItemIndex := 0; ChartListbox1Click(nil); diff --git a/components/tachart/tachartcombos.pas b/components/tachart/tachartcombos.pas index fb9bb5bff9..858dbb442a 100644 --- a/components/tachart/tachartcombos.pas +++ b/components/tachart/tachartcombos.pas @@ -5,14 +5,22 @@ interface uses SysUtils, Graphics, Classes, Controls, StdCtrls, TATypes, TAGraph; +type + TChartComboMode = (ccmPointerStyle, ccmPenStyle, ccmPenWidth, ccmBrushStyle); + + TChartComboOptions = set of ( + ccoNames, // Show item names in combo + ccoPatternBrush, // Include bsPattern item in brush style mode + ccoImageBrush, // Include bsImage item in brush style mode + ccoPatternPen); // Include psPattern item in pen style mode + const DEFAULT_POINTER_STYLE = psCircle; DEFAULT_SYMBOL_WIDTH = 40; DEFAULT_DROPDOWN_COUNT = 24; + DEFAULT_OPTIONS = [ccoNames, ccoPatternBrush, ccoPatternPen]; type - TChartComboMode = (ccmPointerStyle, ccmPenStyle, ccmPenWidth, ccmBrushStyle); - TChartComboBox = class(TCustomComboBox) private FAlignment: TAlignment; @@ -29,7 +37,7 @@ type FCosmetic: Boolean; FLockItemIndex: Integer; FMode: TChartComboMode; - FShowNames: Boolean; + FOptions: TChartComboOptions; FSymbolWidth: Integer; function GetPenPattern: String; procedure SetAlignment(const AValue: TAlignment); @@ -38,13 +46,13 @@ type procedure SetCosmetic(const AValue: Boolean); procedure SetMaxPenWidth(const AValue: Integer); procedure SetMode(const AValue: TChartComboMode); + procedure SetOptions(const AValue: TChartComboOptions); procedure SetPenColor(const AValue: TColor); procedure SetPenPattern(const AValue: String); overload; procedure SetSelectedBrushStyle(const AValue: TBrushStyle); procedure SetSelectedPenStyle(const AValue: TPenStyle); procedure SetSelectedPenWidth(const AValue: Integer); procedure SetSelectedPointerStyle(const AValue: TSeriesPointerStyle); - procedure SetShowNames(const AValue: Boolean); procedure SetSymbolWidth(const AValue: Integer); protected procedure Change; override; @@ -73,12 +81,13 @@ type property Cosmetic: Boolean read FCosmetic write SetCosmetic default true; property MaxPenWidth: Integer read FMaxPenWidth write SetMaxPenWidth default 5; property Mode: TChartComboMode read FMode write SetMode default ccmPenStyle; + property Options: TChartComboOptions read FOptions write SetOptions default DEFAULT_OPTIONS; property PenPattern: string read GetPenPattern write SetPenPattern; property PenColor: TColor read FPenColor write SetPenColor default clBlack; property PenStyle: TPenStyle read FPenStyle write SetSelectedPenStyle default psSolid; property PenWidth: Integer read FPenWidth write SetSelectedPenWidth default 1; property PointerStyle: TSeriesPointerStyle read FPointerStyle write SetSelectedPointerStyle default DEFAULT_POINTER_STYLE; - property ShowNames: Boolean read FShowNames write SetShowNames default true; +// property ShowNames: Boolean read FShowNames write SetShowNames default true; property SymbolWidth: Integer read FSymbolWidth write SetSymbolWidth default DEFAULT_SYMBOL_WIDTH; property Align; @@ -213,270 +222,6 @@ begin end; end; - (* -{ TSeriesPointerStyleCombobox } - -constructor TSeriesPointerStyleCombobox.Create(AOwner:TComponent); -begin - inherited Create(AOwner); - Style := csOwnerDrawFixed; - DropdownCount := DEFAULT_DROPDOWN_COUNT; - ReadOnly := true; - FSymbolBorderColor := clBlack; - FSymbolFillColor := clWhite; - FShowNames := true; - FAlignment := taLeftJustify; - FSelected := DEFAULT_POINTER_STYLE; - GetItems; - Caption := GetSymbolName(FSelected); -end; - -destructor TSeriesPointerStyleCombobox.Destroy; -begin - DestroyBitmaps; - inherited; -end; - -procedure TSeriesPointerStyleCombobox.CreateBitmaps(AWidth, AHeight: Integer); -var - ps: TSeriesPointerStyle; - chart: TChart; - id: IChartDrawer; - series: TLineSeries; - legItems: TChartLegendItems; -begin - DestroyBitmaps; - - chart := TChart.Create(nil); - try - for ps in TSeriesPointerStyle do begin - FBitmaps[ps] := TBitmap.Create; - FBitmaps[ps].Transparent := true; - FBitmaps[ps].TransparentColor := RgbToColor(254,254,254); - FBitmaps[ps].SetSize(AWidth, AHeight); - FBitmaps[ps].Canvas.Brush.Color := FBitmaps[ps].TransparentColor; - FBitmaps[ps].Canvas.FillRect(0, 0, AWidth, AHeight); - - series := TLineSeries.Create(chart); - try - with series do begin - Pointer.Style := ps; - Pointer.Brush.Color := FSymbolFillColor; - Pointer.Pen.Color := FSymbolBorderColor; - Pointer.HorizSize := Min(AWidth, AHeight); - Pointer.VertSize := Pointer.HorizSize; - ShowPoints := true; - LineType := ltNone; - end; - chart.AddSeries(series); - legitems := TChartLegendItems.Create; - try - series.GetSingleLegendItem(legItems); - id := TCanvasDrawer.Create(FBitmaps[ps].Canvas); - id.Pen := Chart.Legend.SymbolFrame; - legItems[0].Draw(id, Rect(0, 0, AWidth-1, AHeight-1)); - finally - legitems.Free; - end; - finally - series.Free; - end; - end; - finally - chart.Free; - end; -end; - -procedure TSeriesPointerStyleCombobox.DestroyBitmaps; -var - ps: TSeriesPointerStyle; -begin - for ps in TSeriesPointerStyle do - FreeAndNil(FBitmaps[ps]); -end; - -procedure TSeriesPointerStyleCombobox.DrawItem(AIndex: Integer; ARect: TRect; - AState: TOwnerDrawState); -const - MARGIN = 2; -var - symRect: TRect; - symheight : integer; - symwidth: Integer; - txt: string; - ps: TSeriesPointerStyle; - ts: TTextStyle; - alignmnt: TAlignment; -begin - SymRect := ARect; - inc(SymRect.Top, MARGIN); - dec(SymRect.Bottom, MARGIN); - symheight := SymRect.Bottom - SymRect.Top; - symwidth := symheight * 6 div 4; // see: TLegendItemLinePointer.Draw in TALagend - if (BiDiMode <> bdLeftToRight) then - case FAlignment of - taLeftJustify : alignmnt := taRightJustify; - taCenter : alignmnt := taCenter; - taRightJustify: alignmnt := taLeftJustify - end - else - alignmnt := FAlignment; - case alignmnt of - taLeftJustify : ; - taCenter : SymRect.Left := (ARect.Left + ARect.Right - symwidth) div 2; - taRightJustify : SymRect.Left := ARect.Right - MARGIN - symwidth; - end; - SymRect.Right := SymRect.Left + symwidth; - - with Canvas do begin - if odSelected in AState then begin - Brush.Color := clHighlight; - Font.Color := clHighlightText; - end else begin - Brush.Color := Color; - Font.Color := clWindowText; - end; - Brush.Style := bsSolid; - FillRect(ARect); - - // Create bitmaps of pointer symbols if they are nil, or if height has changed - if (FBitmaps[psCircle] = nil) or (FBitmaps[psCircle].Height <> symheight) - then CreateBitmaps(symwidth, symheight); - - Pen.Color := FSymbolBorderColor; - Pen.Style := psSolid; - Pen.Width := 1; - Brush.Color := FSymbolFillColor; - ps := GetSymbol(AIndex); - Canvas.Draw(SymRect.Left, SymRect.Top, FBitmaps[ps]); - - if FShowNames and (alignmnt <> taCenter) then begin // Note: No text output for taCenter! - txt := Items[AIndex]; - case alignmnt of - taLeftJustify : ARect.Left := SymRect.Right + 2 * MARGIN; - taRightJustify : ARect.Left := SymRect.Left - 2 * MARGIN - Canvas.TextWidth(txt); - end; - ts := Canvas.TextStyle; - ts.Layout := tlCenter; - ts.Opaque := false; - ts.EndEllipsis := true; - TextRect(ARect, ARect.Left, ARect.Top, txt, ts); - end; - end; -end; - -procedure TSeriesPointerStyleCombobox.GetItems; -const - // Arrange symbols in "nice" order - LIST: array[0..19] of TSeriesPointerStyle = ( - psNone, psRectangle, psCircle, psDiamond, - psTriangle, psDownTriangle, psLeftTriangle, psRightTriangle, - psHexagon, psFullStar, - psStar, psCross, psDiagCross, - psLowBracket, psHighBracket, psLeftBracket, psRightBracket, - psHorBar, psVertBar, psPoint); -var - ps: TSeriesPointerStyle; - s: String; - i: Integer; - sel: TSeriesPointerStyle; - styleItems: TStrings; -begin - if inherited Items.Count > 0 then - exit; - - sel := FSelected; - styleItems := TStringList.Create; - try - for i:=0 to High(LIST) do begin - ps := LIST[i]; - s := GetSymbolName(ps); - if s <> '' then - styleItems.AddObject(s, TObject(PtrInt(ps))); - end; - inherited Items.Assign(styleitems); - finally - styleItems.Free; - SetSelected(sel); - end; -end; - -function TSeriesPointerStyleCombobox.GetSymbol(AIndex: Integer): TSeriesPointerStyle; -begin - if AIndex = -1 then - Result := psNone - else - Result := TSeriesPointerStyle(PtrInt(Items.Objects[AIndex])); -end; - -{ Is overridden to prevent loss of default selected pointer style when - combo is added to a form in designer. } -procedure TSeriesPointerStyleCombobox.RealSetText(const AValue: TCaption); -var - sel: TSeriesPointerStyle; -begin - sel := FSelected; - inherited RealSetText(AValue); - SetSelected(sel); -end; - -procedure TSeriesPointerStyleCombobox.SetAlignment(Value:TAlignment); -begin - if Value <> FAlignment then begin - FAlignment := Value; - Invalidate; - end; -end; - -procedure TSeriesPointerStyleCombobox.SetItemIndex(const AValue: Integer); -begin - FSelected := GetSymbol(AValue); - if AValue = inherited ItemIndex then exit; - inherited SetItemIndex(AValue); -end; - -procedure TSeriesPointerStyleCombobox.SetSelected(AValue:TSeriesPointerStyle); -var - i : integer; -begin - for i := 0 to Items.Count-1 do begin - if GetSymbol(i) = AValue then begin - FSelected := AValue; - ItemIndex := i; - Invalidate; - exit; - end; - end; - ItemIndex := -1; - FSelected := psNone; -end; - -procedure TSeriesPointerStyleCombobox.SetShowNames(AValue: boolean); -begin - if (FShowNames <> AValue) then begin - FShowNames := AValue; - Invalidate; - end; -end; - -procedure TSeriesPointerStyleCombobox.SetSymbolBorderColor(AValue: TColor); -begin - if FSymbolBorderColor <> AValue then begin - FSymbolBorderColor := AValue; - DestroyBitmaps; - Invalidate; - end; -end; - -procedure TSeriesPointerStyleCombobox.SetSymbolFillColor(AValue: TColor); -begin - if FSymbolFillColor <> AValue then begin - FSymbolFillColor := AValue; - DestroyBitmaps; - Invalidate; - end; -end; - *) { TChartComboBox } @@ -498,7 +243,7 @@ begin FPenStyle := psSolid; FPenWidth := 1; FMaxPenWidth := 5; - FShowNames := true; + FOptions := DEFAULT_OPTIONS; FSymbolWidth := DEFAULT_SYMBOL_WIDTH; PopulatePenStyles; SetSelectedPenStyle(FPenStyle); @@ -634,7 +379,7 @@ begin end; Canvas.Brush.Color := FBrushColor; Canvas.Brush.Style := bs; - if bs = bsImage then + if (bs = bsImage) or (bs = bsPattern) then Canvas.Brush.Bitmap := FBrushBitmap; // AFTER assigning Brush.Style! Canvas.Pen.Color := clBlack; Canvas.Pen.Style := psSolid; @@ -668,7 +413,7 @@ begin end; end; - if FShowNames and (FAlignment <> taCenter) then begin + if (ccoNames in FOptions) and (FAlignment <> taCenter) then begin ts := Canvas.TextStyle; ts.Layout := tlCenter; ts.Opaque := false; @@ -708,7 +453,8 @@ begin if AIndex < 0 then Result := psSolid else - Result := TPenStyle(AIndex); +// Result := TPenStyle(AIndex); + Result := TPenStyle(PtrInt(Items.Objects[AIndex])); end; function TChartComboBox.GetPenWidth(const AIndex: Integer): Integer; @@ -732,8 +478,13 @@ begin Items.BeginUpdate; try Items.Clear; - for bs in TBrushStyle do + for bs in TBrushStyle do begin + if (bs = bsPattern) and not (ccoPatternBrush in FOptions) then + Continue; + if (bs = bsImage) and not (ccoImageBrush in FOptions) then + Continue; Items.Add(GetBrushStylename(bs)); + end; finally Items.EndUpdate; dec(FLockItemIndex); @@ -748,8 +499,11 @@ begin Items.BeginUpdate; try Items.Clear; - for ps in TPenStyle do - Items.Add(GetPenStyleName(ps)); + for ps in TPenStyle do begin + if (ps = psPattern) and not (ccoPatternPen in FOptions) then + Continue; + Items.AddObject(GetPenStyleName(ps), TObject(PtrInt(ps))); + end; finally Items.EndUpdate; dec(FLockItemIndex); @@ -916,6 +670,19 @@ begin end; end; +procedure TChartComboBox.SetOptions(const AValue: TChartComboOptions); +begin + if FOptions = AValue then exit; + FOptions := AValue; + case FMode of + ccmBrushStyle : PopulateBrushStyles; + ccmPenStyle : PopulatePenStyles; + ccmPenWidth : PopulatePenWidths; + ccmPointerStyle : PopulatePointerStyles; + end; + Invalidate; +end; + procedure TChartComboBox.SetPenPattern(const AValue: String); var L: TStrings; @@ -959,8 +726,15 @@ begin end; procedure TChartComboBox.SetSelectedPenStyle(const AValue: TPenStyle); +var + i: Integer; begin - ItemIndex := EnsureRange(ord(AValue), 0, Items.Count - 1); + for i := 0 to Items.Count - 1 do + if GetPenStyle(i) = AValue then begin + ItemIndex := i; + exit; + end; + ItemIndex := -1; end; procedure TChartComboBox.SetSelectedPenWidth(const AValue: Integer); @@ -984,13 +758,6 @@ begin FPointerStyle := psNone; end; -procedure TChartComboBox.SetShowNames(const AValue: Boolean); -begin - if FShowNames = AValue then exit; - FShowNames := AValue; - Invalidate; -end; - procedure TChartComboBox.SetSymbolWidth(const AValue: Integer); begin if FSymbolWidth = AValue then exit;