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

industrial: Add property ScaleMin to TA3nalogGauge.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7046 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-07-17 20:16:53 +00:00
parent 900f88ccf2
commit c48d965095
4 changed files with 110 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi
View File

@ -1,11 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>

51
components/industrialstuff/Example/A3nalogGaugeSample/main.lfm
View File

@ -49,13 +49,13 @@ object MainForm: TMainForm
FocusControl = CircleRadEdit
ParentColor = False
end
object ScaleLabel: TLabel
object ScaleMaxLabel: TLabel
Left = 295
Height = 15
Top = 120
Width = 58
Caption = 'Scale value'
FocusControl = ScaleEdit
Width = 84
Caption = 'Scale max value'
FocusControl = ScaleMaxEdit
ParentColor = False
end
object AngleLabel: TLabel
@ -80,7 +80,7 @@ object MainForm: TMainForm
Left = 393
Height = 15
Top = 40
Width = 54
Width = 55
Caption = 'Maximum'
FocusControl = MaximEdit
ParentColor = False
@ -113,7 +113,7 @@ object MainForm: TMainForm
ParentColor = False
end
object SubLenLabel: TLabel
Left = 295
Left = 393
Height = 15
Top = 168
Width = 57
@ -122,9 +122,11 @@ object MainForm: TMainForm
ParentColor = False
end
object CaptionLabel: TLabel
Left = 393
AnchorSideTop.Control = CaptionEdit
AnchorSideTop.Side = asrCenter
Left = 490
Height = 15
Top = 168
Top = 188
Width = 42
Caption = 'Caption'
FocusControl = CaptionEdit
@ -142,7 +144,7 @@ object MainForm: TMainForm
Left = 393
Height = 15
Top = 0
Width = 89
Width = 88
Caption = 'Timer delay (ms)'
FocusControl = FreqEdit
ParentColor = False
@ -210,13 +212,13 @@ object MainForm: TMainForm
OnChange = MarginEditChange
TabOrder = 5
end
object ScaleEdit: TSpinEdit
object ScaleMaxEdit: TSpinEdit
Left = 295
Height = 23
Top = 136
Width = 88
MaxValue = 0
OnChange = ScaleEditChange
OnChange = ScaleMaxEditChange
TabOrder = 6
end
object AngleEdit: TSpinEdit
@ -274,7 +276,7 @@ object MainForm: TMainForm
TabOrder = 12
end
object SubLenEdit: TSpinEdit
Left = 295
Left = 393
Height = 23
Top = 184
Width = 88
@ -340,7 +342,7 @@ object MainForm: TMainForm
Left = 490
Height = 19
Top = 164
Width = 156
Width = 157
Caption = 'Show indicator maximum'
OnClick = IndMaxBoxClick
TabOrder = 20
@ -391,10 +393,10 @@ object MainForm: TMainForm
TabOrder = 25
end
object CaptionEdit: TEdit
Left = 393
Left = 544
Height = 23
Top = 184
Width = 377
Width = 226
OnChange = CaptionEditChange
TabOrder = 26
Text = 'CaptionEdit'
@ -522,6 +524,24 @@ object MainForm: TMainForm
FocusControl = StyleBox
ParentColor = False
end
object ScaleMinLabel: TLabel
Left = 295
Height = 15
Top = 168
Width = 82
Caption = 'Scale min value'
FocusControl = ScaleMinEdit
ParentColor = False
end
object ScaleMinEdit: TSpinEdit
Left = 295
Height = 23
Top = 184
Width = 88
MaxValue = 0
OnChange = ScaleMinEditChange
TabOrder = 38
end
end
object Panel2: TPanel
Left = 0
@ -554,6 +574,7 @@ object MainForm: TMainForm
Layout = tlCenter
ParentColor = False
OnClick = AboutLabelClick
OnMouseLeave = AboutLabelMouseLeave
OnMouseMove = AboutLabelMouseMove
end
object StartStopButton: TButton

36
components/industrialstuff/Example/A3nalogGaugeSample/main.pas
View File

@ -23,6 +23,8 @@ type
{ TMainForm }
TMainForm = class(TForm)
ScaleMinEdit: TSpinEdit;
ScaleMinLabel: TLabel;
StartStopButton: TButton;
Panel1: TPanel;
Panel2: TPanel;
@ -56,8 +58,8 @@ type
CenterRadEdit: TSpinEdit;
CircleLabel: TLabel;
CircleRadEdit: TSpinEdit;
ScaleLabel: TLabel;
ScaleEdit: TSpinEdit;
ScaleMaxLabel: TLabel;
ScaleMaxEdit: TSpinEdit;
AngleLabel: TLabel;
AngleEdit: TSpinEdit;
WidthLabel: TLabel;
@ -86,7 +88,9 @@ type
AboutLabel: TLabel;
AAModeBox: TComboBox;
AAModeLabel: TLabel;
procedure AboutLabelMouseLeave(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ScaleMinEditChange(Sender: TObject);
procedure StartStopButtonClick(Sender: TObject);
procedure StyleBoxChange(Sender: TObject);
procedure TimerTimer(Sender: TObject);
@ -112,7 +116,7 @@ type
procedure MarginEditChange(Sender: TObject);
procedure CenterRadEditChange(Sender: TObject);
procedure CircleRadEditChange(Sender: TObject);
procedure ScaleEditChange(Sender: TObject);
procedure ScaleMaxEditChange(Sender: TObject);
procedure AngleEditChange(Sender: TObject);
procedure WidthEditChange(Sender: TObject);
procedure NumMainEditChange(Sender: TObject);
@ -202,7 +206,7 @@ begin
CenterRadEdit.Value := AnalogGauge1.CenterRadius;
CircleRadEdit.Value := AnalogGauge1.CircleRadius;
MarginEdit.Value := AnalogGauge1.Margin;
ScaleEdit.Value := AnalogGauge1.Scale;
ScaleMaxEdit.Value := AnalogGauge1.Scale;
AngleEdit.Value := AnalogGauge1.Angle;
MinimEdit.Value := AnalogGauge1.IndMinimum;
MaximEdit.Value := AnalogGauge1.IndMaximum;
@ -454,12 +458,21 @@ begin
end;
end;
procedure TMainForm.ScaleEditChange(Sender: TObject);
procedure TMainForm.ScaleMaxEditChange(Sender: TObject);
begin
if ScaleEdit.Text <> '' then begin
AnalogGauge1.Scale := ScaleEdit.Value;
AnalogGauge2.Scale := ScaleEdit.Value;
AnalogGauge3.Scale := ScaleEdit.Value;
if ScaleMaxEdit.Text <> '' then begin
AnalogGauge1.Scale := ScaleMaxEdit.Value;
AnalogGauge2.Scale := ScaleMaxEdit.Value;
AnalogGauge3.Scale := ScaleMaxEdit.Value;
end;
end;
procedure TMainForm.ScaleMinEditChange(Sender: TObject);
begin
if ScaleMinEdit.Text <> '' then begin
AnalogGauge1.ScaleMin := ScaleMinEdit.Value;
AnalogGauge2.ScaleMin := ScaleMinEdit.Value;
AnalogGauge3.ScaleMin := ScaleMinEdit.Value;
end;
end;
@ -718,5 +731,10 @@ begin
{$ENDIF}
end;
procedure TMainForm.AboutLabelMouseLeave(Sender: TObject);
begin
Screen.Cursor := crDefault;
end;
end.

63
components/industrialstuff/source/a3naloggauge.pas
View File

@ -68,7 +68,8 @@ type
FCaptionFont: TFont;
// values
FPosition: Single;
FScaleValue: Integer;
FScaleMaxValue: Integer;
FScaleMinValue: Integer;
FMinimum: Integer;
FMaximum: Integer;
FCaption: string;
@ -118,7 +119,8 @@ type
procedure SetLengthSubTicks(I: Integer);
procedure SetFaceOptions(O: TFaceOptions);
procedure SetPosition(V: Single);
procedure SetScaleValue(I: Integer);
procedure SetScaleMaxValue(I: Integer);
procedure SetScaleMinValue(I: Integer);
procedure SetMaximum(I: Integer);
procedure SetMinimum(I: Integer);
procedure SetCaption(const S: string);
@ -200,7 +202,9 @@ type
property Position: Single
read FPosition write SetPosition;
property Scale: Integer
read FScaleValue write SetScaleValue default 100;
read FScaleMaxValue write SetScaleMaxValue default 100;
property ScaleMin: Integer
read FScaleMinValue write SetScaleMinValue default 0;
property Style: TStyle
read FStyle write SetStyle default agsCenterStyle;
property TicksColor: TColor
@ -269,7 +273,8 @@ begin
FPosition := 0;
FMargin := Scale96ToFont(DEFAULT_MARGIN);
FStyle := agsCenterStyle;
FScaleValue := 100;
FScaleMaxValue := 100;
FScaleMiNValue := 0;
FMaximum := 80;
FMinimum := 20;
FScaleAngle := 120;
@ -351,6 +356,7 @@ var
txt: String;
txtDist: Integer;
apw: Integer; // pen width of arc
v: Double;
begin
W := Bitmap.Width;
H := Bitmap.Height;
@ -450,12 +456,12 @@ begin
Canvas.TextOut(pt.X - Canvas.TextWidth(FCaption) div 2, pt.Y, FCaption);
end;
{ Draw min/max indicator arcs }
{ Draw min/mid/max indicator arcs }
apw := Scale96ToFont(4 * K);
if (foShowIndicatorMax in FFaceOptions) then begin
SetPenStyles(Canvas.Pen, apw, FMaxColor);
SinCos(DegToRad(A + FScaleAngle), sinA, cosA);
SinCos(DegToRad(A + Max*FScaleAngle/FScaleValue), sinB, cosB);
SinCos(DegToRad(A + FScaleAngle * (Max - FScaleMinValue)/(FScaleMaxValue - FScaleMinValue)), sinB, cosB);
Canvas.Arc(X - J, Y - J, X + J, Y + J,
Round(C - J * cosA),
Round(Y - J * sinA),
@ -465,8 +471,8 @@ begin
end;
if (foShowIndicatorMid in FFaceOptions) and (FMinimum < FMaximum) then begin
SetPenStyles(Canvas.Pen, apw, FMidColor);
SinCos(DegToRad(A + Max*FScaleAngle/FScaleValue), sinA, cosA);
SinCos(DegToRad(A + Min*FScaleAngle/FScaleValue), sinB, cosB);
SinCos(DegToRad(A + FScaleAngle*(Max - FScaleMinValue)/(FScaleMaxValue - FScaleMinValue)), sinA, cosA);
SinCos(DegToRad(A + FScaleAngle*(Min - FScaleMinValue)/(FScaleMaxValue - FScaleMinValue)), sinB, cosB);
Canvas.Arc(X - J, Y - J, X + J, Y + J,
Round(C - J * cosA),
Round(Y - J * sinA),
@ -476,7 +482,7 @@ begin
end;
if (foShowIndicatorMin in FFaceOptions) then begin
SetPenStyles(Canvas.Pen, apw, FMinColor);
SinCos(DegToRad(A + Min*FScaleAngle/FScaleValue), sinA, cosA);
SinCos(DegToRad(A + FScaleAngle*(Min - FScaleMinValue)/(FScaleMaxValue-FScaleMinValue)), sinA, cosA);
SinCos(DegToRad(A), sinB, cosB);
Canvas.Arc(X - J, Y - J, X + J, Y + J,
Round(C - J * cosA),
@ -520,7 +526,8 @@ begin
hTxt := Canvas.TextHeight('Tg');
Canvas.Brush.Style := bsClear;
SinCos(DegToRad(A + dA), sinA, cosA);
txt := FormatFloat('0', I * fScaleValue div fNumMainTicks);
v := (fScaleMaxValue - fScaleMinValue) * I / fNumMainTicks + fScaleMinValue;
txt := FormatFloat('0', round(v));
wTxt := Canvas.TextWidth(txt);
Canvas.TextOut(
Round(C-(J-(FLengthMainTicks+txtDist)*K-I)*cosA) - wTxt div 2,
@ -537,6 +544,7 @@ var
J, X, Y, M, W, H, R: Integer;
A, C: Single;
cosA, sinA: Extended;
angle: Single;
begin
M := FMargin * K;
R := FCenterRadius * K;
@ -587,7 +595,8 @@ begin
raise Exception.Create('Style unknown');
end;{case}
SinCos((A + FPosition*FScaleAngle/FScaleValue)*pi/180, sinA, cosA);
angle := (FPosition - FScaleMinValue) / (FScaleMaxValue - FScaleMinValue) * FScaleAngle;
SinCos((A + angle)*pi/180, sinA, cosA);
Canvas.Pen.Width := FArrowWidth * K;
Canvas.Pen.Color := FArrowColor;
Canvas.MoveTo(X, Y);
@ -1077,20 +1086,34 @@ procedure TA3nalogGauge.SetPosition(V: Single);
begin
if V <> FPosition then begin
FPosition := V;
if FPosition < FScaleMinValue then FPosition := FScaleMinValue;
if FPosition > FScaleMaxValue then FPosition := FScaleMaxValue;
if (FPosition > fMaximum) and Assigned(FOverMax) then OnOverMax(Self);
if (FPosition < fMinimum) and Assigned(FOverMin) then OnOverMin(Self);
RedrawArrow;
end
end;
procedure TA3nalogGauge.SetScaleValue(I: Integer);
procedure TA3nalogGauge.SetScaleMaxValue(I: Integer);
begin
if I <> FScaleValue then begin
if I > 1 then begin
FScaleValue := I;
if FMaximum >= FScaleValue then FMaximum := FScaleValue - 1;
if FMinimum > FScaleValue - FMaximum then FMinimum := FScaleValue - fMaximum;
end;
if I <> FScaleMaxValue then begin
if I = FScaleMinValue then
exit;
FScaleMaxValue := I;
if FPosition > FScaleMaxValue then FPosition := FScaleMaxValue;
if FMaximum >= FScaleMaxValue then FMaximum := FScaleMaxValue - 1;
if FMinimum > FScaleMaxValue - FMaximum then FMinimum := FScaleMaxValue - fMaximum;
RedrawScale;
end;
end;
procedure TA3nalogGauge.SetScaleMinValue(I: Integer);
begin
if I <> FScaleMinValue then begin
if I = FScaleMaxValue then
exit;
FScaleMinValue := I;
if FPosition < FScaleMinValue then FPosition := FScaleMinValue;
RedrawScale;
end;
end;
@ -1098,7 +1121,7 @@ end;
procedure TA3nalogGauge.SetMaximum(I: Integer);
begin
if I <> FMaximum then begin
if (I > 0) and (I < FScaleValue) then
if (I > FScaleMinValue) and (I < FScaleMaxValue) then
FMaximum := I;
RedrawScale;
end;
@ -1107,7 +1130,7 @@ end;
procedure TA3nalogGauge.SetMinimum(I: Integer);
begin
if I <> FMinimum then begin
if (I > 0) and (I < FScaleValue) then
if (I > FScaleMinValue) and (I < FScaleMaxValue) then
FMinimum := I;
RedrawScale;
end