From 19acc480ad081786cb5cd0cc68d7db4b4b96dbde Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 22 Apr 2019 16:12:52 +0000 Subject: [PATCH] Industrial: Make TA3nalogGauge and TLEDNumber high-dpi aware. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6857 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../industrialstuff/Example/u_industrial.lfm | 14 +-- .../industrialstuff/source/a3naloggauge.pas | 106 +++++++++++++++--- .../industrialstuff/source/indgnoumeter.pas | 21 ++-- .../industrialstuff/source/lednumber.pas | 8 +- components/industrialstuff/source/sensors.pas | 23 ++-- 5 files changed, 116 insertions(+), 56 deletions(-) diff --git a/components/industrialstuff/Example/u_industrial.lfm b/components/industrialstuff/Example/u_industrial.lfm index 54a929fb7..1d3d08b28 100644 --- a/components/industrialstuff/Example/u_industrial.lfm +++ b/components/industrialstuff/Example/u_industrial.lfm @@ -94,22 +94,16 @@ object Form1: TForm1 Width = 120 Caption = 'Voltage' Value = 50 - Color = clPurple ParentColor = False - ColorFore = clRed - ColorBack = clInactiveCaption SignalUnit = 'mV' ValueMin = 0 ValueMax = 100 Digits = 0 Increment = 10 - ShowIncrements = True - Transparent = True GapTop = 10 GapBottom = 5 BarThickness = 6 MarkerColor = clBlue - ShowMarker = True end object Arrow1: TArrow Left = 48 @@ -150,12 +144,14 @@ object Form1: TForm1 Height = 35 Top = 180 Width = 504 - ColorBetween = 16481536 - ColorThumb = 10768896 + ColorAbove = clRed + ColorBelow = clYellow + ColorBetween = clGreen + ColorThumb = clBlack MaxPosition = 75 MinPosition = 25 SliderMode = smMinValueMax - ThumbStyle = tsTriangle + ThumbStyle = tsTriangleOtherSide OnPositionChange = MultiSlider1PositionChange end object ComboBox1: TComboBox diff --git a/components/industrialstuff/source/a3naloggauge.pas b/components/industrialstuff/source/a3naloggauge.pas index edddff37f..257372aab 100644 --- a/components/industrialstuff/source/a3naloggauge.pas +++ b/components/industrialstuff/source/a3naloggauge.pas @@ -32,6 +32,11 @@ const foShowMainTicks, foShowSubTicks, foShowIndicatorMax, foShowValues, foShowCenter, foShowFrame, foShow3D, foShowCaption ]; + DEFAULT_CENTER_RADIUS = 8; + DEFAULT_CIRCLE_RADIUS = 3; + DEFAULT_LENGTH_MAINTICKS = 15; + DEFAULT_LENGTH_SUBTICKS = 8; + DEFAULT_MARGIN = 10; type TA3nalogGauge = class(TCustomControl) @@ -85,6 +90,11 @@ type FOnFrames: TNotifyEvent; {$ENDIF} // set properties + function IsCenterRadiusStored: Boolean; + function IsCircleRadiusStored: Boolean; + function IsLengthMainTicksStored: Boolean; + function IsLengthSubTicksStored: Boolean; + function IsMarginStored: Boolean; procedure SetFrameColor(C: TColor); procedure SetMinColor(C: TColor); procedure SetMidColor(C: TColor); @@ -118,8 +128,10 @@ type protected procedure CaptionFontChanged(Sender: TObject); - procedure DrawScale(Bitmap: TBitmap; K: Integer); + procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; + const AXProportion, AYProportion: Double); override; procedure DrawArrow(Bitmap: TBitmap; K: Integer); + procedure DrawScale(Bitmap: TBitmap; K: Integer); procedure FastAntiAliasPicture; procedure Loaded; override; procedure RedrawArrow; @@ -134,6 +146,7 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override; published property Angle: Integer @@ -153,11 +166,11 @@ type property CenterColor: TColor read FCenterColor write SetCenterColor default clDkGray; property CenterRadius: Integer - read FCenterRadius write SetCenterRadius default 8; + read FCenterRadius write SetCenterRadius stored IsCenterRadiusStored; property CircleColor: TColor read FCircleColor write SetCircleColor default clBlue; property CircleRadius: Integer - read FCircleRadius write SetCircleRadius default 3; + read FCircleRadius write SetCircleRadius stored IsCircleRadiusStored; property FaceColor: TColor read FFaceColor write SetFaceColor default clBtnFace; property FaceOptions: TFaceOptions @@ -169,11 +182,11 @@ type property IndMinimum: Integer read FMinimum write SetMinimum default 20; property LengthMainTicks: Integer - read FLengthMainTicks write SetLengthMainTicks default 15; + read FLengthMainTicks write SetLengthMainTicks stored IsLengthMainTicksStored; property LengthSubTicks: Integer - read FLengthSubTicks write SetLengthSubTicks default 8; + read FLengthSubTicks write SetLengthSubTicks stored IsLengthSubTicksStored; property Margin: Integer - read FMargin write SetMargin default 10; + read FMargin write SetMargin stored IsMarginStored; property MarginColor: TColor read FMarginColor write SetMarginColor default clSilver; property MaxColor: TColor @@ -246,7 +259,7 @@ begin FValueColor := clBlack; FCaptionColor := clBlack; FArrowColor := clBlack; - FMarginColor := clSilver; //Black; + FMarginColor := clSilver; FCenterColor := clDkGray; FCircleColor := clBlue; FMinColor := clGreen; @@ -254,17 +267,17 @@ begin FMaxColor := clRed; FArrowWidth := 1; FPosition := 0; - FMargin := 10; + FMargin := Scale96ToFont(DEFAULT_MARGIN); FStyle := agsCenterStyle; FScaleValue := 100; FMaximum := 80; FMinimum := 20; FScaleAngle := 120; - FCircleRadius := 3; - FCenterRadius := 8; + FCircleRadius := Scale96ToFont(DEFAULT_CIRCLE_RADIUS); + FCenterRadius := Scale96ToFont(DEFAULT_CENTER_RADIUS); FNumMainTicks := 5; - FLengthMainTicks := 15; - FLengthSubTicks := 8; + FLengthMainTicks := Scale96ToFont(DEFAULT_LENGTH_MAINTICKS); + FLengthSubTicks := Scale96ToFont(DEFAULT_LENGTH_SUBTICKS); FCaption := ''; FFaceOptions := DEFAULT_FACE_OPTIONS; FAntiAliased := aaNone; @@ -300,6 +313,31 @@ begin RedrawScale; end; +procedure TA3nalogGauge.DoAutoAdjustLayout( + const AMode: TLayoutAdjustmentPolicy; + const AXProportion, AYProportion: Double); +begin + inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion); + if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then + begin + DisableAutosizing; + try + if IsCenterRadiusStored then + FCenterRadius := Round(FCenterRadius * AXProportion); + if IsCircleRadiusStored then + FCircleRadius := Round(FCircleRadius * AXProportion); + if IsLengthMainTicksStored then + FLengthMainTicks := Round(FLengthMainTicks * AXProportion); + if IsLengthSubTicksStored then + FLengthSubTicks := Round(FLengthSubTicks * AXProportion); + if IsMarginStored then + FMargin := Round(FMargin * AXProportion); + finally + EnableAutoSizing; + end; + end; +end; + procedure TA3nalogGauge.DrawScale(Bitmap: TBitmap; K: Integer); var I, J, X, Y, N, M, W, H, R: Integer; @@ -312,15 +350,16 @@ var pt: TPoint; txt: String; txtDist: Integer; + apw: Integer; // pen width of arc begin W := Bitmap.Width; H := Bitmap.Height; Max := FMaximum; Min := FMinimum; - N := FNumMainTicks*5; + N := FNumMainTicks * 5; M := FMargin * K; R := FCircleRadius * K; - txtDist := 10; + txtDist := Scale96ToFont(10); with Bitmap do begin Canvas.Brush.Color := FFaceColor; @@ -412,8 +451,9 @@ begin end; { Draw min/max indicator arcs } + apw := Scale96ToFont(4 * K); if (foShowIndicatorMax in FFaceOptions) then begin - SetPenStyles(Canvas.Pen, 4 * K, FMaxColor); + SetPenStyles(Canvas.Pen, apw, FMaxColor); SinCos(DegToRad(A + FScaleAngle), sinA, cosA); SinCos(DegToRad(A + Max*FScaleAngle/FScaleValue), sinB, cosB); Canvas.Arc(X - J, Y - J, X + J, Y + J, @@ -424,7 +464,7 @@ begin ); end; if (foShowIndicatorMid in FFaceOptions) and (FMinimum < FMaximum) then begin - SetPenStyles(Canvas.Pen, 4 * K, FMidColor); + SetPenStyles(Canvas.Pen, apw, FMidColor); SinCos(DegToRad(A + Max*FScaleAngle/FScaleValue), sinA, cosA); SinCos(DegToRad(A + Min*FScaleAngle/FScaleValue), sinB, cosB); Canvas.Arc(X - J, Y - J, X + J, Y + J, @@ -435,9 +475,9 @@ begin ); end; if (foShowIndicatorMin in FFaceOptions) then begin + SetPenStyles(Canvas.Pen, apw, FMinColor); SinCos(DegToRad(A + Min*FScaleAngle/FScaleValue), sinA, cosA); SinCos(DegToRad(A), sinB, cosB); - SetPenStyles(Canvas.Pen, 4 * K, FMinColor); Canvas.Arc(X - J, Y - J, X + J, Y + J, Round(C - J * cosA), Round(Y - J * sinA), @@ -757,6 +797,31 @@ begin end; } +function TA3nalogGauge.IsCenterRadiusStored: Boolean; +begin + Result := FCenterRadius <> Scale96ToFont(DEFAULT_CENTER_RADIUS); +end; + +function TA3nalogGauge.IsCircleRadiusStored: Boolean; +begin + Result := FCircleRadius <> Scale96ToFont(DEFAULT_CIRCLE_RADIUS); +end; + +function TA3nalogGauge.IsLengthMainTicksStored: Boolean; +begin + Result := FLengthMainTicks <> Scale96ToFont(DEFAULT_LENGTH_MAINTICKS); +end; + +function TA3nalogGauge.IsLengthSubTicksStored: Boolean; +begin + Result := FLengthSubTicks <> Scale96ToFont(DEFAULT_LENGTH_SUBTICKS); +end; + +function TA3nalogGauge.IsMarginStored: Boolean; +begin + Result := FMargin <> Scale96ToFont(DEFAULT_MARGIN); +end; + procedure TA3nalogGauge.Loaded; begin inherited; @@ -813,6 +878,13 @@ begin inherited; end; +procedure TA3nalogGauge.ScaleFontsPPI(const AToPPI: Integer; + const AProportion: Double); +begin + inherited; + DoScaleFontPPI(FCaptionFont, AToPPI, AProportion); +end; + procedure TA3nalogGauge.SetCaptionFont(AValue: TFont); begin FCaptionFont.Assign(AValue); diff --git a/components/industrialstuff/source/indgnoumeter.pas b/components/industrialstuff/source/indgnoumeter.pas index 1395114c7..e27b307b0 100644 --- a/components/industrialstuff/source/indgnoumeter.pas +++ b/components/industrialstuff/source/indgnoumeter.pas @@ -106,15 +106,15 @@ type property Color; property Font; property ParentColor; - property ColorFore: Tcolor read fColorFore write SetColorFore; - property ColorBack: Tcolor read fColorBack write SetColorBack; + property ColorFore: Tcolor read fColorFore write SetColorFore default clRed; + property ColorBack: Tcolor read fColorBack write SetColorBack default clBtnFace; property SignalUnit: ShortString read fSignalUnit write SetSignalUnit; property ValueMin: Double read fValueMin write SetValueMin; property ValueMax: Double read fValueMax write SetValueMax; property Digits: Byte read fDigits write SetDigits; property Increment: Double read fIncrement write SetIncrement; - property ShowIncrements: Boolean read fShowIncrements write SetShowIncrements; - property Transparent: Boolean read GetTransparent write SetTransparent; + property ShowIncrements: Boolean read fShowIncrements write SetShowIncrements default true; + property Transparent: Boolean read GetTransparent write SetTransparent default true; property GapTop: Word read fGapTop write SetGapTop stored IsGapTopStored; property GapBottom: Word @@ -126,7 +126,7 @@ type read fMarkerDist write SetMarkerDist stored IsMarkerDistStored; property MarkerSize: Integer read fMarkerSize write SetMarkerSize stored IsMarkerSizeStored; - property ShowMarker: Boolean read fShowMarker write SetShowMarker; + property ShowMarker: Boolean read fShowMarker write SetShowMarker default true; end; @@ -462,9 +462,9 @@ begin with Canvas do begin TheRect := ClientRect; - TheRect.Left := LeftMeter + BarThickness + 10; + TheRect.Left := LeftMeter + BarThickness + Scale96ToFont(10); TheRect.Top := TopTextHeight; - TheRect.Bottom := Height - fGapBottom + 6; + TheRect.Bottom := Height - fGapBottom + Scale96ToFont(6); Brush.Style := bsClear; DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_BOTTOM; DisplayValue := FloatToStrF(ValueMin, ffFixed, 8, fDigits) + ' ' + fSignalUnit; @@ -478,8 +478,8 @@ begin with Canvas do begin TheRect := ClientRect; - TheRect.Left := LeftMeter + BarThickness + 10; - TheRect.Top := TopTextHeight - 6; + TheRect.Left := LeftMeter + BarThickness + Scale96ToFont(10); + TheRect.Top := TopTextHeight - Scale96ToFont(6); Brush.Style := bsClear; DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_TOP; DisplayValue := FloatToStrF(ValueMax, ffFixed, 8, fDigits) + ' ' + fSignalUnit; @@ -523,7 +523,6 @@ begin MoveTo(LeftMeter + 1, ValueToPixels(fValue) - 1); LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue) - 1); end; - end; end; @@ -541,7 +540,7 @@ end; procedure TindGnouMeter.Paint; begin - LeftMeter := (Width div 2) - 10 - fBarThickness; + LeftMeter := (Width div 2) - Scale96ToFont(10) - fBarThickness; with Canvas do begin if not Transparent then diff --git a/components/industrialstuff/source/lednumber.pas b/components/industrialstuff/source/lednumber.pas index 4904a4f20..522ec1498 100644 --- a/components/industrialstuff/source/lednumber.pas +++ b/components/industrialstuff/source/lednumber.pas @@ -311,8 +311,8 @@ var I : Integer; begin for I := 0 to MAX_POINTS do begin - Points[i].X := DigitPoints[i].X * (FSize - 1); - Points[i].Y := DigitPoints[i].Y * (FSize - 1); + Points[i].X := Scale96ToFont(DigitPoints[i].X * (FSize - 1)); + Points[i].Y := Scale96ToFont(DigitPoints[i].Y * (FSize - 1)); end; end; {=====} @@ -320,9 +320,9 @@ end; function TCustomLEDNumber.NewOffset(xOry: char; OldOffset: Integer): Integer; begin if (xOry = 'x')then - newOffset := oldOffset + 17 * (FSize - 1) + newOffset := oldOffset + Scale96ToFont(17 * (FSize - 1)) else - newOffset := oldOffset + 30 * (FSize -1) + newOffset := oldOffset + Scale96ToFont(30 * (FSize -1)) end; {=====} diff --git a/components/industrialstuff/source/sensors.pas b/components/industrialstuff/source/sensors.pas index f9adca195..feeebbfc8 100644 --- a/components/industrialstuff/source/sensors.pas +++ b/components/industrialstuff/source/sensors.pas @@ -137,14 +137,9 @@ begin with FlblShowText do begin Alignment := taCenter; - AutoSize := False; - Font := Self.Font; - Height := 17; - Left := 5; - Top := 57; - Width := 160; - Parent := Self; Align := alBottom; + Font := Self.Font; + Parent := Self; end; FShowLevel := True; @@ -325,8 +320,8 @@ var begin X := Scale96ToFont(20); Y := Scale96ToFont(23); - W := ClientWidth - 2*X; - H := ClientHeight - 2*Y; + W := ClientWidth - 2*X; //130; + H := ClientHeight - 2*Y; //33; if (W < 1) or (H < 1) then Exit; with Canvas do @@ -366,9 +361,8 @@ begin end; procedure TAnalogSensor.PaintAsHorizontal; -var - MiddleX: Integer; - X, Y, W, H: Integer; +var MiddleX: Integer; + X, Y, W, H: Integer; begin X := Scale96ToFont(20); Y := Scale96ToFont(23); @@ -408,9 +402,8 @@ begin end; procedure TAnalogSensor.PaintAsVertical; -var - MiddleY: Integer; - X, Y, W, H: Integer; +var MiddleY: Integer; + X, Y, W, H: Integer; begin X := Scale96ToFont(20); Y := Scale96ToFont(23);