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"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="11"/> <Version Value="12"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="demo"/> <Title Value="demo"/>
<Scaled Value="True"/> <Scaled Value="True"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>

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

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

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

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

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

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