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

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
+    ColorAbove = clRed
-    ColorThumb = 10768896
+    ColorBelow = clYellow
+    ColorBetween = clGreen
+    ColorThumb = clBlack
     MaxPosition = 75
     MinPosition = 25
     SliderMode = smMinValueMax
-    ThumbStyle = tsTriangle
+    ThumbStyle = tsTriangleOtherSide
     OnPositionChange = MultiSlider1PositionChange
   end
   object ComboBox1: TComboBox

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;
+  FCircleRadius := Scale96ToFont(DEFAULT_CIRCLE_RADIUS);
-  FCenterRadius := 8;
+  FCenterRadius := Scale96ToFont(DEFAULT_CENTER_RADIUS);
   FNumMainTicks := 5;
-  FLengthMainTicks := 15;
+  FLengthMainTicks := Scale96ToFont(DEFAULT_LENGTH_MAINTICKS);
-  FLengthSubTicks := 8;
+  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);

components/industrialstuff/source/indgnoumeter.pas

@@ -106,15 +106,15 @@ type
     property Color;
     property Font;
     property ParentColor;
-    property ColorFore: Tcolor read fColorFore write SetColorFore;
+    property ColorFore: Tcolor read fColorFore write SetColorFore default clRed;
-    property ColorBack: Tcolor read fColorBack write SetColorBack;
+    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 ShowIncrements: Boolean read fShowIncrements write SetShowIncrements default true;
-    property Transparent: Boolean read GetTransparent write SetTransparent;
+    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.Left := LeftMeter + BarThickness + Scale96ToFont(10);
-    TheRect.Top := TopTextHeight - 6;
+    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

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].X := Scale96ToFont(DigitPoints[i].X * (FSize - 1));
-    Points[i].Y := DigitPoints[i].Y * (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;
 {=====}
 

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;
+  W := ClientWidth - 2*X; //130;
-  H := ClientHeight - 2*Y;
+  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
+var MiddleX: Integer;
-  MiddleX: Integer;
+    X, Y, W, H: Integer;
-  X, Y, W, H: Integer;
 begin
   X := Scale96ToFont(20);
   Y := Scale96ToFont(23);
@@ -408,9 +402,8 @@ begin
 end;
 
 procedure TAnalogSensor.PaintAsVertical;
-var
+var MiddleY: Integer;
-  MiddleY: Integer;
+    X, Y, W, H: Integer;
-  X, Y, W, H: Integer;
 begin
   X := Scale96ToFont(20);
   Y := Scale96ToFont(23);