You've already forked lazarus-ccr
jvcllaz: Add Jan's simulation components (JvJansSim), incl JvSimScope demo.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6242 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -1 +1,11 @@
|
|||||||
tjvyeargrid.bmp
|
tjvyeargrid.bmp
|
||||||
|
tjvsimlogicbox.bmp
|
||||||
|
tjvsimindicator.bmp
|
||||||
|
tjvsimconnector.bmp
|
||||||
|
tjvsimpid.bmp
|
||||||
|
tjvsimpidlinker.bmp
|
||||||
|
tjvsimscope.bmp
|
||||||
|
tjvsimbutton.bmp
|
||||||
|
tjvsimreverse.bmp
|
||||||
|
tjvsimlight.bmp
|
||||||
|
tjvlogic.bmp
|
||||||
|
|||||||
BIN
components/jvcllaz/design/JvJans/images/tjvlogic.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvlogic.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimbin.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimbin.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimbutton.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimbutton.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimconnector.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimconnector.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimindicator.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimindicator.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimlight.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimlight.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimlogicbox.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimlogicbox.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimpid.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimpid.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimpidlinker.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimpidlinker.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimreverse.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimreverse.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvJans/images/tjvsimscope.bmp
Normal file
BIN
components/jvcllaz/design/JvJans/images/tjvsimscope.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
@ -14,13 +14,22 @@ implementation
|
|||||||
{$R ../../resource/jvjansreg.res}
|
{$R ../../resource/jvjansreg.res}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, JvDsgnConsts, JvYearGrid;
|
Classes, JvDsgnConsts,
|
||||||
|
JvYearGrid,
|
||||||
|
JvSimScope, JvSimIndicator, JvSimPID, JvSimPIDLinker, JvSimLogic;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
begin
|
begin
|
||||||
RegisterComponents(RsPaletteJvcl, [
|
RegisterComponents(RsPaletteJvcl, [
|
||||||
TJvYearGrid
|
TJvYearGrid
|
||||||
]);
|
]);
|
||||||
|
|
||||||
|
// Simulator Components
|
||||||
|
RegisterComponents(RsPaletteJvcl, [ // was: RsPaletteJansSim
|
||||||
|
TJvSimScope, TJvSimIndicator, TJvSimPID,
|
||||||
|
TJvSimPIDLinker, TJvSimConnector, TJvLogic, TJvSimButton, TJvSimLight,
|
||||||
|
TJvSimLogicBox, TJvSimReverse]);
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|||||||
81
components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpi
Normal file
81
components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpi
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="JvSimScopeDemo"/>
|
||||||
|
<Scaled Value="True"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<XPManifest>
|
||||||
|
<DpiAware Value="True"/>
|
||||||
|
</XPManifest>
|
||||||
|
<Icon Value="0"/>
|
||||||
|
</General>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
<Modes Count="0"/>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="JvJansLazR"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="JvSimScopeDemo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="MainForm.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="frmMain"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="..\..\bin\JvSimScopeDemo"/>
|
||||||
|
</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>
|
||||||
16
components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpr
Normal file
16
components/jvcllaz/examples/JvSimScope/JvSimScopeDemo.lpr
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
program JvSimScopeDemo;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Forms, Interfaces, LclVersion,
|
||||||
|
MainForm in 'MainForm.pas' {frmMain};
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
{$IF LCL_FullVersion >= 1080000}
|
||||||
|
Application.Scaled := True;
|
||||||
|
{$ENDIF}
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TfrmMain, frmMain);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
93
components/jvcllaz/examples/JvSimScope/MainForm.lfm
Normal file
93
components/jvcllaz/examples/JvSimScope/MainForm.lfm
Normal file
@ -0,0 +1,93 @@
|
|||||||
|
object frmMain: TfrmMain
|
||||||
|
Left = 0
|
||||||
|
Height = 271
|
||||||
|
Top = 0
|
||||||
|
Width = 541
|
||||||
|
BorderStyle = bsSingle
|
||||||
|
Caption = 'JvSimScope demo'
|
||||||
|
ClientHeight = 271
|
||||||
|
ClientWidth = 541
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Position = poScreenCenter
|
||||||
|
LCLVersion = '1.9.0.0'
|
||||||
|
object jssRandom: TJvSimScope
|
||||||
|
Left = 264
|
||||||
|
Height = 208
|
||||||
|
Top = 48
|
||||||
|
Width = 256
|
||||||
|
Active = False
|
||||||
|
BaseLine = 0
|
||||||
|
BaseLineUnit = jluAbsolute
|
||||||
|
DisplayUnits = jduLogical
|
||||||
|
Interval = 100
|
||||||
|
Lines = <
|
||||||
|
item
|
||||||
|
Name = 'Random'
|
||||||
|
Color = clAqua
|
||||||
|
Position = 0
|
||||||
|
PositionUnit = jluAbsolute
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Name = 'Random 2'
|
||||||
|
Color = clYellow
|
||||||
|
Position = 0
|
||||||
|
PositionUnit = jluAbsolute
|
||||||
|
end>
|
||||||
|
Minimum = -100
|
||||||
|
Maximum = 100
|
||||||
|
TotalTimeSteps = 240
|
||||||
|
OnUpdate = jssRandomUpdate
|
||||||
|
end
|
||||||
|
object lblRandomDetails1: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 80
|
||||||
|
Top = 48
|
||||||
|
Width = 232
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'This scope shows random values but uses logical units to show a more advanced usage. Here, the Minimum and Maximum values are used and can be adjusted to make the lines fit in the display.'
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 96
|
||||||
|
Top = 128
|
||||||
|
Width = 225
|
||||||
|
AutoSize = False
|
||||||
|
Caption = 'The yellow line values are meant to go higher than the maximum value set at design time for the scope. Use the button below to change that value and notice how the lines are completely adjusted to this change.'
|
||||||
|
ParentColor = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object lblWelcome: TLabel
|
||||||
|
AnchorSideLeft.Control = Owner
|
||||||
|
AnchorSideLeft.Side = asrCenter
|
||||||
|
Left = 114
|
||||||
|
Height = 28
|
||||||
|
Top = 8
|
||||||
|
Width = 312
|
||||||
|
Caption = 'Welcome to the TJvSimScope demo'
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -20
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
end
|
||||||
|
object btnActivateDeactivateRandom: TButton
|
||||||
|
Left = 32
|
||||||
|
Height = 25
|
||||||
|
Top = 232
|
||||||
|
Width = 75
|
||||||
|
Caption = 'Activate'
|
||||||
|
OnClick = btnActivateDeactivateRandomClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object btnAdjustMax: TButton
|
||||||
|
Left = 113
|
||||||
|
Height = 25
|
||||||
|
Top = 232
|
||||||
|
Width = 100
|
||||||
|
Caption = 'Adjust Max value'
|
||||||
|
OnClick = btnAdjustMaxClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
93
components/jvcllaz/examples/JvSimScope/MainForm.pas
Normal file
93
components/jvcllaz/examples/JvSimScope/MainForm.pas
Normal file
@ -0,0 +1,93 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: MainForm.pas, released on 2007-02-06.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Olivier Sannier [obones att altern dott org]
|
||||||
|
Portions created by Olivier Sannier are Copyright (C) 2007 Olivier Sannier.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s): None to date.
|
||||||
|
|
||||||
|
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:
|
||||||
|
Demonstrates the usage of TJvSimScope
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
unit MainForm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||||
|
Dialogs, JvSimScope, StdCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
TfrmMain = class(TForm)
|
||||||
|
jssRandom: TJvSimScope;
|
||||||
|
lblRandomDetails1: TLabel;
|
||||||
|
btnActivateDeactivateRandom: TButton;
|
||||||
|
btnAdjustMax: TButton;
|
||||||
|
Label1: TLabel;
|
||||||
|
lblWelcome: TLabel;
|
||||||
|
procedure jssRandomUpdate(Sender: TObject);
|
||||||
|
procedure btnActivateDeactivateRandomClick(Sender: TObject);
|
||||||
|
procedure btnAdjustMaxClick(Sender: TObject);
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmMain: TfrmMain;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
{ TfrmMain }
|
||||||
|
|
||||||
|
procedure TfrmMain.btnActivateDeactivateRandomClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
jssRandom.Active := not jssRandom.Active;
|
||||||
|
if jssRandom.Active then
|
||||||
|
btnActivateDeactivateRandom.Caption := 'Deactivate'
|
||||||
|
else
|
||||||
|
btnActivateDeactivateRandom.Caption := 'Activate';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.btnAdjustMaxClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
LineMax: Integer;
|
||||||
|
begin
|
||||||
|
// We check all values of line number 1 to see if there is one that is greater
|
||||||
|
// than the current max value of the scope. If so, we change the Maximum value
|
||||||
|
// to demonstrate how redrawing is done and how past values were kept to allow
|
||||||
|
// redrawing with a new scale.
|
||||||
|
LineMax := jssRandom.Minimum;
|
||||||
|
for I := 0 to jssRandom.Lines[1].Values.Count - 1 do
|
||||||
|
begin
|
||||||
|
if jssRandom.Lines[1].Values[I] > LineMax then
|
||||||
|
LineMax := jssRandom.Lines[1].Values[I];
|
||||||
|
end;
|
||||||
|
|
||||||
|
if LineMax > jssRandom.Maximum then
|
||||||
|
jssRandom.Maximum := LineMax;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.jssRandomUpdate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
jssRandom.Lines[0].Position := Random(200) - 100;
|
||||||
|
jssRandom.Lines[1].Position := Random(200); // this one will eventually go out of scope
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@ -1,7 +1,7 @@
|
|||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<ProjectGroup FileVersion="1">
|
<ProjectGroup FileVersion="1">
|
||||||
<Targets Count="19">
|
<Targets Count="21">
|
||||||
<Target0 FileName="JvCoreLazR.lpk"/>
|
<Target0 FileName="JvCoreLazR.lpk"/>
|
||||||
<Target1 FileName="JvCoreLazD.lpk"/>
|
<Target1 FileName="JvCoreLazD.lpk"/>
|
||||||
<Target2 FileName="JvCtrlsLazR.lpk"/>
|
<Target2 FileName="JvCtrlsLazR.lpk"/>
|
||||||
@ -21,6 +21,8 @@
|
|||||||
<Target16 FileName="jvcustomlazr.lpk"/>
|
<Target16 FileName="jvcustomlazr.lpk"/>
|
||||||
<Target17 FileName="jvcustomlazd.lpk"/>
|
<Target17 FileName="jvcustomlazd.lpk"/>
|
||||||
<Target18 FileName="jvcmpr.lpk"/>
|
<Target18 FileName="jvcmpr.lpk"/>
|
||||||
|
<Target19 FileName="jvjanslazr.lpk"/>
|
||||||
|
<Target20 FileName="jvjanslazd.lpk"/>
|
||||||
</Targets>
|
</Targets>
|
||||||
</ProjectGroup>
|
</ProjectGroup>
|
||||||
</CONFIG>
|
</CONFIG>
|
||||||
|
|||||||
@ -2,7 +2,7 @@
|
|||||||
<CONFIG>
|
<CONFIG>
|
||||||
<Package Version="4">
|
<Package Version="4">
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<Name Value="jvjanslazd"/>
|
<Name Value="JvJansLazD"/>
|
||||||
<Type Value="RunAndDesignTime"/>
|
<Type Value="RunAndDesignTime"/>
|
||||||
<Author Value="Original author: Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]"/>
|
<Author Value="Original author: Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]"/>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
@ -11,11 +11,12 @@
|
|||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="..\run\JvJans"/>
|
<IncludeFiles Value="..\run\JvJans"/>
|
||||||
<OtherUnitFiles Value="..\run\JvJans;..\design\JvJans"/>
|
<OtherUnitFiles Value="..\run\JvJans;..\design\JvJans"/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code of Jan's Components):
|
<Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (designtime code of Jan's Components):
|
||||||
- YearGrid"/>
|
- YearGrid
|
||||||
|
- Simulation components"/>
|
||||||
<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. "/>
|
<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="4"/>
|
<Version Major="1" Release="4"/>
|
||||||
<Files Count="1">
|
<Files Count="1">
|
||||||
|
|||||||
@ -2,21 +2,22 @@
|
|||||||
<CONFIG>
|
<CONFIG>
|
||||||
<Package Version="4">
|
<Package Version="4">
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<Name Value="jvjanslazr"/>
|
<Name Value="JvJansLazR"/>
|
||||||
<Author Value="Original author: Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]"/>
|
<Author Value="Original author: Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]"/>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
<Version Value="11"/>
|
<Version Value="11"/>
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<OtherUnitFiles Value="..\run\JvJans"/>
|
<OtherUnitFiles Value="..\run\JvJans"/>
|
||||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code of Jan's Components):
|
<Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code of Jan's Components):
|
||||||
- YearGrid"/>
|
- YearGrid
|
||||||
|
- Simulation components"/>
|
||||||
<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. "/>
|
<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="4"/>
|
<Version Major="1" Release="4"/>
|
||||||
<Files Count="2">
|
<Files Count="7">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="..\run\JvJans\JvYearGrid.pas"/>
|
<Filename Value="..\run\JvJans\JvYearGrid.pas"/>
|
||||||
<UnitName Value="JvYearGrid"/>
|
<UnitName Value="JvYearGrid"/>
|
||||||
@ -25,6 +26,26 @@
|
|||||||
<Filename Value="..\run\JvJans\JvYearGridEditForm.pas"/>
|
<Filename Value="..\run\JvJans\JvYearGridEditForm.pas"/>
|
||||||
<UnitName Value="JvYearGridEditForm"/>
|
<UnitName Value="JvYearGridEditForm"/>
|
||||||
</Item2>
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Filename Value="..\run\JvJans\JvSimIndicator.pas"/>
|
||||||
|
<UnitName Value="JvSimIndicator"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<Filename Value="..\run\JvJans\JvSimLogic.pas"/>
|
||||||
|
<UnitName Value="JvSimLogic"/>
|
||||||
|
</Item4>
|
||||||
|
<Item5>
|
||||||
|
<Filename Value="..\run\JvJans\JvSimPID.pas"/>
|
||||||
|
<UnitName Value="JvSimPID"/>
|
||||||
|
</Item5>
|
||||||
|
<Item6>
|
||||||
|
<Filename Value="..\run\JvJans\JvSimPIDLinker.pas"/>
|
||||||
|
<UnitName Value="JvSimPIDLinker"/>
|
||||||
|
</Item6>
|
||||||
|
<Item7>
|
||||||
|
<Filename Value="..\run\JvJans\JvSimScope.pas"/>
|
||||||
|
<UnitName Value="JvSimScope"/>
|
||||||
|
</Item7>
|
||||||
</Files>
|
</Files>
|
||||||
<RequiredPkgs Count="2">
|
<RequiredPkgs Count="2">
|
||||||
<Item1>
|
<Item1>
|
||||||
|
|||||||
BIN
components/jvcllaz/resource/JvSimImages.res
Normal file
BIN
components/jvcllaz/resource/JvSimImages.res
Normal file
Binary file not shown.
Binary file not shown.
@ -26,7 +26,6 @@ Known Issues:
|
|||||||
unit JvMovableBevel;
|
unit JvMovableBevel;
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
//{$I jvcl.inc}
|
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
@ -41,9 +40,6 @@ type
|
|||||||
tdRightToLeft, tdTopLeftToBottomRight, tdTopRightToBottomLeft,
|
tdRightToLeft, tdTopLeftToBottomRight, tdTopRightToBottomLeft,
|
||||||
tdBottomLeftToTopRight, tdBottomRightToTopLeft);
|
tdBottomLeftToTopRight, tdBottomRightToTopLeft);
|
||||||
|
|
||||||
// {$IFDEF RTL230_UP}
|
|
||||||
// [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
|
|
||||||
// {$ENDIF RTL230_UP}
|
|
||||||
TJvMovableBevel = class(TBevel) //TJvExBevel)
|
TJvMovableBevel = class(TBevel) //TJvExBevel)
|
||||||
private
|
private
|
||||||
FStartX: Integer;
|
FStartX: Integer;
|
||||||
@ -69,8 +65,6 @@ type
|
|||||||
X, Y: Integer); override;
|
X, Y: Integer); override;
|
||||||
procedure MouseEnter; override;
|
procedure MouseEnter; override;
|
||||||
procedure MouseLeave; override;
|
procedure MouseLeave; override;
|
||||||
// procedure MouseEnter(Control: TControl); override;
|
|
||||||
// procedure MouseLeave(Control: TControl); override;
|
|
||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
published
|
published
|
||||||
|
|||||||
203
components/jvcllaz/run/JvJans/JvSimIndicator.pas
Normal file
203
components/jvcllaz/run/JvJans/JvSimIndicator.pas
Normal file
@ -0,0 +1,203 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: JvSimIndicator.PAS, released on 2002-06-15.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
|
||||||
|
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s): Robert Love [rlove att slcdug dott org].
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvSimIndicator;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
LCLIntf,
|
||||||
|
SysUtils, Classes, Graphics, Controls, ExtCtrls,
|
||||||
|
JvComponent, JvJVCLUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvSimIndicator = class(TJvGraphicControl)
|
||||||
|
private
|
||||||
|
FValue: Integer;
|
||||||
|
FMaximum: Integer;
|
||||||
|
FMinimum: Integer;
|
||||||
|
FBarColor: TColor;
|
||||||
|
FBackColor: TColor;
|
||||||
|
FMargins: TJvRect;
|
||||||
|
procedure SetBarColor(const Value: TColor);
|
||||||
|
procedure SetMaximum(const Value: Integer);
|
||||||
|
procedure SetMinimum(const Value: Integer);
|
||||||
|
procedure SetValue(const Value: Integer);
|
||||||
|
procedure SetBackColor(const Value: TColor);
|
||||||
|
procedure SetMargins(const Value: TJvRect);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Paint; override;
|
||||||
|
published
|
||||||
|
property Value: Integer read FValue write SetValue;
|
||||||
|
property Minimum: Integer read FMinimum write SetMinimum default 0;
|
||||||
|
property Maximum: Integer read FMaximum write SetMaximum default 100;
|
||||||
|
property BarColor: TColor read FBarColor write SetBarColor default clLime;
|
||||||
|
property BackColor: TColor read FBackColor write SetBackColor default clSilver;
|
||||||
|
property Width default 25;
|
||||||
|
property Height default 100;
|
||||||
|
property Margins: TJvRect read FMargins write SetMargins;
|
||||||
|
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
property ParentShowHint;
|
||||||
|
property ShowHint;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
// property OnCanResize; --- wp removed
|
||||||
|
property OnClick;
|
||||||
|
property OnConstrainedResize;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDock;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseEnter;
|
||||||
|
property OnMouseLeave;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnMouseWheel;
|
||||||
|
property OnMouseWheelDown;
|
||||||
|
property OnMouseWheelUp;
|
||||||
|
property OnResize;
|
||||||
|
property OnStartDock;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
constructor TJvSimIndicator.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
Width := 25;
|
||||||
|
Height := 100;
|
||||||
|
FMinimum := 0;
|
||||||
|
FMaximum := 100;
|
||||||
|
FValue := 50;
|
||||||
|
FBarColor := clLime;
|
||||||
|
FBackColor := clSilver;
|
||||||
|
FMargins := TJvRect.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvSimIndicator.Destroy;
|
||||||
|
begin
|
||||||
|
FMargins.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimIndicator.Paint;
|
||||||
|
const
|
||||||
|
NumberOfBars = 20;
|
||||||
|
var
|
||||||
|
R, Ri: TRect;
|
||||||
|
I, n: Integer;
|
||||||
|
h, dh: Integer;
|
||||||
|
begin
|
||||||
|
R := ClientRect;
|
||||||
|
Canvas.Brush.Color := clSilver;
|
||||||
|
Canvas.FillRect(R);
|
||||||
|
Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
|
||||||
|
|
||||||
|
Dec(R.Top, Margins.Top);
|
||||||
|
Dec(R.Left, Margins.Left);
|
||||||
|
Dec(R.Bottom, Margins.Bottom);
|
||||||
|
Dec(R.Right, Margins.Right);
|
||||||
|
Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1);
|
||||||
|
|
||||||
|
Canvas.Brush.Color := FBackColor;
|
||||||
|
InflateRect(R, -1, -1);
|
||||||
|
Canvas.FillRect(R);
|
||||||
|
Dec(R.Right);
|
||||||
|
h := R.Bottom - R.Top;
|
||||||
|
dh := h div NumberOfBars;
|
||||||
|
n := Round(NumberOfBars * (FValue - FMinimum)/(FMaximum - FMinimum));
|
||||||
|
Canvas.Brush.Color := FBarColor;
|
||||||
|
Ri := Classes.Rect(R.Left + 1, R.Bottom - dh + 1, R.Right - 1, R.Bottom);
|
||||||
|
for I := 1 to n do
|
||||||
|
begin
|
||||||
|
Canvas.FillRect(Ri);
|
||||||
|
Dec(Ri.Top, dh);
|
||||||
|
Dec(Ri.Bottom, dh);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimIndicator.SetBackColor(const Value: TColor);
|
||||||
|
begin
|
||||||
|
if FBackColor <> Value then
|
||||||
|
begin
|
||||||
|
FBackColor := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimIndicator.SetBarColor(const Value: TColor);
|
||||||
|
begin
|
||||||
|
if FBarColor <> Value then
|
||||||
|
begin
|
||||||
|
FBarColor := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimIndicator.SetMaximum(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if FMaximum <> Value then
|
||||||
|
begin
|
||||||
|
FMaximum := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimIndicator.SetMinimum(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if FMinimum <> Value then
|
||||||
|
begin
|
||||||
|
FMinimum := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimIndicator.SetValue(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if FValue <> Value then
|
||||||
|
begin
|
||||||
|
FValue := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimIndicator.SetMargins(const Value: TJvRect);
|
||||||
|
begin
|
||||||
|
FMargins.Assign(Value);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
2801
components/jvcllaz/run/JvJans/JvSimLogic.pas
Normal file
2801
components/jvcllaz/run/JvJans/JvSimLogic.pas
Normal file
File diff suppressed because it is too large
Load Diff
352
components/jvcllaz/run/JvJans/JvSimPID.pas
Normal file
352
components/jvcllaz/run/JvJans/JvSimPID.pas
Normal file
@ -0,0 +1,352 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: JvSimPID.PAS, released on 2002-06-15.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
|
||||||
|
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s): Robert Love [rlove att slcdug dott org].
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvSimPID;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
LCLIntf,
|
||||||
|
SysUtils, Classes, Graphics, Controls,
|
||||||
|
JvComponent;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvSymFunc = (sfPid, sfAdd, sfCompare, sfRamp, sfMul);
|
||||||
|
|
||||||
|
TJvSimPID = class(TJvGraphicControl)
|
||||||
|
private
|
||||||
|
FMV: Extended;
|
||||||
|
FMVColor: TColor;
|
||||||
|
FSP: Extended;
|
||||||
|
FSPColor: TColor;
|
||||||
|
FCV: Extended;
|
||||||
|
FCVColor: TColor;
|
||||||
|
FKD: Extended;
|
||||||
|
FKP: Extended;
|
||||||
|
FKI: Extended;
|
||||||
|
FI: Extended;
|
||||||
|
FD: Extended;
|
||||||
|
FDirect: Boolean;
|
||||||
|
FManual: Boolean;
|
||||||
|
FSource: TJvSimPID;
|
||||||
|
FActive: Boolean;
|
||||||
|
FSymFunc: TJvSymFunc;
|
||||||
|
procedure SetMV(Value: Extended);
|
||||||
|
procedure SetMVColor(Value: TColor);
|
||||||
|
procedure SetSP(const Value: Extended);
|
||||||
|
procedure SetSPColor(const Value: TColor);
|
||||||
|
procedure SetCV(const Value: Extended);
|
||||||
|
procedure SetCVColor(const Value: TColor);
|
||||||
|
procedure SetKD(const Value: Extended);
|
||||||
|
procedure SetKI(const Value: Extended);
|
||||||
|
procedure SetKP(const Value: Extended);
|
||||||
|
procedure CalcOut;
|
||||||
|
procedure SetDirect(const Value: Boolean);
|
||||||
|
procedure SetManual(const Value: Boolean);
|
||||||
|
procedure SetSource(const Value: TJvSimPID);
|
||||||
|
procedure SetActive(const Value: Boolean);
|
||||||
|
procedure SetSymFunc(const Value: TJvSymFunc);
|
||||||
|
protected
|
||||||
|
procedure Paint; override;
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
procedure Execute;
|
||||||
|
published
|
||||||
|
property SymFunc: TJvSymFunc read FSymFunc write SetSymFunc;
|
||||||
|
property Source: TJvSimPID read FSource write SetSource;
|
||||||
|
property MV: Extended read FMV write SetMV;
|
||||||
|
property MVColor: TColor read FMVColor write SetMVColor default clRed;
|
||||||
|
property SP: Extended read FSP write SetSP;
|
||||||
|
property SPColor: TColor read FSPColor write SetSPColor default clLime;
|
||||||
|
property CV: Extended read FCV write SetCV;
|
||||||
|
property CVColor: TColor read FCVColor write SetCVColor default clYellow;
|
||||||
|
property KP: Extended read FKP write SetKP;
|
||||||
|
property KI: Extended read FKI write SetKI;
|
||||||
|
property KD: Extended read FKD write SetKD;
|
||||||
|
property Direct: Boolean read FDirect write SetDirect default False;
|
||||||
|
property Manual: Boolean read FManual write SetManual default False;
|
||||||
|
property Active: Boolean read FActive write SetActive default False;
|
||||||
|
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
property Color default clWhite;
|
||||||
|
property Height default 100;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property Width default 20;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
// property OnCanResize; // wp: removed
|
||||||
|
property OnClick;
|
||||||
|
property OnConstrainedResize;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDock;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseEnter;
|
||||||
|
property OnMouseLeave;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnMouseWheel;
|
||||||
|
property OnMouseWheelDown;
|
||||||
|
property OnMouseWheelUp;
|
||||||
|
property OnResize;
|
||||||
|
property OnStartDock;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
JvJVCLUtils;
|
||||||
|
|
||||||
|
constructor TJvSimPID.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
Color := clWhite;
|
||||||
|
MVColor := clRed;
|
||||||
|
SPColor := clLime;
|
||||||
|
CVColor := clYellow;
|
||||||
|
Direct := False;
|
||||||
|
Manual := False;
|
||||||
|
Active := False;
|
||||||
|
FMV := 50;
|
||||||
|
FSP := 50;
|
||||||
|
FCV := 50;
|
||||||
|
FKP := 0.5;
|
||||||
|
FKI := 0;
|
||||||
|
FKD := 0;
|
||||||
|
Width := 20;
|
||||||
|
Height := 100;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetMV(Value: Extended);
|
||||||
|
var
|
||||||
|
MVOld: Extended;
|
||||||
|
begin
|
||||||
|
MVOld := FMV;
|
||||||
|
if Value <> FMV then
|
||||||
|
begin
|
||||||
|
if Value > 100 then
|
||||||
|
MV := 100
|
||||||
|
else
|
||||||
|
if Value < 0 then
|
||||||
|
MV := 0
|
||||||
|
else
|
||||||
|
FMV := Value;
|
||||||
|
end;
|
||||||
|
FI := FI + KI * (FMV - FSP);
|
||||||
|
if FI > 50 then
|
||||||
|
FI := 50;
|
||||||
|
if FI < -50 then
|
||||||
|
FI := -50;
|
||||||
|
FD := KD * (FMV - MVOld);
|
||||||
|
if FD > 50 then
|
||||||
|
FD := 50;
|
||||||
|
if FD < -50 then
|
||||||
|
FD := -50;
|
||||||
|
CalcOut;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetMVColor(Value: TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FMVColor then
|
||||||
|
begin
|
||||||
|
FMVColor := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.Paint;
|
||||||
|
|
||||||
|
procedure DrawValue(Left, Right: Integer; Value: Extended; AColor: TColor);
|
||||||
|
var
|
||||||
|
DrawRect: TRect;
|
||||||
|
begin
|
||||||
|
DrawRect.Left := Left;
|
||||||
|
DrawRect.Right := Right;
|
||||||
|
DrawRect.Top := DrawRect.Top + Round((100 - Value) *
|
||||||
|
(DrawRect.Bottom - DrawRect.Top) / 100);
|
||||||
|
DrawRect.Bottom := DrawRect.Bottom;
|
||||||
|
Canvas.Brush.Color := AColor;
|
||||||
|
Canvas.FillRect(DrawRect);
|
||||||
|
Canvas.Brush.Color := Color;
|
||||||
|
DrawRect.Bottom := DrawRect.Top;
|
||||||
|
DrawRect.Top := DrawRect.Top;
|
||||||
|
Canvas.FillRect(DrawRect);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
bw: Integer;
|
||||||
|
DrawRect: TRect;
|
||||||
|
begin
|
||||||
|
DrawRect := ClientRect;
|
||||||
|
Canvas.Pen.Color := clGray;
|
||||||
|
Canvas.Pen.Width := 1;
|
||||||
|
Canvas.Rectangle(DrawRect.Left, DrawRect.Top, DrawRect.Right, DrawRect.Bottom);
|
||||||
|
InflateRect(DrawRect, -1, -1);
|
||||||
|
|
||||||
|
bw := (DrawRect.Right - DrawRect.Left) div 3;
|
||||||
|
// first draw the Measured Value
|
||||||
|
DrawValue(DrawRect.Left + bw, DrawRect.Right - bw, SP, SPColor);
|
||||||
|
// and now the SetPoint
|
||||||
|
DrawValue(DrawRect.Left, DrawRect.Left + bw, MV, MVColor);
|
||||||
|
// draw the Corrective Value (CV)
|
||||||
|
DrawValue(DrawRect.Right - bw, DrawRect.Right, CV, CVColor);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetSP(const Value: Extended);
|
||||||
|
begin
|
||||||
|
if Value <> FSP then
|
||||||
|
begin
|
||||||
|
if Value > 100 then
|
||||||
|
FSP := 100
|
||||||
|
else
|
||||||
|
if Value < 0 then
|
||||||
|
FSP := 0
|
||||||
|
else
|
||||||
|
FSP := Value;
|
||||||
|
CalcOut;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetSPColor(const Value: TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FSPColor then
|
||||||
|
begin
|
||||||
|
FSPColor := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetCV(const Value: Extended);
|
||||||
|
begin
|
||||||
|
if Value <> FCV then
|
||||||
|
begin
|
||||||
|
if Value > 100 then
|
||||||
|
FCV := 100
|
||||||
|
else
|
||||||
|
if Value < 0 then
|
||||||
|
FCV := 0
|
||||||
|
else
|
||||||
|
FCV := Value;
|
||||||
|
end;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetCVColor(const Value: TColor);
|
||||||
|
begin
|
||||||
|
if Value <> FCVColor then
|
||||||
|
begin
|
||||||
|
FCVColor := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetKD(const Value: Extended);
|
||||||
|
begin
|
||||||
|
FKD := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetKI(const Value: Extended);
|
||||||
|
begin
|
||||||
|
FKI := Value;
|
||||||
|
if FKI = 0 then
|
||||||
|
FI := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetKP(const Value: Extended);
|
||||||
|
begin
|
||||||
|
FKP := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.CalcOut;
|
||||||
|
var
|
||||||
|
Output: Extended;
|
||||||
|
begin
|
||||||
|
if not Manual then
|
||||||
|
begin
|
||||||
|
if Direct then
|
||||||
|
Output := 50 + KP * (MV - SP) + FI + FD
|
||||||
|
else
|
||||||
|
Output := 50 - (KP * (MV - SP) + FI + FD);
|
||||||
|
SetCV(Output);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetDirect(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
FDirect := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetManual(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
FManual := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetSource(const Value: TJvSimPID);
|
||||||
|
begin
|
||||||
|
ReplaceComponentReference(Self, Value, TComponent(FSource));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.Execute;
|
||||||
|
var
|
||||||
|
Value: Extended;
|
||||||
|
begin
|
||||||
|
if Active then
|
||||||
|
if Assigned(FSource) then
|
||||||
|
begin
|
||||||
|
Value := Source.CV;
|
||||||
|
SetMV(Value);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetActive(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
FActive := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.SetSymFunc(const Value: TJvSymFunc);
|
||||||
|
begin
|
||||||
|
FSymFunc := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPID.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if (AComponent = Source) and (Operation = opRemove) then
|
||||||
|
Source := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
123
components/jvcllaz/run/JvJans/JvSimPIDLinker.pas
Normal file
123
components/jvcllaz/run/JvJans/JvSimPIDLinker.pas
Normal file
@ -0,0 +1,123 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: JvSimPIDlinker.PAS, released on 2002-06-15.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
|
||||||
|
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s): Robert Love [rlove att slcdug dott org].
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvSimPIDLinker;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
JvSimPID;
|
||||||
|
|
||||||
|
type
|
||||||
|
TPIDS = array of TJvSimPID;
|
||||||
|
|
||||||
|
TJvSimPIDLinker = class(TComponent)
|
||||||
|
private
|
||||||
|
FPIDS: TPIDS;
|
||||||
|
function GetPID(const Index: Integer): TJvSimPID;
|
||||||
|
procedure SetPID(const Index: Integer; const Value: TJvSimPID);
|
||||||
|
protected
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation);
|
||||||
|
override;
|
||||||
|
procedure InitPids;
|
||||||
|
public
|
||||||
|
procedure Execute;
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
published
|
||||||
|
property In1: TJvSimPID index 0 read GetPID write SetPID;
|
||||||
|
property Out1: TJvSimPID index 1 read GetPID write SetPID;
|
||||||
|
property In2: TJvSimPID index 2 read GetPID write SetPID;
|
||||||
|
property Out2: TJvSimPID index 3 read GetPID write SetPID;
|
||||||
|
property In3: TJvSimPID index 4 read GetPID write SetPID;
|
||||||
|
property Out3: TJvSimPID index 5 read GetPID write SetPID;
|
||||||
|
property In4: TJvSimPID index 6 read GetPID write SetPID;
|
||||||
|
property Out4: TJvSimPID index 7 read GetPID write SetPID;
|
||||||
|
property In5: TJvSimPID index 8 read GetPID write SetPID;
|
||||||
|
property Out5: TJvSimPID index 9 read GetPID write SetPID;
|
||||||
|
property In6: TJvSimPID index 10 read GetPID write SetPID;
|
||||||
|
property Out6: TJvSimPID index 11 read GetPID write SetPID;
|
||||||
|
property In7: TJvSimPID index 12 read GetPID write SetPID;
|
||||||
|
property Out7: TJvSimPID index 13 read GetPID write SetPID;
|
||||||
|
property In8: TJvSimPID index 14 read GetPID write SetPID;
|
||||||
|
property Out8: TJvSimPID index 15 read GetPID write SetPID;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
constructor TJvSimPIDLinker.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
InitPids;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPIDLinker.Execute;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
for I := 0 to Length(FPIDS) - 2 do
|
||||||
|
if (FPIDS[I] <> nil) and (FPIDS[I + 1] <> nil) then
|
||||||
|
FPIDS[I].MV := FPIDS[I + 1].CV;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvSimPIDLinker.GetPID(const Index: Integer): TJvSimPID;
|
||||||
|
begin
|
||||||
|
Result := FPIDS[Index];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPIDLinker.InitPids;
|
||||||
|
const
|
||||||
|
cCount = 16;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
SetLength(FPIDS, cCount);
|
||||||
|
for I := 0 to cCount - 1 do
|
||||||
|
FPIDS[I] := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPIDLinker.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if Operation = opRemove then
|
||||||
|
for I := 0 to Length(FPIDS) - 1 do
|
||||||
|
if FPIDS[I] = AComponent then
|
||||||
|
FPIDS[I] := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimPIDLinker.SetPID(const Index: Integer;
|
||||||
|
const Value: TJvSimPID);
|
||||||
|
begin
|
||||||
|
FPIDS[Index] := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
860
components/jvcllaz/run/JvJans/JvSimScope.pas
Normal file
860
components/jvcllaz/run/JvJans/JvSimScope.pas
Normal file
@ -0,0 +1,860 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
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: JvSimScope.PAS, released on 2002-06-15.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
|
||||||
|
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s): Robert Love [rlove att slcdug dott org].
|
||||||
|
|
||||||
|
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:
|
||||||
|
TJvSimScope Properties:
|
||||||
|
Active Starts/Stops scope
|
||||||
|
Color Backgroundcolor
|
||||||
|
GridColor Grid mask color
|
||||||
|
HorizontalGridSize Size of horiontal grid mask in logical units
|
||||||
|
VerticalGridSize Size of vertical grid mask in logical units
|
||||||
|
Interval Scroll speed in 1/100's seconds
|
||||||
|
LineColor Scope dataline color
|
||||||
|
Position Dataline value
|
||||||
|
BaseColor Color of BaseLine
|
||||||
|
BaseLine BaseLine value
|
||||||
|
|
||||||
|
TJvSimScope Methods:
|
||||||
|
Clear Clears the control and redraws grid
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvSimScope;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls;
|
||||||
|
|
||||||
|
const
|
||||||
|
JvScopeDefaultCapacity = 128;
|
||||||
|
JvMinimumScopeWidth = 20;
|
||||||
|
JvMinimumScopeHeight = 20;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvSimScope = class;
|
||||||
|
|
||||||
|
TJvScopeLineUnit = (jluPercent, jluAbsolute);
|
||||||
|
|
||||||
|
TValues = array of Integer;
|
||||||
|
|
||||||
|
TJvScopeLineValues = class
|
||||||
|
private
|
||||||
|
FValues: TValues;
|
||||||
|
FCount: Integer;
|
||||||
|
FZeroIndex: Integer;
|
||||||
|
|
||||||
|
procedure SetCapacity(const Value: Integer);
|
||||||
|
function GetCapacity: Integer;
|
||||||
|
function GetItem(Index: Integer): Integer;
|
||||||
|
public
|
||||||
|
procedure Assign(Source: TJvScopeLineValues);
|
||||||
|
procedure Add(Value: Integer);
|
||||||
|
procedure Clear;
|
||||||
|
|
||||||
|
property Capacity: Integer read GetCapacity write SetCapacity;
|
||||||
|
property Count: Integer read FCount;
|
||||||
|
property Items[Index: Integer]: Integer read GetItem; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvScopeLine = class(TCollectionItem)
|
||||||
|
private
|
||||||
|
FPosition: Integer;
|
||||||
|
FColor: TColor;
|
||||||
|
FName: string;
|
||||||
|
FPositionUnit: TJvScopeLineUnit;
|
||||||
|
FValues: TJvScopeLineValues;
|
||||||
|
protected
|
||||||
|
function GetDisplayName: string; override;
|
||||||
|
public
|
||||||
|
constructor Create(ACollection: Classes.TCollection); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure Assign(Source: TPersistent); override;
|
||||||
|
procedure Clear;
|
||||||
|
property Values: TJvScopeLineValues read FValues;
|
||||||
|
published
|
||||||
|
property Name: string read FName write FName;
|
||||||
|
property Color: TColor read FColor write FColor default clLime;
|
||||||
|
property Position: Integer read FPosition write FPosition default 50;
|
||||||
|
property PositionUnit: TJvScopeLineUnit read FPositionUnit write FPositionUnit default jluPercent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvScopeLines = class(TOwnedCollection)
|
||||||
|
private
|
||||||
|
function GetItem(Index: Integer): TJvScopeLine;
|
||||||
|
procedure SetItem(Index: Integer; const Value: TJvScopeLine);
|
||||||
|
protected
|
||||||
|
function GetOwner: TJvSimScope; reintroduce;
|
||||||
|
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TJvSimScope);
|
||||||
|
procedure Assign(Source: TPersistent); override;
|
||||||
|
procedure ClearValues;
|
||||||
|
|
||||||
|
function Add: TJvScopeLine;
|
||||||
|
function IndexOfName(const AName: string): Integer;
|
||||||
|
property Lines[Index: Integer]: TJvScopeLine read GetItem write SetItem; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvSimScopeDisplayUnit = (jduPixels, jduLogical);
|
||||||
|
|
||||||
|
TJvSimScope = class(TGraphicControl)
|
||||||
|
private
|
||||||
|
FAllowed: Boolean;
|
||||||
|
FOnUpdate: TNotifyEvent;
|
||||||
|
FDrawBuffer: TBitmap;
|
||||||
|
FDrawTimer: TTimer;
|
||||||
|
FActive: Boolean;
|
||||||
|
FBaseColor: TColor;
|
||||||
|
FGridColor: TColor;
|
||||||
|
FBaseLine: Integer;
|
||||||
|
FInterval: Integer;
|
||||||
|
FLines: TJvScopeLines;
|
||||||
|
FHorizontalGridSize: Integer;
|
||||||
|
FVerticalGridSize: Integer;
|
||||||
|
FDisplayUnits: TJvSimScopeDisplayUnit;
|
||||||
|
FMaximum: Integer;
|
||||||
|
FMinimum: Integer;
|
||||||
|
FBaseLineUnit: TJvScopeLineUnit;
|
||||||
|
FTotalTimeSteps: Integer;
|
||||||
|
FUpdateTimeSteps: Integer;
|
||||||
|
|
||||||
|
procedure SetActive(Value: Boolean);
|
||||||
|
procedure SetGridSize(Value: Integer);
|
||||||
|
procedure SetBaseLine(Value: Integer);
|
||||||
|
procedure SetInterval(Value: Integer);
|
||||||
|
procedure SetLines(const Value: TJvScopeLines);
|
||||||
|
procedure UpdateDisplay(ClearFirst: Boolean);
|
||||||
|
procedure SetHorizontalGridSize(const Value: Integer);
|
||||||
|
procedure SetVerticalGridSize(const Value: Integer);
|
||||||
|
function GetGridSize: Integer;
|
||||||
|
procedure SetDisplayUnits(const Value: TJvSimScopeDisplayUnit);
|
||||||
|
procedure SetMaximum(const Value: Integer);
|
||||||
|
procedure SetMinimum(const Value: Integer);
|
||||||
|
procedure UpdateComputedValues;
|
||||||
|
procedure SetBaseLineUnit(const Value: TJvScopeLineUnit);
|
||||||
|
procedure SetTotalTimeSteps(const Value: Integer);
|
||||||
|
procedure SetUpdateTimeSteps(const Value: Integer);
|
||||||
|
protected
|
||||||
|
FCalcBase: Integer;
|
||||||
|
FStepPixelWidth: Double;
|
||||||
|
FCounter: Double;
|
||||||
|
procedure DrawTimerTimer(Sender: TObject);
|
||||||
|
function GetLinePixelPosition(Line: TJvScopeLine; Position: Integer): Integer;
|
||||||
|
procedure Loaded; override;
|
||||||
|
public
|
||||||
|
procedure Paint; override;
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
procedure UpdateScope;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Clear;
|
||||||
|
procedure ClearValues;
|
||||||
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
|
||||||
|
published
|
||||||
|
property Active: Boolean read FActive write SetActive;
|
||||||
|
property BaseColor: TColor read FBaseColor write FBaseColor default clRed;
|
||||||
|
property BaseLine: Integer read FBaseLine write SetBaseLine default 50;
|
||||||
|
property BaseLineUnit: TJvScopeLineUnit read FBaseLineUnit write SetBaseLineUnit default jluPercent;
|
||||||
|
property Color default clBlack;
|
||||||
|
property DisplayUnits: TJvSimScopeDisplayUnit read FDisplayUnits write SetDisplayUnits default jduPixels;
|
||||||
|
property GridColor: TColor read FGridColor write FGridColor default clGreen;
|
||||||
|
property GridSize: Integer read GetGridSize write SetGridSize stored False default 16;
|
||||||
|
property HorizontalGridSize: Integer read FHorizontalGridSize write SetHorizontalGridSize default 16;
|
||||||
|
property Height default 120;
|
||||||
|
property Interval: Integer read FInterval write SetInterval default 50;
|
||||||
|
property Lines: TJvScopeLines read FLines write SetLines;
|
||||||
|
property Minimum: Integer read FMinimum write SetMinimum;
|
||||||
|
property Maximum: Integer read FMaximum write SetMaximum default 120;
|
||||||
|
property TotalTimeSteps: Integer read FTotalTimeSteps write SetTotalTimeSteps default 208;
|
||||||
|
property UpdateTimeSteps: Integer read FUpdateTimeSteps write SetUpdateTimeSteps default 2;
|
||||||
|
property VerticalGridSize: Integer read FVerticalGridSize write SetVerticalGridSize default 16;
|
||||||
|
property Width default 208;
|
||||||
|
|
||||||
|
property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
|
||||||
|
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
property ParentShowHint;
|
||||||
|
property ShowHint;
|
||||||
|
property Visible;
|
||||||
|
|
||||||
|
// property OnCanResize; -- wp: removed
|
||||||
|
property OnClick;
|
||||||
|
property OnConstrainedResize;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDock;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseEnter;
|
||||||
|
property OnMouseLeave;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnMouseWheel;
|
||||||
|
property OnMouseWheelDown;
|
||||||
|
property OnMouseWheelUp;
|
||||||
|
property OnResize;
|
||||||
|
property OnStartDock;
|
||||||
|
property OnStartDrag;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Math;
|
||||||
|
|
||||||
|
//=== { TJvScopeLineValues } =================================================
|
||||||
|
|
||||||
|
procedure TJvScopeLineValues.Add(Value: Integer);
|
||||||
|
begin
|
||||||
|
Assert(Assigned(Self));
|
||||||
|
if Length(FValues)=Count then // auto-growby JvScopeDefaultCapacity
|
||||||
|
SetCapacity( GetCapacity+JvScopeDefaultCapacity);
|
||||||
|
|
||||||
|
if Count < Capacity then
|
||||||
|
begin
|
||||||
|
FValues[FCount] := Value;
|
||||||
|
Inc(FCount);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FValues[FZeroIndex] := Value;
|
||||||
|
FZeroIndex := (FZeroIndex + 1) mod FCount;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvScopeLineValues.Assign(Source: TJvScopeLineValues);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
if (not Assigned(Source)) then
|
||||||
|
raise Exception.Create('TJvScopeLineValues.Assign:Source not assigned');
|
||||||
|
FCount := Source.FCount;
|
||||||
|
FZeroIndex := Source.FZeroIndex;
|
||||||
|
Capacity := Source.Capacity;
|
||||||
|
for I := 0 to Source.Capacity - 1 do
|
||||||
|
FValues[I] := Source.FValues[I];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvScopeLineValues.Clear;
|
||||||
|
begin
|
||||||
|
FCount := 0;
|
||||||
|
FZeroIndex := 0;
|
||||||
|
|
||||||
|
// Always need to have two values in the queue
|
||||||
|
Add(0);
|
||||||
|
Add(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvScopeLineValues.GetCapacity: Integer;
|
||||||
|
begin
|
||||||
|
if Assigned(FValues) then
|
||||||
|
Result := Length(FValues)
|
||||||
|
else
|
||||||
|
Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvScopeLineValues.GetItem(Index: Integer): Integer;
|
||||||
|
begin
|
||||||
|
if FCount = 0 then
|
||||||
|
Result := FValues[0]
|
||||||
|
else
|
||||||
|
Result := FValues[(Index + FZeroIndex) mod FCount];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvScopeLineValues.SetCapacity(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if Value <> Capacity then
|
||||||
|
begin
|
||||||
|
SetLength(FValues, Value);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvScopeLine } =======================================================
|
||||||
|
|
||||||
|
procedure TJvScopeLine.Clear;
|
||||||
|
begin
|
||||||
|
FValues.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJvScopeLine.Create(ACollection: Classes.TCollection);
|
||||||
|
begin
|
||||||
|
// MUST be created before, inherited create will call Notify...
|
||||||
|
FValues := TJvScopeLineValues.Create;
|
||||||
|
inherited Create(ACollection);
|
||||||
|
FPosition := 50;
|
||||||
|
FColor := clLime;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvScopeLine.Destroy;
|
||||||
|
begin
|
||||||
|
FValues.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvScopeLine.Assign(Source: TPersistent);
|
||||||
|
begin
|
||||||
|
if Source is TJvScopeLine then
|
||||||
|
begin
|
||||||
|
Name := TJvScopeLine(Source).Name;
|
||||||
|
Color := TJvScopeLine(Source).Color;
|
||||||
|
Position := TJvScopeLine(Source).Position;
|
||||||
|
FValues.Assign(TJvScopeLine(Source).FValues);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvScopeLine.GetDisplayName: string;
|
||||||
|
begin
|
||||||
|
if Name = '' then
|
||||||
|
Result := inherited GetDisplayName
|
||||||
|
else
|
||||||
|
Result := Name;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvScopeLines } ======================================================
|
||||||
|
|
||||||
|
procedure TJvScopeLines.ClearValues;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
begin
|
||||||
|
Lines[I].Clear;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJvScopeLines.Create(AOwner: TJvSimScope);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner, TJvScopeLine);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvScopeLines.Add: TJvScopeLine;
|
||||||
|
begin
|
||||||
|
Result := TJvScopeLine(inherited Add);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvScopeLines.Assign(Source: TPersistent);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
if Source is TJvScopeLines then
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
for I := 0 to TJvScopeLines(Source).Count - 1 do
|
||||||
|
Add.Assign(TJvScopeLines(Source)[I]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvScopeLines.GetItem(Index: Integer): TJvScopeLine;
|
||||||
|
begin
|
||||||
|
Result := TJvScopeLine(inherited Items[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvScopeLines.GetOwner: TJvSimScope;
|
||||||
|
begin
|
||||||
|
Result := inherited GetOwner as TJvSimScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvScopeLines.IndexOfName(const AName: string): Integer;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
if AnsiSameStr(Lines[Result].Name, AName) then
|
||||||
|
begin
|
||||||
|
Result := I;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvScopeLines.Notify(Item: TCollectionItem;
|
||||||
|
Action: TCollectionNotification);
|
||||||
|
begin
|
||||||
|
inherited Notify(Item, Action);
|
||||||
|
|
||||||
|
if Action = cnAdded then
|
||||||
|
begin
|
||||||
|
TJvScopeLine(Item).FValues.Capacity := GetOwner.TotalTimeSteps;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvScopeLines.SetItem(Index: Integer; const Value: TJvScopeLine);
|
||||||
|
begin
|
||||||
|
inherited Items[Index] := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvSimScope } ========================================================
|
||||||
|
|
||||||
|
procedure TJvSimScope.ClearValues;
|
||||||
|
begin
|
||||||
|
FLines.ClearValues;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJvSimScope.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FAllowed := False;
|
||||||
|
FDrawBuffer := TBitmap.Create;
|
||||||
|
FDrawBuffer.Canvas.Brush.Style := bsSolid;
|
||||||
|
FDrawBuffer.Canvas.Pen.Width := 1;
|
||||||
|
FDrawBuffer.Canvas.Pen.Style := psSolid;
|
||||||
|
|
||||||
|
FDrawTimer := TTimer.Create(Self);
|
||||||
|
FDrawTimer.Enabled := False;
|
||||||
|
FDrawTimer.OnTimer := @DrawTimerTimer;
|
||||||
|
FDrawTimer.Interval := 500;
|
||||||
|
|
||||||
|
FDisplayUnits := jduPixels;
|
||||||
|
FUpdateTimeSteps := 2;
|
||||||
|
|
||||||
|
Height := 120; { property default }
|
||||||
|
Width := 208; { property default }
|
||||||
|
|
||||||
|
Color := clBlack;
|
||||||
|
FGridColor := clGreen;
|
||||||
|
FBaseColor := clRed;
|
||||||
|
|
||||||
|
BaseLine := 50;
|
||||||
|
GridSize := 16;
|
||||||
|
|
||||||
|
FLines := TJvScopeLines.Create(Self);
|
||||||
|
Interval := 50;
|
||||||
|
FCounter := 1;
|
||||||
|
|
||||||
|
ControlStyle := [csFramed, csOpaque];
|
||||||
|
FAllowed := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvSimScope.Destroy;
|
||||||
|
begin
|
||||||
|
FDrawTimer.Free;
|
||||||
|
FDrawBuffer.Free;
|
||||||
|
FLines.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.DrawTimerTimer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
UpdateScope;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvSimScope.GetGridSize: Integer;
|
||||||
|
begin
|
||||||
|
Result := -1;
|
||||||
|
if HorizontalGridSize = VerticalGridSize then
|
||||||
|
Result := HorizontalGridSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvSimScope.GetLinePixelPosition(Line: TJvScopeLine;
|
||||||
|
Position: Integer): Integer;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
case Line.PositionUnit of
|
||||||
|
jluPercent:
|
||||||
|
Result := Height - Round(Height * Position / 100);
|
||||||
|
jluAbsolute:
|
||||||
|
Result := Height - Round(Height * (Position - Minimum) / (Maximum - Minimum));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.Loaded;
|
||||||
|
begin
|
||||||
|
inherited Loaded;
|
||||||
|
|
||||||
|
// To force having enough values in the scope.
|
||||||
|
ClearValues;
|
||||||
|
|
||||||
|
FAllowed := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.Clear;
|
||||||
|
var
|
||||||
|
A: Double;
|
||||||
|
I: Integer;
|
||||||
|
J: Integer;
|
||||||
|
Position: Double;
|
||||||
|
begin
|
||||||
|
if not FAllowed then
|
||||||
|
Exit;
|
||||||
|
UpdateComputedValues;
|
||||||
|
with FDrawBuffer.Canvas do
|
||||||
|
begin
|
||||||
|
Brush.Color := Color;
|
||||||
|
Pen.Style := psClear;
|
||||||
|
Rectangle(0, 0, Width + 1, Height + 1);
|
||||||
|
Pen.Style := psSolid;
|
||||||
|
Pen.Color := GridColor;
|
||||||
|
Pen.Width := 1;
|
||||||
|
{ Vertical lines }
|
||||||
|
A := Width;
|
||||||
|
while A > 0 do
|
||||||
|
begin
|
||||||
|
MoveTo(Round(A - 1), 0);
|
||||||
|
LineTo(Round(A - 1), Height);
|
||||||
|
A := A - VerticalGridSize * FStepPixelWidth;
|
||||||
|
end;
|
||||||
|
{ Horizontal lines - below BaseLine }
|
||||||
|
A := FCalcBase;
|
||||||
|
while A < Height do
|
||||||
|
begin
|
||||||
|
A := A + HorizontalGridSize * Height / (Maximum - Minimum);
|
||||||
|
MoveTo(0, Round(A));
|
||||||
|
LineTo(Width, Round(A));
|
||||||
|
end;
|
||||||
|
{ Horizontal lines - above BaseLine }
|
||||||
|
A := FCalcBase;
|
||||||
|
while A > 0 do
|
||||||
|
begin
|
||||||
|
A := A - HorizontalGridSize * Height / (Maximum - Minimum);
|
||||||
|
MoveTo(0, Round(A));
|
||||||
|
LineTo(Width, Round(A));
|
||||||
|
end;
|
||||||
|
{ BaseLine }
|
||||||
|
Pen.Color := BaseColor;
|
||||||
|
MoveTo(0, FCalcBase);
|
||||||
|
LineTo(Width, FCalcBase);
|
||||||
|
|
||||||
|
// Redraw old values to keep history of values
|
||||||
|
for I := 0 to FLines.Count - 1 do
|
||||||
|
begin
|
||||||
|
Pen.Color := FLines[I].Color;
|
||||||
|
|
||||||
|
if FLines[I].FValues.Count > 0 then
|
||||||
|
begin
|
||||||
|
Position := (TotalTimeSteps - FLines[I].FValues.Count) * FStepPixelWidth;
|
||||||
|
|
||||||
|
MoveTo(Round(Position), GetLinePixelPosition(FLines[I], FLines[I].FValues[0]));
|
||||||
|
J := UpdateTimeSteps - 1;
|
||||||
|
while J < FLines[I].FValues.Count - 1 do
|
||||||
|
begin
|
||||||
|
Position := Position + UpdateTimeSteps * FStepPixelWidth;
|
||||||
|
LineTo(Round(Position), GetLinePixelPosition(FLines[I], FLines[I].FValues[J]));
|
||||||
|
Inc(J, UpdateTimeSteps);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FLines[I].FValues.Clear;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FCounter := 1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetBaseLine(Value: Integer);
|
||||||
|
begin
|
||||||
|
FBaseLine := Value;
|
||||||
|
UpdateComputedValues;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetBaseLineUnit(const Value: TJvScopeLineUnit);
|
||||||
|
begin
|
||||||
|
if FBaseLineUnit <> Value then
|
||||||
|
begin
|
||||||
|
FBaseLineUnit := Value;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetInterval(Value: Integer);
|
||||||
|
begin
|
||||||
|
if FInterval <> Value then
|
||||||
|
begin
|
||||||
|
FDrawTimer.Enabled := False;
|
||||||
|
UpdateComputedValues;
|
||||||
|
FDrawTimer.Interval := Value * 10;
|
||||||
|
FInterval := Value;
|
||||||
|
FDrawTimer.Enabled := FActive;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetGridSize(Value: Integer);
|
||||||
|
begin
|
||||||
|
if ((Value <> FHorizontalGridSize) or (Value <> FVerticalGridSize)) and (Value > 0) then
|
||||||
|
begin
|
||||||
|
FHorizontalGridSize := Value;
|
||||||
|
FVerticalGridSize := Value;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetHorizontalGridSize(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if (FHorizontalGridSize <> Value) and (Value > 0) then
|
||||||
|
begin
|
||||||
|
FHorizontalGridSize := Value;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetActive(Value: Boolean);
|
||||||
|
begin
|
||||||
|
if FActive <> Value then
|
||||||
|
begin
|
||||||
|
UpdateComputedValues;
|
||||||
|
FDrawTimer.Interval := Interval * 10;
|
||||||
|
FDrawTimer.Enabled := Value;
|
||||||
|
FActive := Value;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ All drawings is performed on in the FDrawBuffer to speed up
|
||||||
|
proceedings and eliminate flicker. The Paint procedure merely
|
||||||
|
copies the contents of the FDrawBuffer. }
|
||||||
|
|
||||||
|
procedure TJvSimScope.UpdateScope;
|
||||||
|
var
|
||||||
|
A: Double;
|
||||||
|
I: Integer;
|
||||||
|
Dest, Src: TRect;
|
||||||
|
UpdateWidth: Integer;
|
||||||
|
J: Integer;
|
||||||
|
PosMinusOne: Double;
|
||||||
|
PosMinusTwo: Double;
|
||||||
|
begin
|
||||||
|
with FDrawBuffer.Canvas do
|
||||||
|
begin
|
||||||
|
Pen.Color := FGridColor;
|
||||||
|
|
||||||
|
UpdateWidth := Round(UpdateTimeSteps * FStepPixelWidth);
|
||||||
|
|
||||||
|
Dest.Top := 0;
|
||||||
|
Dest.Left := 0;
|
||||||
|
Dest.Right := Round(Width - UpdateWidth);
|
||||||
|
Dest.Bottom := Height;
|
||||||
|
|
||||||
|
Src.Top := 0;
|
||||||
|
Src.Left := Round(UpdateTimeSteps * FStepPixelWidth);
|
||||||
|
Src.Right := Width;
|
||||||
|
Src.Bottom := Height;
|
||||||
|
{ Copy bitmap leftwards }
|
||||||
|
CopyRect(Dest, FDrawBuffer.Canvas, Src);
|
||||||
|
|
||||||
|
{ Draw new area }
|
||||||
|
Pen.Color := Color;
|
||||||
|
Brush.Color := Color;
|
||||||
|
BRush.Style := bsSolid;
|
||||||
|
Dest.Top := 0;
|
||||||
|
Dest.Left := Width - UpdateWidth;
|
||||||
|
Dest.Right := Width;
|
||||||
|
Dest.Bottom := Height;
|
||||||
|
FilLRect(Dest);
|
||||||
|
(* Pen.Width := UpdateWidth;
|
||||||
|
MoveTo(Width - Round(UpdateWidth / 2), 0);
|
||||||
|
LineTo(Width - Round(UpdateWidth / 2), Height); *)
|
||||||
|
|
||||||
|
|
||||||
|
Pen.Color := GridColor;
|
||||||
|
Pen.Width := 1;
|
||||||
|
{ Draw vertical line if needed }
|
||||||
|
if FCounter >= Round(VerticalGridSize * FStepPixelWidth / UpdateWidth) then
|
||||||
|
begin
|
||||||
|
MoveTo(Width - 1, 0);
|
||||||
|
LineTo(Width - 1, Height);
|
||||||
|
FCounter := 0;
|
||||||
|
end;
|
||||||
|
FCounter := FCounter + 1;
|
||||||
|
{ Horizontal lines - below BaseLine }
|
||||||
|
A := FCalcBase;
|
||||||
|
while A < Height do
|
||||||
|
begin
|
||||||
|
A := A + HorizontalGridSize * Height / (Maximum - Minimum);
|
||||||
|
MoveTo(Width - UpdateWidth, Round(A));
|
||||||
|
LineTo(Width, Round(A));
|
||||||
|
end;
|
||||||
|
{ Horizontal lines - above BaseLine }
|
||||||
|
A := FCalcBase;
|
||||||
|
while A > 0 do
|
||||||
|
begin
|
||||||
|
A := A - HorizontalGridSize * Height / (Maximum - Minimum);
|
||||||
|
MoveTo(Width - UpdateWidth, Round(A));
|
||||||
|
LineTo(Width, Round(A));
|
||||||
|
end;
|
||||||
|
{ BaseLine }
|
||||||
|
Pen.Color := BaseColor;
|
||||||
|
MoveTo(Width - UpdateWidth, FCalcBase);
|
||||||
|
LineTo(Width, FCalcBase);
|
||||||
|
{ Draw position for lines}
|
||||||
|
for I := 0 to FLines.Count - 1 do
|
||||||
|
begin
|
||||||
|
Pen.Color := FLines[I].Color;
|
||||||
|
|
||||||
|
A := GetLinePixelPosition(FLines[I], FLines[I].Position);
|
||||||
|
PosMinusOne := GetLinePixelPosition(FLines[I], FLines[I].FValues[FLines[I].FValues.Count - 1 * UpdateTimeSteps]);
|
||||||
|
PosMinusTwo := GetLinePixelPosition(FLines[I], FLines[I].FValues[FLines[I].FValues.Count - 2 * UpdateTimeSteps]);
|
||||||
|
|
||||||
|
MoveTo(Width - UpdateWidth * 2, Round(PosMinusTwo));
|
||||||
|
LineTo(Width - UpdateWidth, Round(PosMinusOne));
|
||||||
|
LineTo(Width - 0, Round(A));
|
||||||
|
for J := 0 to UpdateTimeSteps - 1 do
|
||||||
|
FLines[I].FValues.Add(FLines[I].Position);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Repaint;
|
||||||
|
if Assigned(FOnUpdate) then
|
||||||
|
FOnUpdate(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Called by timer to show updates }
|
||||||
|
|
||||||
|
procedure TJvSimScope.Paint;
|
||||||
|
var
|
||||||
|
Rect: TRect;
|
||||||
|
begin
|
||||||
|
// inherited Paint;
|
||||||
|
FDrawBuffer.Height := Height;
|
||||||
|
FDrawBuffer.Width := Width;
|
||||||
|
Rect.Top := 0;
|
||||||
|
Rect.Left := 0;
|
||||||
|
Rect.Right := Width;
|
||||||
|
Rect.Bottom := Height;
|
||||||
|
Canvas.CopyRect(Rect, FDrawBuffer.Canvas, Rect);
|
||||||
|
FAllowed := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Recalulate control after move and/or resize }
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
||||||
|
begin
|
||||||
|
{ BUGFIX/Workaround:JAN 2009 - ACCESS VIOLATIONS AND ODD BEHAVIOUR - SIZE/WIDTH BEING ZAPPED TO ZERO.}
|
||||||
|
if AWidth < JvMinimumScopeWidth then
|
||||||
|
AWidth := JvMinimumScopeWidth;
|
||||||
|
if AHeight < JvMinimumScopeHeight then
|
||||||
|
AHeight := JvMinimumScopeHeight;
|
||||||
|
|
||||||
|
|
||||||
|
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
|
||||||
|
FDrawBuffer.Height := Height;
|
||||||
|
FDrawBuffer.Width := Width;
|
||||||
|
if DisplayUnits = jduPixels then
|
||||||
|
begin
|
||||||
|
FMinimum := 0;
|
||||||
|
FMaximum := AHeight;
|
||||||
|
FTotalTimeSteps := AWidth;
|
||||||
|
end;
|
||||||
|
Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.UpdateComputedValues;
|
||||||
|
begin
|
||||||
|
case FBaseLineUnit of
|
||||||
|
jluPercent:
|
||||||
|
FCalcBase := Height - Round(Height * FBaseLine / 100);
|
||||||
|
jluAbsolute:
|
||||||
|
FCalcBase := Height - Round(Height * (FBaseLine - Minimum) / (Maximum - Minimum));
|
||||||
|
end;
|
||||||
|
FStepPixelWidth := Width / TotalTimeSteps;
|
||||||
|
if FUpdateTimeSteps * FStepPixelWidth < 2 then
|
||||||
|
UpdateTimeSteps := 2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetDisplayUnits(const Value: TJvSimScopeDisplayUnit);
|
||||||
|
begin
|
||||||
|
if FDisplayUnits <> Value then
|
||||||
|
begin
|
||||||
|
FDisplayUnits := Value;
|
||||||
|
if FDisplayUnits = jduPixels then
|
||||||
|
begin
|
||||||
|
FMinimum := 0;
|
||||||
|
FMaximum := Height;
|
||||||
|
end;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetLines(const Value: TJvScopeLines);
|
||||||
|
begin
|
||||||
|
FLines.Assign(Value);
|
||||||
|
Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetMaximum(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if (FDisplayUnits <> jduPixels) and (FMaximum <> Value) then
|
||||||
|
begin
|
||||||
|
FMaximum := Value;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetMinimum(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if (FDisplayUnits <> jduPixels) and (FMinimum <> Value) then
|
||||||
|
begin
|
||||||
|
FMinimum := Value;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetTotalTimeSteps(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if (FDisplayUnits <> jduPixels) and (FTotalTimeSteps <> Value) then
|
||||||
|
begin
|
||||||
|
FTotalTimeSteps := Value;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetUpdateTimeSteps(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if (FUpdateTimeSteps <> Value) and (Value > 0) then
|
||||||
|
begin
|
||||||
|
FUpdateTimeSteps := Value;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.SetVerticalGridSize(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if (FVerticalGridSize <> Value) and (Value > 0) then
|
||||||
|
begin
|
||||||
|
FVerticalGridSize := Value;
|
||||||
|
UpdateDisplay(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvSimScope.UpdateDisplay(ClearFirst: Boolean);
|
||||||
|
begin
|
||||||
|
if Parent <> nil then
|
||||||
|
begin
|
||||||
|
if ClearFirst then
|
||||||
|
Clear;
|
||||||
|
Repaint;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
Reference in New Issue
Block a user