pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Add TJvChart component.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7175 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-11-09 13:20:57 +00:00
parent 91e4b55009
commit bf67a7d27a
12 changed files with 7912 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/jvcllaz/design/JvCustomControls/images/images.txt
View File

@ -1,6 +1,7 @@
tjvtabbar.bmp
tjvmoderntabbarpainter.bmp
tjvtabbarxppainter.bmp
tjvchart.bmp
tjvgammapanel.png
tjvgammapanel_150.png
tjvgammapanel_200.png

BIN
components/jvcllaz/design/JvCustomControls/images/tjvchart.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

6
components/jvcllaz/design/JvCustomControls/jvcustomreg.pas
View File

@ -22,7 +22,8 @@ uses
// JvTabBar, JvTabBarXPPainter,
JvThumbImage, JvThumbnails, JvThumbViews,
JvTimeLine, JvTMTimeLine, JvTimeLineEditor,
JvImagesViewer, JvImageListViewer, JvOwnerDrawViewer;
JvImagesViewer, JvImageListViewer, JvOwnerDrawViewer,
JvChart;
procedure Register;
begin
@ -33,7 +34,8 @@ begin
TJvThumbView, TJvThumbnail, TJvThumbImage,
TJvTimeLine, TJvTMTimeLine,
TJvGammaPanel,
TJvImagesViewer, TJvImageListViewer, TJvOwnerDrawViewer
TJvImagesViewer, TJvImageListViewer, TJvOwnerDrawViewer,
TJvChart
]);
// Timeline

90
components/jvcllaz/examples/JvChartDemo/JvChartDemo.lpi Normal file
View File

@ -0,0 +1,90 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="JvChartDemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="Printer4Lazarus"/>
</Item1>
<Item2>
<PackageName Value="JvCustomLazR"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="JvChartDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="jvchartdemofm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="JvChartDemoForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="JvChartDemoFm"/>
</Unit>
<Unit>
<Filename Value="statsclasses.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="StatsClasses"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\bin\$(TargetCPU)-$(TargetOS)\JvChartDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

20
components/jvcllaz/examples/JvChartDemo/JvChartDemo.lpr Normal file
View File

@ -0,0 +1,20 @@
program JvChartDemo;
{$MODE OBJFPC}{$H+}
uses
Interfaces,
Forms, printer4lazarus,
JvChartDemoFm in 'JvChartDemoFm.pas' {JvChartDemoForm},
StatsClasses in 'StatsClasses.pas';
{$R *.res}
begin
Application.Initialize;
Application.Title:='JvChartDemo';
Application.Scaled := true;
Application.CreateForm(TJvChartDemoForm, JvChartDemoForm);
Application.Run;
end.

526
components/jvcllaz/examples/JvChartDemo/jvchartdemofm.lfm Normal file
View File

@ -0,0 +1,526 @@
object JvChartDemoForm: TJvChartDemoForm
Left = 436
Height = 453
Top = 278
Width = 789
Caption = 'JEDI JvChart Demo'
ClientHeight = 433
ClientWidth = 789
Color = clWindow
Menu = MainMenu1
OnCreate = FormCreate
OnDestroy = FormDestroy
OnResize = FormResize
Position = poScreenCenter
LCLVersion = '2.1.0.0'
object Chart: TJvChart
Left = 164
Height = 398
Top = 35
Width = 625
Font.Height = -19
Align = alClient
Options.XAxisValuesPerDivision = 10
Options.XAxisLabelAlignment = taLeftJustify
Options.XAxisDateTimeMode = False
Options.XAxisDateTimeDivision = 0
Options.XAxisLegendSkipBy = 2
Options.PenCount = 3
Options.XGap = 0
Options.XOrigin = 0
Options.YOrigin = 0
Options.YStartOffset = 42
Options.PrimaryYAxis.YMax = 20
Options.PrimaryYAxis.YMin = 0
Options.PrimaryYAxis.YDivisions = 20
Options.PrimaryYAxis.YLegendDecimalPlaces = 1
Options.SecondaryYAxis.YMax = 140
Options.SecondaryYAxis.YMin = 0
Options.SecondaryYAxis.YLegendDecimalPlaces = 0
Options.SecondaryYAxis.DefaultYLegends = 60
Options.MouseDragObjects = False
Options.Legend = clChartLegendBelow
Options.LegendRowCount = 1
Options.PenLineWidth = 2
Options.AxisLineWidth = 3
Options.XValueCount = 20
Options.HeaderFont.Color = clWindowText
Options.LegendFont.Color = clWindowText
Options.AxisFont.Color = clWindowText
Options.PaperColor = clWhite
Options.AxisLineColor = clBlack
Options.CursorColor = clBlack
Options.CursorStyle = psDot
OnChartPaint = ChartChartPaint
OnBeginFloatingMarkerDrag = ChartBeginFloatingMarkerDrag
OnEndFloatingMarkerDrag = ChartEndFloatingMarkerDrag
end
object Splitter1: TSplitter
Left = 159
Height = 398
Top = 35
Width = 5
end
object PanelTop: TPanel
Left = 0
Height = 35
Top = 0
Width = 789
Align = alTop
ClientHeight = 35
ClientWidth = 789
Font.CharSet = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Verdana'
ParentFont = False
TabOrder = 0
object ButtonBarChart: TSpeedButton
Left = 5
Height = 25
Hint = 'Bar Chart'
Top = 5
Width = 25
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333300030003
0003333377737773777333333333333333333FFFFFFFFFFFFFFF770000000000
0000777777777777777733039993BBB3CCC3337F737F737F737F37039993BBB3
CCC3377F737F737F737F33039993BBB3CCC33F7F737F737F737F77079997BBB7
CCC77777737773777377330399930003CCC3337F737F7773737F370399933333
CCC3377F737F3333737F330399933333CCC33F7F737FFFFF737F770700077777
CCC77777777777777377330333333333CCC3337F33333333737F370333333333
0003377F33333333777333033333333333333F7FFFFFFFFFFFFF770777777777
7777777777777777777733333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonBarChartClick
ShowHint = True
ParentShowHint = False
end
object ButtonLine: TSpeedButton
Left = 58
Height = 25
Hint = 'Line Chart'
Top = 5
Width = 25
Down = True
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00337333733373
3373337F3F7F3F7F3F7F33737373737373733F7F7F7F7F7F7F7F770000000000
000077777777777777773303333333333333337FF333333F33333709333333C3
333337773F3FF373F333330393993C3C33333F7F7F77F7F7FFFF77079797977C
77777777777777777777330339339333C333337FF73373F37F33370C333C3933
933337773F3737F37FF33303C3C33939C9333F7F7F7FF7F777FF7707C7C77797
7C97777777777777777733033C3333333C33337F37F33333373F37033C333333
33C3377F37333333337333033333333333333F7FFFFFFFFFFFFF770777777777
7777777777777777777733333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonLineClick
ShowHint = True
ParentShowHint = False
end
object ButtonStackedBarAve: TSpeedButton
Left = 345
Height = 25
Hint = 'Stacked Bars with Average'
Top = 7
Width = 25
Enabled = False
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333300030003
0003333388838883888333333333333333333FFFFFFFFFFFFFFF880000000000
000088888888888888883303999399939993338F838F838F838F38039993BBB3
9993388F838F838F838F3303BBB3BBB399933F8F838F838F838F8808BBB8AAA8
999888888388838883883303AAA300039993338F838F8883838F3803AAA30003
BBB3388F838F3333838F3303AAA30003BBB33F8F838FFFFF838F880800080008
BBB88888888888888388330300030003AAA3338F33333333838F380300030003
0003388F33333333888333030003000300033F8FFFFFFFFFFFFF880888888888
8888888888888888888833333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonStackedBarAveClick
ShowHint = True
ParentShowHint = False
end
object ButtonStackedBar: TSpeedButton
Left = 111
Height = 25
Hint = 'Stacked Bars'
Top = 5
Width = 26
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333300030003
0003333388838883888333333333333333333FFFFFFFFFFFFFFF880000000000
000088888888888888883303999399939993338F838F838F838F38039993BBB3
BBB3388F838F838F838F3303BBB3BBB3BBB33F8F838F838F838F8808BBB8AAA8
BBB888888388838883883303AAA30003BBB3338F838F8883838F3803AAA33333
BBB3388F838F3333838F3303AAA33333BBB33F8F838FFFFF838F880800088888
BBB88888888888888388330333333333AAA3338F33333333838F380333333333
0003388F33333333888333033333333333333F8FFFFFFFFFFFFF880888888888
8888888888888888888833333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonStackedBarClick
ShowHint = True
ParentShowHint = False
end
object ButtonBarAve: TSpeedButton
Left = 31
Height = 25
Hint = 'Bar Chart with Average Line'
Top = 5
Width = 25
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333300030003
0003333388838883888333333333333333333FFFFFFFFFFFFFFF880000000000
0000888888888888888833039BA39BA39BA3338F838F838F838F38039BA39BA3
9BA3388F838F838F838F33039BA39BA39BA33F8F838F838F838F88089BA89BA8
9BA8888883888388838833039BA390A39BA3338F838F8883838F38039BA30B03
9BA3388F838F3333838F33039BA03B309BA33F8F838FFFFF838F88089B088B88
0BA8888888888888838833039033333390A3338F33333333838F380393333333
9BA3388F3333333388833303333333333B333F8FFFFFFFFFFFFF880888888888
8B88888888888888888833333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonBarAveClick
ShowHint = True
ParentShowHint = False
end
object ButtonPie: TSpeedButton
Left = 371
Height = 25
Hint = 'Show Pie Chart (one series only)'
Top = 7
Width = 25
Enabled = False
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333FFFFF3333333333700073333333FFF3777773F3FFF00030990BB03
000077737337F373777733309990BBB0333333373337F3373F3333099990BBBB
033333733337F33373F337999990BBBBB73337F33337F33337F330999990BBBB
B03337F33337FFFFF7F3309999900000003337F33337777777F33099990A0CCC
C03337F3337373F337F3379990AAA0CCC733373F3733373F373333090AAAAA0C
033333737333337373333330AAAAAAA033333FF73F33333733FF00330AAAAA03
3000773373FFFF73377733333700073333333333377777333333333333333333
3333333333333333333333333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonPieClick
ShowHint = True
ParentShowHint = False
end
object ButtonMarkers: TSpeedButton
Left = 291
Height = 25
Hint = 'Show Markers'
Top = 7
Width = 25
Enabled = False
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00338333833383
3383338F3F8F3F8F3F8F33838383838383833F8F8F8F8F8F8F8F880000000000
000088888888888888883303333333333333338F33333333333338033393A333
333A388833333333333333033C333C3333333F8FFFFFFFFFFFFF88088888988C
888A88888888888888883303333333333333338F333333333333380A33A33333
3333388833333333333333033333333A33333F8FFFFFFFFFFFFF880888888898
889888888888888888883303933C33333333338F333333333333380333333333
3A33388F3333333333333303C333333333333F8FFFFFFFFFFFFF880888888888
8888888888888888888833333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonMarkersClick
ShowHint = True
ParentShowHint = False
end
object ButtonDeltaAverage: TSpeedButton
Left = 319
Height = 25
Hint = 'Delta Average'
Top = 7
Width = 25
Enabled = False
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333300030003
0003333388838883888333333333333333333FFFFFFFFFFFFFFF888000000000
0000888888888888888833333333033333333333333F33333333333333330333
33333333333F3333333333CCCCCC033333333333333F3333333388CCCCCC0333
33333333333F3333333333333333033333333333333F33333333333333330AAA
A3333333333F33333333333333330AAAA3333333333F33333333833333330333
33333333333F3333333333333333099999993333333F33333333333333330999
99993333333F3333333333333333033333333FFFFFFFFFFFFFFF888000000000
0000888888888888888833333333333333333333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonDeltaAverageClick
ShowHint = True
ParentShowHint = False
end
object ButtonLineMarker: TSpeedButton
Left = 84
Height = 25
Hint = 'Line with Markers'
Top = 5
Width = 25
Flat = True
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00337333733373
3373337F3F7F3F7F3F7F33737373737373733F7F7F7F7F7F7F7F770000000000
000077777777777777773303333333333333337FF333333F33333709333333C3
333337773F3FF373F333330393993C3C33333F7F7F77F7F7FFFF77079797977C
77777777777777777777330339339333C333337FF73373F37F33370C333C3933
933337773F3737F37FF33303C3C33939C9333F7F7F7FF7F777FF7707C7C79797
7C97777777777777777733033C3393933C33337F37F33333373F37033C333933
33C3377F3733333333733303CCC3393333C33F7FFFFFFFFFFFFF77077C777777
7CCC777777777777777733333333333333C33333333333333333
}
GroupIndex = 1
NumGlyphs = 2
OnClick = ButtonLineMarkerClick
ShowHint = True
ParentShowHint = False
end
object Label1: TLabel
Left = 398
Height = 16
Top = 10
Width = 210
Caption = '(TODO: Fix broken chart types)'
Enabled = False
ParentColor = False
end
object SpeedButtonTestMouseOver: TSpeedButton
Left = 139
Height = 25
Hint = 'Floating Markers Demo (new JAN 2005!)'
Top = 5
Width = 26
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000000000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00D88888888888
888D79FFFFFFFFFFFF98999FFFFFFFFFF99979CFFFFFFFFFCF987FFCFFFFFFFF
CFF87FFCFFFFFFFCFFF87FFCFFFFFFFCFFF87FFFCFFFFFCFFFF87FFFCFFFFFCF
FFF87FFFCFFFFFCFFFF87FFFFCFFFCFFFFF87FFFFCFFFCFFFFF87FFFFFCFFCFF
FFF87FFFFFC9CFFFFFF87FFFFF999FFFFFF8D77777797777777D
}
GroupIndex = 1
OnClick = SpeedButtonTestMouseOverClick
ShowHint = True
ParentShowHint = False
end
end
object ListBox1: TListBox
Left = 0
Height = 398
Top = 35
Width = 159
Align = alLeft
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Items.Strings = (
'<Pen Values>'
)
ItemHeight = 14
OnClick = ListBox1Click
OnDblClick = ListBox1DblClick
ParentFont = False
TabOrder = 1
Visible = False
end
object ColorDialog1: TColorDialog
Color = clBlack
CustomColors.Strings = (
'ColorA=000000'
'ColorB=000080'
'ColorC=008000'
'ColorD=008080'
'ColorE=800000'
'ColorF=800080'
'ColorG=808000'
'ColorH=808080'
'ColorI=C0C0C0'
'ColorJ=0000FF'
'ColorK=00FF00'
'ColorL=00FFFF'
'ColorM=FF0000'
'ColorN=FF00FF'
'ColorO=FFFF00'
'ColorP=FFFFFF'
'ColorQ=C0DCC0'
'ColorR=F0CAA6'
'ColorS=F0FBFF'
'ColorT=A4A0A0'
)
left = 504
top = 160
end
object FontDialog1: TFontDialog
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
MinFontSize = 0
MaxFontSize = 0
Options = []
left = 592
top = 160
end
object MainMenu1: TMainMenu
left = 464
top = 48
object Demo1: TMenuItem
Caption = '&Demo'
object mnuSetHeaderFont: TMenuItem
Caption = 'Set Header Font...'
OnClick = mnuSetHeaderFontClick
end
object mnuSetAxisTitlefont: TMenuItem
Caption = 'Set Axis Title Font...'
OnClick = mnuSetAxisTitlefontClick
end
object mnuSetAxisFont: TMenuItem
Caption = 'Set Axis Label Font...'
OnClick = mnuSetAxisFontClick
end
object mnuSetLegendFont: TMenuItem
Caption = 'Set Legend Font...'
OnClick = mnuSetLegendFontClick
end
object N2: TMenuItem
Caption = '-'
end
object mnuScrolling: TMenuItem
Caption = 'Scrolling'
ShortCut = 16467
OnClick = mnuScrollingClick
end
object CopyToClipboard1: TMenuItem
Caption = 'Copy To Clipboard'
ShortCut = 16451
OnClick = CopyToClipboard1Click
end
object Print1: TMenuItem
Caption = 'Print Chart to Printer'
ShortCut = 16464
OnClick = Print1Click
end
object PrintOptions1: TMenuItem
Caption = '&Print Options'
OnClick = PrintOptions1Click
end
object N1: TMenuItem
Caption = '-'
end
object Generatenewrandomvalues1: TMenuItem
Caption = '&Generate new random values'
ShortCut = 16466
OnClick = Generatenewrandomvalues1Click
end
object ShowgapinLineChart1: TMenuItem
Caption = '&Show gap in Line Chart'
ShortCut = 16455
OnClick = ShowgapinLineChart1Click
end
object DateTimeAxisMode: TMenuItem
Caption = 'Date/Time Axis Mode'
OnClick = DateTimeAxisModeClick
end
object MenuNegValueTest: TMenuItem
AutoCheck = True
Caption = 'Use Positive and Negative Demo Values (-20..+20)'
OnClick = MenuNegValueTestClick
end
object MenuSecondaryAxisMode: TMenuItem
Caption = '&Plot Markers+Values using Alternate Scale (0-120%)'
OnClick = MenuSecondaryAxisModeClick
end
object N4: TMenuItem
Caption = '-'
end
object ShowDataInListbox1: TMenuItem
Caption = '&Show Data in listbox'
ShortCut = 16452
OnClick = ShowDataInListbox1Click
end
object LargeDataset576samples1: TMenuItem
Caption = '&Large Dataset (576 samples)'
ShortCut = 16460
OnClick = LargeDataset576samples1Click
end
object NewFeaturesfor20071: TMenuItem
Caption = 'New Features for 2007'
OnClick = NewFeaturesfor20071Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object About1: TMenuItem
Caption = '&About JvChart Component'
ShortCut = 16449
OnClick = About1Click
end
end
end
object Timer1: TTimer
Enabled = False
Interval = 100
OnTimer = Timer1Timer
left = 344
top = 48
end
object PrinterSetupDialog1: TPrinterSetupDialog
left = 264
top = 160
end
object PrintDialog1: TPrintDialog
left = 392
top = 160
end
end

854
components/jvcllaz/examples/JvChartDemo/jvchartdemofm.pas Normal file
View File

@ -0,0 +1,854 @@
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvChartDemoFm.Pas, released on 2002-10-04.
The Initial Developer of the Original Code is AABsoft and Mårten Henrichson.
(C) 1996 AABsoft and Mårten Henrichson.
All Rights Reserved.
Contributor(s): -
Last Modified: 2005-01-14
Modified March 2007 by Warren Postma - Show new JvChart 2007 Features.
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Description:
BAR/LINE Charting Component for JEDI [Updated March 2007]
Known Issues:
-----------------------------------------------------------------------------}
{$MODE OBJFPC}{$H+}
unit JvChartDemoFm;
interface
uses
Windows, SysUtils, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Spin, PrintersDlgs,
JvChart, JvComponent, JvExControls, StatsClasses, Menus;
type
{ TJvChartDemoForm }
TJvChartDemoForm = class(TForm)
mnuSetAxisTitlefont: TMenuItem;
mnuSetLegendFont: TMenuItem;
mnuSetHeaderFont: TMenuItem;
PanelTop: TPanel;
ButtonBarChart: TSpeedButton;
ButtonLine: TSpeedButton;
ButtonStackedBarAve: TSpeedButton;
ButtonStackedBar: TSpeedButton;
ButtonBarAve: TSpeedButton;
ColorDialog1: TColorDialog;
ButtonPie: TSpeedButton;
FontDialog1: TFontDialog;
ButtonMarkers: TSpeedButton;
ButtonDeltaAverage: TSpeedButton;
Chart: TJvChart;
ButtonLineMarker: TSpeedButton;
Label1: TLabel;
MainMenu1: TMainMenu;
Demo1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
ShowgapinLineChart1: TMenuItem;
N1: TMenuItem;
Print1: TMenuItem;
Generatenewrandomvalues1: TMenuItem;
CopyToClipboard1: TMenuItem;
N2: TMenuItem;
mnuSetAxisFont: TMenuItem;
mnuScrolling: TMenuItem;
ListBox1: TListBox;
Splitter1: TSplitter;
Timer1: TTimer;
ShowDataInListbox1: TMenuItem;
N4: TMenuItem;
LargeDataset576samples1: TMenuItem;
DateTimeAxisMode: TMenuItem;
PrintOptions1: TMenuItem;
PrinterSetupDialog1: TPrinterSetupDialog;
PrintDialog1: TPrintDialog;
MenuSecondaryAxisMode: TMenuItem;
MenuNegValueTest: TMenuItem;
SpeedButtonTestMouseOver: TSpeedButton;
NewFeaturesfor20071: TMenuItem;
procedure FormResize(Sender: TObject);
procedure ButtonLineClick(Sender: TObject);
procedure ButtonBarChartClick(Sender: TObject);
procedure ButtonStackedBarAveClick(Sender: TObject);
procedure ButtonStackedBarClick(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure ButtonBarAveClick(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ButtonPieClick(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure ButtonMarkersClick(Sender: TObject);
procedure ButtonDeltaAverageClick(Sender: TObject);
procedure ButtonLineMarkerClick(Sender: TObject);
procedure Panel2DblClick(Sender: TObject);
procedure ShowgapinLineChart1Click(Sender: TObject);
procedure Print1Click(Sender: TObject);
procedure Generatenewrandomvalues1Click(Sender: TObject);
procedure CopyToClipboard1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure mnuScrollingClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ShowDataInListbox1Click(Sender: TObject);
procedure LargeDataset576samples1Click(Sender: TObject);
procedure DateTimeAxisModeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PrintOptions1Click(Sender: TObject);
procedure MenuSecondaryAxisModeClick(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure mnuSetAxisFontClick(Sender: TObject);
procedure mnuSetAxisTitlefontClick(Sender: TObject);
procedure mnuSetHeaderFontClick(Sender: TObject);
procedure mnuSetLegendFontClick(Sender: TObject);
procedure MenuNegValueTestClick(Sender: TObject);
procedure SpeedButtonTestMouseOverClick(Sender: TObject);
procedure ChartEndFloatingMarkerDrag(Sender: TJvChart;
FloatingMarker: TJvChartFloatingMarker);
procedure ChartBeginFloatingMarkerDrag(Sender: TJvChart;
FloatingMarker: TJvChartFloatingMarker);
procedure ChartChartPaint(Sender: TJvChart; aCanvas: TCanvas);
procedure NewFeaturesfor20071Click(Sender: TObject);
private
// Our waveform generator uses the following as state-variables:
FGenerationIndex: Integer;
Foo, Foo1, Foo2: Integer;
Fhgt, Fhg0, Fhg2p: Double;
FStatHgt, FStatHg0: TStatArray;
Fdt, Fds: Double;
FNegValueFlag: Boolean;
protected
procedure _Generate;
procedure _StoreValue(I: integer);
function _QAProblemScatter: Integer;
public
procedure NewValues;
end;
var
JvChartDemoForm: TJvChartDemoForm;
implementation
uses
LCLIntf, // OpenURL
LCLType, // MB_OK
Math; // Math:NaN handling, function isNan in D6 and higher.
{$R *.lfm}
{ Bogus vageuly sinusoidal signal generator }
procedure TJvChartDemoForm._Generate;
begin
FHgt := Abs(Random(80) + (Random(((FGenerationIndex div foo) mod foo1) * 250) * 5 + 9500));
FHg0 := Abs(Random(280) + Random(((FGenerationIndex div foo) mod foo2) * 650) * 5 + 1003);
if FNegValueFlag then
begin
if (Random(80) > 75) or (FGenerationIndex = 2) then
begin
FHg0 := -1 * FHg0; // Generate a negative value! (just to show what it looks like)
end;
end;
Inc(FGenerationIndex);
end;
{ Bogus random spiky-looking function to simulate a QA value,
which hovers within +/- 10% of perfect (100%), but
with relatively infrequent spiky errors }
function TJvChartDemoForm._QAProblemScatter: Integer;
var
n, m: Double;
begin
n := Log10(Random(10000) + 1); // Random is my favourite function. How about you? -WP
n := n * Log10(Random(10000) + 1);
m := Log10(Random(10000) + 1);
m := m * Log10(Random(10000) + 1);
n := Abs(100 + n - m);
if (n < 0) then
n := 0;
if (n > 150) then
n := 150;
Result := Round(n);
end;
procedure TJvChartDemoForm._StoreValue(I: integer);
begin
FStatHgt.AddValue(Fhgt);
FStatHg0.AddValue(Fhg0);
// PAY ATTENTION HERE, this is where we set the Chart.Data.Value[ index,pen] := <values>
// stuff which is the MOST IMPORTANT THING, unless you like blank charts:
// Set Data.Value[Pen, Series] := dataValue ...
Chart.Data.Value[0, I] := FStatHgt.Average / 1000;
if FHg0 < 0 then
begin
Chart.Data.Value[1, I] := FHg0 / 1000;
// Don't show average with negative samples or my negative demo ability goes away (averaged out!)
end
else
begin
// Test blanks on big chart, show missing data:
Chart.Data.Value[1, I] := FStatHg0.Average / 1000;
end;
Fhg2p := (FStatHgt.Average - FStatHg0.Average) / 1000;
if Fhg2p < 0.0 then
Fhg2p := 0.0;
Chart.Data.Value[2, I] := Fhg2p;
Fds := Fdt + (FGenerationIndex / 576);
// There are TWO ways to get an X Axis label plotted:
if DateTimeAxisMode.Checked then
Chart.Data.Timestamp[I] := Fds // X legends generated by timestamps
else
// X Legends generated by user are used by default.
// This would be redundant, and would be a waste of memory
// if Chart.Options.XAxisDateTimeMode was also set.
Chart.Options.XLegends.Add(FormatDateTime('hh:nn:ss', Fds));
if MenuSecondaryAxisMode.Checked then
begin
if I = 1 then
Chart.Data.Value[3, I] := 100
else
if (I mod 4) = 3 then
begin
//Chart.Data.Value[3,I] := 1+ ((I mod 12) * 10) // stairstep
//random:
Chart.Data.Value[3, I] := _QAProblemScatter;
end
else
Chart.Data.Value[3, I] := NaN; // leave some blanks.
end;
end;
procedure TJvChartDemoForm.NewFeaturesfor20071Click(Sender: TObject);
var
vbar:TJvChartVerticalBar;
hbar:TJvChartHorizontalBar;
begin
// Try out new features for 2007:
// Gradients.
Chart.Options.GradientColor := $00FDEEDB; // powder blue (baby blue) mostly white.
Chart.Options.GradientDirection :=grDown;
// Vertical Bar.
vbar := Chart.AddVerticalBar;
vbar.Color := $00FDDDC7;
vbar.Visible := true;
vbar.XLeft := 6;
vbar.XRight := 7;
// Horizontal Bar.
hbar := Chart.AddHorizontalBar;
hbar.Color := $007CCAC7;
hbar.Visible := true;
hbar.YTop := 3;
hbar.YBottom := 2;
// Lots of things not shown here are new in 2007:
// Floating Marker Count, Delete a floating marker, etc,
// search for 'NEW 2007' in JvChart.pas for a complete
// look at new things.
// last thing, always update graph:
Chart.PlotGraph;
//Chart.Refresh;
end;
procedure TJvChartDemoForm.NewValues;
var
I: Integer;
nValueCount: Integer;
begin
//Chart.Options.Title := 'Click on the Chart Title to change it!';
Chart.Options.PenCount := 3;
Chart.ClearFloatingMarkers; // remove any previous markers.
ListBox1.Clear;
Chart.Data.Clear;
Chart.Options.PrimaryYAxis.YMax := 20;
Randomize;
Chart.Options.XAxisDateTimeMode := DateTimeAxisMode.Checked; // Use datetime timestamp labels, just Fer Instance.
if not Chart.Options.XAxisDateTimeMode then
Chart.Options.XAxisLegendSkipBy := 5;
if LargeDataset576samples1.Checked then
begin
// A larger bogus data set for demonstration purposes.
nValueCount := 576; // 2.5 minute sample period, 576 samples = 1 day.
foo := 5; // Used in generating our bogus data below, not really important.
Chart.Options.XAxisValuesPerDivision := 24;
// 24 samples * 150 seconds = 1 hour time divisions ( Chart.Options.XAxisValuesPerDivision := 4;
end
else
begin
// A smaller bogus data set for demonstration purposes.
nValueCount := 24; // 2.5 minute sample period, 24 samples =1 hour.
foo := 1; // Used in generating our bogus data below, not really important.
Chart.Options.XAxisValuesPerDivision := 4; // five divisions, 4 values per division
end;
//Chart.ResetGraphModule; // Clears YMax.
Fdt := Trunc(now - 1.0); // yesterday, midnight.
Foo1 := Random(5) + 2; // more randomness
Foo2 := Random(3) + 5; // more randomness
FGenerationIndex := 1;
for I := 0 to nValueCount - 1 do
begin
if i > 0 then
begin // generate random data that appears to show a sawtooth-frequency-pattern plus a lot of random noise:
_Generate;
end
else
begin
Fhgt := 7000; // First sample always known value, helps me troubleshoot.
Fhg0 := 1000;
end;
_StoreValue(I);
// Override stored value in special cases:
{ How to make a gap in the data! }
if (nValueCount > 100) and ShowgapinLineChart1.Checked then
begin
if (I > 100) and (I < 130) then
begin
Chart.Data.Value[0, I] := NaN; // Use special Math.NaN const
Chart.Data.Value[1, I] := NaN; // Use special Math.NaN const
Chart.Data.Value[2, I] := NaN; // Use special Math.NaN const
end;
end;
// Just so that the last two values are visibly different, to make sure
// the chart handles the final vaulues correctly, we set all the final
// values to known amounts also:
if I = nValueCount - 2 then
begin
Chart.Data.Value[0, I] := 6.0; // Use special Math.NaN const
Chart.Data.Value[1, I] := 4.0; // Use special Math.NaN const
Chart.Data.Value[2, I] := 2.0; // Use special Math.NaN const
end
else
if I = nValueCount - 1 then
begin
Chart.Data.Value[0, I] := 3.0; // Use special Math.NaN const
Chart.Data.Value[1, I] := 2.0; // Use special Math.NaN const
Chart.Data.Value[2, I] := 1.0; // Use special Math.NaN const
end;
ListBox1.Items.Append(Chart.Data.DebugStr(I));
end;
with Chart.Options do
begin
Title := 'Chart Title';
XAxisHeader := 'Date/Time';
YAxisHeader := 'Readings (ng/m3)';
if FNegValueFlag then
begin
PrimaryYAxis.YMin := -20;
PrimaryYAxis.YMax := 20;
end
else
PrimaryYAxis.YMin := 0;
// Try out the pen styles:
if ChartKind = ckChartStackedBar then
PenStyle[0] := psClear // THIS IS HOW YOU TEMPORARILY HIDE ONE PEN!
else
PenStyle[0] := psSolid;
PenStyle[1] := psDash;
PenStyle[2] := psDot;
if MenuSecondaryAxisMode.Checked then
begin
PenCount := 4; // Add a pen for right side demo.
SecondaryYAxis.YMax := 140; // Example shows Q/A percentage. Experimental results
// results are compared to expected results, and the
// response percentage, is plotted from 0% to 140%
// of expected value.
SecondaryYAxis.YLegendDecimalPlaces := 2;
PenSecondaryAxisFlag[3] := True; // Move pen index 3 (Fourth pen) to secondary axis.
PenMarkerKind[3] := pmkDiamond;
PenValueLabels[3] := true; // Label with text.
PenStyle[3] := psClear; // Markers only, no lines.
PenColor[3] := clGray;
MarkerSize := 5; // Make 'em bigger.
end
else
begin
PenCount := 3;
MarkerSize := 3; // Make 'em little
end;
PenLegends.Clear;
PenLegends.Add('HgT');
PenLegends.Add('Hg0');
PenLegends.Add('Hg2+');
if MenuSecondaryAxisMode.Checked then
PenLegends.Add('Quality%');
PenUnit.Clear;
PenUnit.Add('ug/m3');
PenUnit.Add('ug/m3');
PenUnit.Add('ug/m3');
if MenuSecondaryAxisMode.Checked then
PenUnit.Add('%'); // Optional Pen in percentage scale.
//ShowLegend := TRUE;
Legend := clChartLegendBelow;
//ChartKind := ckChartLine;
end;
// Chart.AutoFormatGraph;
Chart.PlotGraph;
//Chart.ResizeChartCanvas;
end;
procedure TJvChartDemoForm.FormResize(Sender: TObject);
begin
if Assigned(Chart) then
Chart.ResizeChartCanvas;
end;
procedure TJvChartDemoForm.ButtonBarChartClick(Sender: TObject);
begin
Chart.Options.ChartKind := ckChartBar;
NewValues;
//Chart.PlotGraph;
end;
procedure TJvChartDemoForm.ButtonLineClick(Sender: TObject);
var
I: Integer;
begin
Chart.Options.ChartKind := ckChartLine;
for I := 0 to Chart.Options.PenCount - 1 do
begin
Chart.Options.PenMarkerKind[I] := pmkNone;
end;
NewValues;
end;
procedure TJvChartDemoForm.ButtonLineMarkerClick(Sender: TObject);
//var
// I:Integer;
begin
Chart.Options.ChartKind := ckChartLine;
Chart.Options.PenMarkerKind[0] := pmkDiamond; // demonstrate both Diamond and Circle Marks.
Chart.Options.PenMarkerKind[1] := pmkDiamond;
Chart.Options.PenMarkerKind[2] := pmkCircle;
NewValues;
end;
procedure TJvChartDemoForm.ButtonStackedBarAveClick(Sender: TObject);
begin
Chart.Options.ChartKind := ckChartStackedBarAverage;
NewValues;
end;
procedure TJvChartDemoForm.ButtonStackedBarClick(Sender: TObject);
begin
Chart.Options.ChartKind := ckChartStackedBar;
NewValues;
end;
procedure TJvChartDemoForm.SpeedButton7Click(Sender: TObject);
begin
// Chart.PivotData; // TODO: This causes exceptions. not sure why we want this.
end;
procedure TJvChartDemoForm.ButtonBarAveClick(Sender: TObject);
begin
//Chart.ShowAsBarWithAve;
Chart.Options.ChartKind := ckChartBarAverage;
NewValues;
//Chart.Plo
end;
procedure TJvChartDemoForm.ButtonPieClick(Sender: TObject);
begin
// Chart.ShowAsPie;
Chart.Options.ChartKind := ckChartPieChart;
end;
procedure TJvChartDemoForm.ButtonMarkersClick(Sender: TObject);
begin
//Chart.ShowAsMark;
Chart.Options.ChartKind := ckChartMarkers;
end;
procedure TJvChartDemoForm.SpinEdit1Change(Sender: TObject);
begin
// Chart.Options.ColorScheme := SpinEdit1.Value;
// Chart.PlotGraph;
end;
procedure TJvChartDemoForm.Button2Click(Sender: TObject);
begin
Chart.PlotGraph;
end;
procedure TJvChartDemoForm.Button4Click(Sender: TObject);
begin
// Chart.AutoFormatGraph; WAP Removed. BAD CODE.
Chart.PlotGraph;
end;
procedure TJvChartDemoForm.ButtonDeltaAverageClick(Sender: TObject);
begin
Chart.Options.ChartKind := ckChartDeltaAverage;
end;
procedure TJvChartDemoForm.FormCreate(Sender: TObject);
begin
FStatHgt := TStatArray.Create(10); // Initialize for rolling average of last 10 samples.
FStatHg0 := TStatArray.Create(10);
if Assigned(Chart) then
// Chart.ShowAsLineWithMark;
NewValues;
end;
procedure TJvChartDemoForm.Panel2DblClick(Sender: TObject);
begin
ShellExecute(HWND(nil), 'show', 'http://jvcl.delphi-jedi.org/', nil, nil, SW_SHOW);
end;
procedure TJvChartDemoForm.ShowgapinLineChart1Click(Sender: TObject);
begin
ShowgapinLineChart1.Checked := not ShowgapinLineChart1.Checked;
ButtonLine.Down := true;
NewValues;
end;
procedure TJvChartDemoForm.Print1Click(Sender: TObject);
begin
if PrintDialog1.Execute then
Chart.PrintGraph;
end;
procedure TJvChartDemoForm.Generatenewrandomvalues1Click(Sender: TObject);
begin
if SpeedButtonTestMouseOver.Down then exit;
NewValues;
end;
procedure TJvChartDemoForm.CopyToClipboard1Click(Sender: TObject);
begin
Chart.GraphToClipboard;
end;
procedure TJvChartDemoForm.mnuSetAxisFontClick(Sender: TObject);
begin
{Get the current font for the axis label texts...}
FontDialog1.Font.Assign(Chart.Options.AxisFont);
if FontDialog1.Execute then
{Set the font for the Header text...}
Chart.Options.AxisFont := FontDialog1.Font;
Chart.PlotGraph;
// Chart.Invalidate;
end;
procedure TJvChartDemoForm.mnuSetAxisTitlefontClick(Sender: TObject);
begin
{Get the current font for the axis titles...}
FontDialog1.Font.Assign(Chart.Font);
if FontDialog1.Execute then
{Set the font for the Header text...}
Chart.Font := FontDialog1.Font;
Chart.PlotGraph;
Chart.Invalidate;
end;
procedure TJvChartDemoForm.mnuSetHeaderFontClick(Sender: TObject);
begin
{Get the current font for the header (title) text...}
FontDialog1.Font.Assign(Chart.Options.HeaderFont);
if FontDialog1.Execute then
{Set the font for the Header text...}
Chart.Options.HeaderFont := FontDialog1.Font;
Chart.PlotGraph;
// Chart.Invalidate;
end;
procedure TJvChartDemoForm.mnuSetLegendFontClick(Sender: TObject);
begin
{Get the current font for the header (title) text...}
FontDialog1.Font.Assign(Chart.Options.LegendFont);
if FontDialog1.Execute then
{Set the font for the Header text...}
Chart.Options.LegendFont := FontDialog1.Font;
Chart.PlotGraph;
// Chart.Invalidate;
end;
procedure TJvChartDemoForm.About1Click(Sender: TObject);
begin
Application.MessageBox(PChar(
'JvChart comes from AABSoft Graph written by Mårten Henrichson, JVCL 3.0 ' +
'version by Warren Postma. '), 'About JvChart', MB_OK);
end;
procedure TJvChartDemoForm.mnuScrollingClick(Sender: TObject);
begin
if SpeedButtonTestMouseOver.Down then exit;
mnuScrolling.Checked := not mnuScrolling.Checked;
Timer1.Enabled := mnuScrolling.Checked;
end;
procedure TJvChartDemoForm.Timer1Timer(Sender: TObject);
begin
if SpeedButtonTestMouseOver.Down then exit;
Chart.Data.Scroll;
_Generate;
_StoreValue(Chart.Data.ValueCount - 1);
Chart.PlotGraph;
end;
procedure TJvChartDemoForm.ShowDataInListbox1Click(Sender: TObject);
begin
ShowDataInListbox1.Checked := not ShowDataInListbox1.Checked;
ListBox1.Visible := ShowDataInListbox1.Checked;
if not ShowDataInListbox1.Checked then
begin
Chart.CursorPosition := -1; // Invisible.
end;
end;
procedure TJvChartDemoForm.LargeDataset576samples1Click(Sender: TObject);
begin
if SpeedButtonTestMouseOver.Down then exit;
LargeDataset576samples1.Checked := not LargeDataset576samples1.Checked;
NewValues;
end;
procedure TJvChartDemoForm.DateTimeAxisModeClick(Sender: TObject);
begin
DateTimeAxisMode.Checked := not DateTimeAxisMode.Checked;
if SpeedButtonTestMouseOver.Down then begin
Chart.Options.XLegends.Clear;
end else
NewValues;
end;
procedure TJvChartDemoForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(FStatHgt);
FreeAndNil(FStatHg0);
end;
procedure TJvChartDemoForm.PrintOptions1Click(Sender: TObject);
begin
PrinterSetupDialog1.Execute;
end;
procedure TJvChartDemoForm.MenuSecondaryAxisModeClick(Sender: TObject);
begin
MenuSecondaryAxisMode.Checked := not MenuSecondaryAxisMode.Checked;
if MenuSecondaryAxisMode.Checked then
begin
ButtonLine.Down := true;
ButtonLineClick(Sender);
end
else
NewValues;
end;
procedure TJvChartDemoForm.ListBox1DblClick(Sender: TObject);
begin
Chart.CursorPosition := ListBox1.ItemIndex; // Highlight one sample.
end;
procedure TJvChartDemoForm.ListBox1Click(Sender: TObject);
begin
Chart.CursorPosition := ListBox1.ItemIndex; // Highlight one sample.
end;
procedure TJvChartDemoForm.MenuNegValueTestClick(Sender: TObject);
begin
FNegValueFlag := MenuNegValueTest.Checked;
NewValues;
end;
{ Simple Chart Tests for finding bug }
procedure TJvChartDemoForm.SpeedButtonTestMouseOverClick(Sender: TObject);
var
i:Integer;
n:Double;
marker1,marker2,draggableCursor:TJvChartFloatingMarker;
begin
ListBox1.Clear;
mnuScrolling.Checked := false;
Chart.Options.Title := 'Click on the Red Diamonds or the vertical gray line and Drag them!';
Chart.Options.ChartKind := ckChartLine;
Chart.Options.XLegends.Clear;
Chart.Options.XAxisHeader := '';
Chart.Options.MouseDragObjects := true; // NEW: MOUSE DRAG FLOATING OBJECTS!
for i := 0 to Chart.Options.PenCount - 1 do
begin
Chart.Options.PenMarkerKind[I] := pmkNone;
end;
Chart.Data.Clear;
Chart.Options.XValueCount := 80;
Chart.Data.ValueCount := 6;
Chart.Options.PenCount := 1;
for i := 0 to Chart.Options.XValueCount-1 do begin
n := 30-(25*((1-((i-25)/15))*(1-((i-25)/15))));
if n<5 then
n := 5 -(Sqrt((Abs(n))/15));
ListBox1.Items.Add( FloatToStrF(n,ffFixed,6,4));
Chart.Data.Value[0,i] := n;
end;
Chart.Options.PrimaryYAxis.YMax := 50;
Chart.Options.PenStyle[0] := psSolid;
// NEW: Add a floating marker:
marker1 := Chart.AddFloatingMarker;
marker1.XPosition := 13;
marker1.YPosition := Chart.Data.Value[0,marker1.XPosition]; // Snap to Pen 1
marker1.XDraggable := true; // make it mouse-moveable.
marker1.YDraggable := true;
marker1.Caption :='Start';
marker1.Visible := true;
marker2 := Chart.AddFloatingMarker;
marker2.XPosition := 66;
marker2.YPosition := Chart.Data.Value[0,marker2.XPosition]; // Snap to Pen 1
marker2.LineToMarker := marker1.index; // Connect with a line to marker1
marker2.XDraggable := true; // make it mouse-moveable.
marker2.YDraggable := true;
marker2.Caption := 'End';
marker2.Visible := true;
// NOTE: Do not Free marker1 or marker2.
// Marker objects are freed automatically
// by the Chart.
// a draggable cursor object:
draggableCursor := Chart.AddFloatingMarker;
draggableCursor.LineVertical := true; // Make a vertical Line
draggableCursor.Marker := pmkNone; // No marker. So it is a line only.
draggableCursor.XDraggable := true; // make it draggable.
draggableCursor.XPosition := 40;
draggableCursor.LineColor := clDkGray;
draggableCursor.LineStyle := psSolid;
draggableCursor.LineWidth := 2;
draggableCursor.Caption := FloatToStrF( Chart.Data.Value[0,draggableCursor.XPosition], ffFixed, 6,4 );
draggableCursor.Visible := true;
Chart.PlotGraph;
end;
procedure TJvChartDemoForm.ChartEndFloatingMarkerDrag(Sender: TJvChart;
FloatingMarker: TJvChartFloatingMarker);
begin
// Snap to line:
if (FloatingMarker.Index<2) then // One of the first two markers?
FloatingMarker.YPosition := Chart.Data.Value[0, FloatingMarker.XPosition]
else // update caption
FloatingMarker.Caption := FloatToStrF( Chart.Data.Value[0,FloatingMarker.XPosition],ffFixed,6,4 );
end;
procedure TJvChartDemoForm.ChartBeginFloatingMarkerDrag(Sender: TJvChart;
FloatingMarker: TJvChartFloatingMarker);
begin
if FloatingMarker.Index=2 then
FloatingMarker.Caption := '?';
end;
procedure TJvChartDemoForm.ChartChartPaint(Sender: TJvChart;
aCanvas: TCanvas);
begin
aCanvas.Pen.Color := clRed;
aCanvas.Pen.Style := psSolid;
aCanvas.MoveTo(0,0);
aCanvas.LineTo(100,100);
end;
end.

268
components/jvcllaz/examples/JvChartDemo/statsclasses.pas Normal file
View File

@ -0,0 +1,268 @@
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvChartDemoFm.Pas, released on 2002-10-04.
The Initial Developer of the Original Code is AABsoft and Mårten Henrichson.
(C) 1996 AABsoft and Mårten Henrichson.
All Rights Reserved.
Contributor(s): -
Last Modified: 2004-01-07
Modified 2003 Warren Postma
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Description:
TStatArray - Statistics, Rolling average helper class.
Known Issues:
This version is part of JvChartDemo.
-----------------------------------------------------------------------------}
{$MODE OBJFPC}{$H+}
unit StatsClasses;
interface
type
TStatArray = class
protected
//FFirst:Boolean;
FGrows:Boolean; // false=rolling average (circular buffer mode), true=average or sd of any number of samples (array grows without limit)
FValues:Array of Double;
FLength, // Array absolute size (may still be no data even if this is >0)
FIndex, // Where will the next sample be stored into the array?
FCount: // How many valid samples are in the array right now?
Integer;
procedure SetLen(aLength:Integer);
public
procedure AddValue(aValue:Double);
function Average:Double;
function StandardDeviation:Double;
property Grows:Boolean read FGrows write FGrows; // false=rolling average, true=average ALL samples (grows to fit)
property Length:Integer read FLength write SetLen;
property Count:Integer read FCount;
//property First:Boolean read FFirst;
procedure Reset; // Clear everything!
constructor Create; overload;
constructor Create(initialLength:Integer); overload;
destructor Destroy; override;
end;
implementation
uses //Windows, // OutputDebugString
SysUtils, // FloatToStr
Math; // VCL's statistics routines. StdDev, etc.
// Begin Rolling Average
constructor TStatArray.Create; // overload;
begin
//FFirst := true;
FLength := 0;
FIndex := 0;
FCount:= 0;
FGrows := true;
SetLength(FValues,0);
end;
procedure TStatArray.Reset;
var
i:Integer;
begin
FIndex := 0;
FCount := 0;
for i := 0 to FLength-1 do begin
FValues[i] := -999.0; // debug helper.
end;
//FFirst := true;
end;
constructor TStatArray.Create(initialLength:Integer); // overload;
begin
// FFirst := true;
SetLength(FValues,initialLength);
if (initialLength>0) then
FGrows := false
else
FGrows := true;
FLength := initialLength;
FIndex := 0;
FCount:= 0;
end;
destructor TStatArray.Destroy;
begin
SetLength(FValues,0);
end;
function TStatArray.Average:Double;
var
last,i:Integer;
sum:Double;
begin
if FCount <= 0 then begin
result := 0;
end else begin
sum := 0;
if (FCount>FLength) then
last :=FLength-1
else
last :=FCount-1;
for i := 0 to last do begin
sum := sum + FValues[i];
end;
result := sum / (last+1);
end;
end;
function TStatArray.StandardDeviation:Double;
var
i:Integer;
// sum:Double;
TempArray:Array of Double;
begin
if (FCount <= 0) then
result := 0
else if (FCount >= FLength) then begin
result := Math.StdDev( FValues )
end else begin
SetLength(TempArray,FCount);
for i := 0 to FCount-1 do begin
TempArray[i] := FValues[i];
end;
result := Math.StdDev( TempArray );
SetLength(TempArray,0);
end;
end;
procedure TStatArray.AddValue(aValue:Double);
//var
// i:Integer;
begin
(*if FFirst then begin
FFirst := false;
FIndex := 0;
FValues[0] := aValue;
FCount := 1;
end else begin*)
// First time in we might need to create an array:
if FIndex>=Length then begin
Assert(FGrows); // Illegal condition.
FLength := FIndex+1;
SetLength( FValues,FLength); // uninitialized, as of yet.
end;
FValues[FIndex] := aValue;
Inc(FIndex);
Inc(FCount);
if (not FGrows) then begin // circular?
if (FIndex>=FLength) then begin
FIndex := 0;
//FCount := FLength;//FCount does not exceed FLength in wraparounds.
end;
end else begin // grow after, in doublings of size, scales better!
if (FIndex>=FLength) then begin
FLength := FLength * 2;
SetLength( FValues,FLength); // uninitialized, as of yet.
{$ifdef DEBUG_ASSERTIONS}
Assert(FLength<20000); // Debug limit
{$endif}
end;
end;
end;
procedure TStatArray.SetLen(aLength:Integer);
begin
if(aLength<1) then
aLength := 1;
FLength := aLength;
SetLength(FValues, FLength);
end;
// End Stats
{$ifdef UNIT_TESTS}
procedure StatsUnitTests;
var
diff:Double;
a1:TStatArray;
procedure _outs(s:String);
begin
OutputDebugString(PChar(s));
end;
procedure _outd(d:Double);
begin
OutputDebugString(PChar(FloatToStr(d)));
end;
begin
_outs('StatsUnitTests begins');
a1 := TStatArray.Create(0); // Growing array.
a1.AddValue( 3.5 );
a1.AddValue( 1.5 );
a1.AddValue( 25.5 );
a1.AddValue( 100.5 );
_outd( a1.Average );
diff := Abs(((3.5+1.5+25.5+100.5)/4.0)-a1.Average);
Assert(diff<0.001);
a1.Reset;
Assert(Abs(a1.Average)<0.0001);
a1.AddValue( 3.5 );
a1.AddValue( 1.5 );
a1.AddValue( 25.5 );
a1.AddValue( 100.5 );
_outd( a1.Average );
diff := Abs(((3.5+1.5+25.5+100.5)/4.0)-a1.Average);
Assert(diff<0.001);
_outd( a1.StandardDeviation );
Assert(trunc(a1.StandardDeviation)=46);
_outs('StatsUnitTests ends');
end;
initialization
StatsUnitTests;
{$endif}
end.

6
components/jvcllaz/packages/jvcustomlazr.lpk
View File

@ -16,7 +16,7 @@
TimeLine, OutlookBar, Thumbnail viewer, ImageViewer, ImageListViewer, OwnerDrawViewer"/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="6"/>
<Files Count="13">
<Files Count="14">
<Item1>
<Filename Value="..\run\JvCustomControls\jvtimeline.pas"/>
<UnitName Value="JvTimeLine"/>
@ -69,6 +69,10 @@ TimeLine, OutlookBar, Thumbnail viewer, ImageViewer, ImageListViewer, OwnerDrawV
<Filename Value="..\run\JvCustomControls\jvgammapanel.pas"/>
<UnitName Value="JvGammaPanel"/>
</Item13>
<Item14>
<Filename Value="..\run\JvCustomControls\jvchart.pas"/>
<UnitName Value="JvChart"/>
</Item14>
</Files>
<RequiredPkgs Count="2">
<Item1>

BIN
components/jvcllaz/resource/jvcustomreg.res
View File

Binary file not shown.

113
components/jvcllaz/run/JvCore/jvjclutils.pas
View File

@ -47,7 +47,7 @@ interface
uses
LCLIntf, LCLType,
SysUtils, Classes, Graphics,
SysUtils, Classes, Graphics, SysConst,
JvTypes;
const
@ -95,8 +95,18 @@ const
NullDate: TDateTime = {-693594} 0;
*)
function JvSafeStrToFloatDef(const Str: string; Def: Extended; aDecimalSeparator: Char): Extended;
function JvSafeStrToFloat(const Str: string; aDecimalSeparator: Char): Extended;
{ there is a STrToIntDef provided by Delphi, but no "safe" versions of
StrToFloat or StrToCurr }
// Note: before using JvSafeStrToFloatDef, please be aware that it will ignore
// any character that is not a valid character for a float, which is different
// from what StrToFloatDef in Delphi 6 up is doing. This has been documented in Mantis
// issue# 2935: http://issuetracker.delphi-jedi.org/view.php?id=2935
// and in Mantis 4466: http://issuetracker.delphi-jedi.org/view.php?id=4466
function JvSafeStrToFloatDef(const Str: string; Def: Extended;
aDecimalSeparator: Char = ' '): Extended; // {NOTE: default value of Space is a magic wildcard}
function JvSafeStrToFloat(const Str: string; aDecimalSeparator: Char = ' '): Extended; // {NOTE: default value of Space is a magic wildcard}
(******************* NOT CONVERTED ******
function USToLocalFloatStr(const Text: string): string;
@ -1551,6 +1561,102 @@ begin
raise EJvConvertError.CreateResFmt(ResString, Args); { will be also caught if you catch E:EConvertERror }
end;
{ _JvSafeStrToFloat: [PRIVATE INTERNAL FUNCTION]
[ not to be called outside this unit, see below for public api ]
This is a refactored version of the internal guts of the former routine
StrToFloatDefIgnoreInvalidCharacters with some improvements made to decimal
separator handling.
}
function _JvSafeStrToFloat(const Str: string; aDecimalSeparator: Char; var OutValue: Extended): Boolean;
var
LStr: String;
I: Integer;
CharSet: TSysCharSet;
LocalFormatSettings: TFormatSettings;
begin
Result := false;
if Str = '' then
Exit; { hows this for a nice optimization? WPostma. }
{ Locale Handling logic October 2008 supercedes former StrToFloatUS functionality. }
{$IFDEF RTL150_UP}
LocalFormatSettings.ThousandSeparator := GetLocaleChar(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, '.');
LocalFormatSettings.DecimalSeparator := GetLocaleChar(LOCALE_USER_DEFAULT, LOCALE_SDECIMAL, '.');
{$ELSE}
LocalFormatSettings.DecimalSeparator := DecimalSeparator;
{$ENDIF RTL150_UP}
if aDecimalSeparator = ' ' then {magic mode}
aDecimalSeparator := LocalFormatSettings.DecimalSeparator { default case! use system defaults! }
else
LocalFormatSettings.DecimalSeparator := aDecimalSeparator; { custom format specified! }
{ Cross-codepage safety feature: Handed '1.2', a string without a comma,
but which is obviously a floating point number, convert it properly also.
This functionality is important for JvCsvDataSet and may be important in other
places. }
if (Pos(USDecimalSeparator, Str) > 0) and (Pos(aDecimalSeparator, Str) = 0) then
begin
aDecimalSeparator := USDecimalSeparator; { automatically works when US decimal values are encountered }
LocalFormatSettings.DecimalSeparator := aDecimalSeparator; { custom format specified! }
end;
LStr := '';
CharSet := ['0'..'9', '-', '+', 'e', 'E', AnsiChar(aDecimalSeparator)];
for I := 1 to Length(Str) do
if CharInSet(Str[I], CharSet) then
LStr := LStr + Str[I];
{ the string '-' fails StrToFloat, but it can be interpreted as 0 }
if LStr = '-' then
LStr := '0';
if Length(LStr) > 0 then
try
{ a string that ends in a '.' such as '12.' fails StrToFloat,
but as far as I am concerned, it may as well be interpreted as 12.0 }
if LStr[Length(LStr)] = aDecimalSeparator then
LStr := LStr + '0';
Result := TryStrToFloat(LStr, OutValue, LocalFormatSettings);
except
Result := False;
end;
end;
// JvSafeStrToFloatDef:
//
// Note: before using StrToFloatDef, please be aware that it will ignore
// any character that is not a valid character for a float, which is different
// from what the one in Delphi 6 up is doing. This has been documented in Mantis
// issue# 2935: http://homepages.borland.com/jedi/issuetracker/view.php?id=2935
//
// This function was extended by WPostma, to allow specification of custom decimal
// separators. This was required by JvCsvDataSet and may be required elsewhere in the
// VCL wherever custom (fixed) non-current-region-settings floating point value
// encoding must be supported. We renamed this from StrToFloatDefIgnoreInvalidCharacters
// to JvSafeStrToFloatDef because it has multiple "floating point runtime exception safety"
// enhancements.
function JvSafeStrToFloatDef(const Str: string; Def: Extended;
aDecimalSeparator: Char = ' '): Extended;
begin
{ one handy dandy api expects a Default value returned instead }
if not _JvSafeStrToFloat(Str, aDecimalSeparator, Result) then
Result := Def; { failed, use default }
end;
// New routine, same as JvSafeStrToFloatDef but it will raise a conversion exception,
// for cases when you actually want to handle an EConvertError yourself and where
// there is no convenient or possible float value for your case.
function JvSafeStrToFloat(const Str: string;
aDecimalSeparator: Char = ' '): Extended;
begin
{ the other handy dandy api style expects us to raise an EConvertError. }
if not _JvSafeStrToFloat(Str, aDecimalSeparator, Result) then
JvStrConvertErrorFmt(@SInvalidFloat, [Str]); {failed, raise exception }
end;
(*
function _JvSafeStrToFloat(const Str: String; aDecimalSeparator: Char; out AValue: Extended): Boolean;
var
LocalFormatSettings: TFormatSettings;
@ -1591,6 +1697,7 @@ begin
if not _JvSafeStrToFloat(Str, aDecimalSeparator, Result) then
JvStrConvertErrorFmt(@SParInvalidFloat, [Str]); {failed, raise exception }
end;
*)
(******************** NOT CONVERTED ***
function StrToFloatUSDef(const Text: string; Default: Extended): Extended;

6034
components/jvcllaz/run/JvCustomControls/jvchart.pas Normal file
View File

File diff suppressed because it is too large Load Diff