industrial: Fix lcl scaling for TA3nalogGauge. Adapt sample project.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7300 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi

@@ -24,7 +24,6 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="0"/>
     </RunParams>
     <RequiredPackages Count="1">
       <Item1>

components/industrialstuff/Example/A3nalogGaugeSample/main.lfm

@@ -1,7 +1,7 @@
 object MainForm: TMainForm
-  Left = 427
+  Left = 430
   Height = 483
-  Top = 104
+  Top = 138
   Width = 779
   Caption = 'AntiAliased Analog Gauge demo'
   ClientHeight = 483
@@ -11,7 +11,6 @@ object MainForm: TMainForm
   OnCreate = FormCreate
   Position = poDefaultPosOnly
   LCLVersion = '2.1.0.0'
-  Scaled = False
   object Panel1: TPanel
     Left = 0
     Height = 216

components/industrialstuff/Example/A3nalogGaugeSample/main.pas

@@ -136,8 +136,7 @@ type
     procedure CaptionBoxClick(Sender: TObject);
     procedure CaptionEditChange(Sender: TObject);
     procedure CloseButtonClick(Sender: TObject);
-    procedure AboutLabelMouseMove(Sender: TObject; Shift: TShiftState; X,
+    procedure AboutLabelMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
-      Y: Integer);
     procedure AboutLabelClick(Sender: TObject);
   private
     AnalogGauge1: TA3nalogGauge;
@@ -195,7 +194,7 @@ begin
     Left := 490;
     Top := 16;
     Width := 278;
-    Height := 200; //245;
+    Height := 200;
     Anchors := [akRight, akTop, akBottom];
     Angle := 180;
     Caption := 'mV';
@@ -206,7 +205,7 @@ begin
   CenterRadEdit.Value := AnalogGauge1.CenterRadius;
   CircleRadEdit.Value := AnalogGauge1.CircleRadius;
   MarginEdit.Value := AnalogGauge1.Margin;
-  ScaleMaxEdit.Value := AnalogGauge1.Scale;
+  ScaleMaxEdit.Value := AnalogGauge1.ScaleMax;
   AngleEdit.Value := AnalogGauge1.Angle;
   MinimEdit.Value := AnalogGauge1.IndMinimum;
   MaximEdit.Value := AnalogGauge1.IndMaximum;
@@ -267,8 +266,8 @@ begin
     V := 0;
     FDelta := -FDelta
   end else
-  if V > AnalogGauge1.Scale then begin
+  if V > AnalogGauge1.ScaleMax then begin
-    V := AnalogGauge1.Scale;
+    V := AnalogGauge1.ScaleMax;
     FDelta := -FDelta
   end;
   AnalogGauge1.Position := V;
@@ -461,9 +460,9 @@ end;
 procedure TMainForm.ScaleMaxEditChange(Sender: TObject);
 begin
   if ScaleMaxEdit.Text <> '' then begin
-    AnalogGauge1.Scale := ScaleMaxEdit.Value;
+    AnalogGauge1.ScaleMax := ScaleMaxEdit.Value;
-    AnalogGauge2.Scale := ScaleMaxEdit.Value;
+    AnalogGauge2.ScaleMax := ScaleMaxEdit.Value;
-    AnalogGauge3.Scale := ScaleMaxEdit.Value;
+    AnalogGauge3.ScaleMax := ScaleMaxEdit.Value;
   end;
 end;
 

components/industrialstuff/source/a3naloggauge.pas

@@ -11,7 +11,7 @@ unit A3nalogGauge;
 interface
 
 uses
-  LCLIntf, LCLType, LCLProc, Types,
+  LCLIntf, LCLType, LCLProc, LCLVersion, Types,
   {$IFDEF TICKER} Windows,{$ENDIF}      // for QueryPerformanceCounter
   SysUtils, Classes, Graphics, Controls;
 
@@ -27,19 +27,20 @@ type
   );
   TFaceOptions = set of TFaceOption;
 
-const
-  DEFAULT_FACE_OPTIONS = [
-    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)
+  private
+    const
+      DEFAULT_FACE_OPTIONS = [
+        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;
+      DEFAULT_TEXT_DIST = 10;
   private
     // face elements colors
     FMinColor: TColor;
@@ -59,6 +60,7 @@ type
     FCircleRadius: Integer;
     FScaleAngle: Integer;
     FMargin: Integer;
+    FTextDist: Integer;
     FStyle: TStyle;
     FArrowWidth: Integer;
     FNumMainTicks: Integer;
@@ -91,11 +93,6 @@ 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);
@@ -121,6 +118,7 @@ type
     procedure SetPosition(V: Single);
     procedure SetScaleMaxValue(I: Integer);
     procedure SetScaleMinValue(I: Integer);
+    procedure SetTextDist(I: Integer);
     procedure SetMaximum(I: Integer);
     procedure SetMinimum(I: Integer);
     procedure SetCaption(const S: string);
@@ -130,25 +128,32 @@ type
 
   protected
     procedure CaptionFontChanged(Sender: TObject);
-    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 FontChanged(Sender: TObject); override;
+    class function GetControlClassDefaultSize: TSize; override;
     procedure Loaded; override;
     procedure RedrawArrow;
     procedure RedrawScale;
     procedure Paint; override;
     procedure Resize; override;
-    procedure FontChanged(Sender: TObject); override;
-    class function GetControlClassDefaultSize: TSize; override;
     //procedure CMFontChanged(var Msg: TMessage); message CM_FontChanged;
     //procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
 
+  { LCL scaling }
+  protected
+    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); override;
+  public
+    {$IF LCL_FullVersion >= 2010000}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
+    {$IFEND}
+    procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
 
   published
     property Angle: Integer
@@ -168,11 +173,11 @@ type
     property CenterColor: TColor
       read FCenterColor write SetCenterColor default clDkGray;
     property CenterRadius: Integer
-      read FCenterRadius write SetCenterRadius stored IsCenterRadiusStored;
+      read FCenterRadius write SetCenterRadius default DEFAULT_CENTER_RADIUS;
     property CircleColor: TColor
       read FCircleColor write SetCircleColor default clBlue;
     property CircleRadius: Integer
-      read FCircleRadius write SetCircleRadius stored IsCircleRadiusStored;
+      read FCircleRadius write SetCircleRadius default DEFAULT_CIRCLE_RADIUS;
     property FaceColor: TColor
       read FFaceColor write SetFaceColor default clBtnFace;
     property FaceOptions: TFaceOptions
@@ -184,11 +189,11 @@ type
     property IndMinimum: Integer
       read FMinimum write SetMinimum default 20;
     property LengthMainTicks: Integer
-      read FLengthMainTicks write SetLengthMainTicks stored IsLengthMainTicksStored;
+      read FLengthMainTicks write SetLengthMainTicks default DEFAULT_LENGTH_MAINTICKS;
     property LengthSubTicks: Integer
-      read FLengthSubTicks write SetLengthSubTicks stored IsLengthSubTicksStored;
+      read FLengthSubTicks write SetLengthSubTicks default DEFAULT_LENGTH_SUBTICKS;
     property Margin: Integer
-      read FMargin write SetMargin stored IsMarginStored;
+      read FMargin write SetMargin default DEFAULT_MARGIN;
     property MarginColor: TColor
       read FMarginColor write SetMarginColor default clSilver;
     property MaxColor: TColor
@@ -209,6 +214,8 @@ type
       read FScaleMinValue write SetScaleMinValue default 0;
     property Style: TStyle
       read FStyle write SetStyle default agsCenterStyle;
+    property TextDist: Integer
+      read FTextDist write SetTextDist default DEFAULT_TEXT_DIST;
     property TicksColor: TColor
       read FTicksColor write SetTicksColor default clBlack;
     property ValueColor: TColor
@@ -242,10 +249,14 @@ var
   w, h: Integer;
 begin
   inherited;
+
   FBackBitmap := TBitmap.Create;
   FFaceBitmap := TBitmap.Create;
   FAABitmap := nil;
+
   //*****************************defaults:****************************************
+  Constraints.MinWidth := 60;
+  Constraints.MinHeight := 50;
   with GetControlClassDefaultSize do begin
     SetInitialBounds(0, 0, CX, CY);
     w := CX;
@@ -273,18 +284,19 @@ begin
   FMaxColor := clRed;
   FArrowWidth := 1;
   FPosition := 0;
-  FMargin := Scale96ToFont(DEFAULT_MARGIN);
+  FMargin := DEFAULT_MARGIN;
   FStyle := agsCenterStyle;
   FScaleMaxValue := 100;
   FScaleMiNValue := 0;
   FMaximum := 80;
   FMinimum := 20;
   FScaleAngle := 120;
-  FCircleRadius := Scale96ToFont(DEFAULT_CIRCLE_RADIUS);
+  FCircleRadius := DEFAULT_CIRCLE_RADIUS;
-  FCenterRadius := Scale96ToFont(DEFAULT_CENTER_RADIUS);
+  FCenterRadius := DEFAULT_CENTER_RADIUS;
+  FTextDist := DEFAULT_TEXT_DIST;
   FNumMainTicks := 5;
-  FLengthMainTicks := Scale96ToFont(DEFAULT_LENGTH_MAINTICKS);
+  FLengthMainTicks := DEFAULT_LENGTH_MAINTICKS;
-  FLengthSubTicks := Scale96ToFont(DEFAULT_LENGTH_SUBTICKS);
+  FLengthSubTicks := DEFAULT_LENGTH_SUBTICKS;
   FCaption := '';
   FFaceOptions := DEFAULT_FACE_OPTIONS;
   FAntiAliased := aaNone;
@@ -327,21 +339,12 @@ begin
   inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
   begin
-    DisableAutosizing;
+    FCenterRadius := Round(FCenterRadius * AXProportion);
-    try
+    FCircleRadius := Round(FCircleRadius * AXProportion);
-      if IsCenterRadiusStored then
+    FLengthMainTicks := Round(FLengthMainTicks * AXProportion);
-        FCenterRadius := Round(FCenterRadius * AXProportion);
+    FLengthSubTicks := Round(FLengthSubTicks * AXProportion);
-      if IsCircleRadiusStored then
+    FMargin := Round(FMargin * AXProportion);
-        FCircleRadius := Round(FCircleRadius * AXProportion);
+    FTextDist := Round(FTextDist * 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;
 
@@ -356,7 +359,6 @@ var
   tm: TTextMetric;
   pt: TPoint;
   txt: String;
-  txtDist: Integer;
   apw: Integer;  // pen width of arc
   v: Double;
 begin
@@ -367,7 +369,6 @@ begin
   N := FNumMainTicks * 5;
   M := FMargin * K;
   R := FCircleRadius * K;
-  txtDist := Scale96ToFont(10);
 
   with Bitmap do begin
     Canvas.Brush.Color := FFaceColor;
@@ -459,7 +460,7 @@ begin
     end;
 
     { Draw min/mid/max indicator arcs }
-    apw := Scale96ToFont(4 * K);
+    apw := 4 * K; //Scale96ToFont(4 * K);
     if (foShowIndicatorMax in FFaceOptions) then begin
       SetPenStyles(Canvas.Pen, apw, FMaxColor);
       SinCos(DegToRad(A + FScaleAngle), sinA, cosA);
@@ -532,8 +533,8 @@ begin
         txt := FormatFloat('0', round(v));
         wTxt := Canvas.TextWidth(txt);
         Canvas.TextOut(
-          Round(C-(J-(FLengthMainTicks+txtDist)*K-I)*cosA) - wTxt div 2,
+          Round(C-(J-(FLengthMainTicks+FTextDist)*K-I)*cosA) - wTxt div 2,
-          Round(Y-(J-(FLengthMainTicks+txtDist)*K)*sinA) - hTxt div 2,
+          Round(Y-(J-(FLengthMainTicks+FTextDist)*K)*sinA) - hTxt div 2,
           txt
         );
       end;
@@ -808,31 +809,6 @@ 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;
@@ -866,10 +842,12 @@ procedure TA3nalogGauge.Resize;
 var
   K: Integer;
 begin
+(*
   if Width < 60 then
     Width := 60;
   if Height < 50 then
     Height := 50;
+  *)
 
   if FAntiAliased = aaNone then begin
     FBackBitmap.Width := Width;
@@ -889,6 +867,14 @@ begin
   inherited;
 end;
 
+{$IF LCL_FullVersion >= 2010000}
+procedure TA3nalogGauge.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(FCaptionFont, ADesignTimePPI);
+end;
+{$IFEND}
+
 procedure TA3nalogGauge.ScaleFontsPPI(const AToPPI: Integer;
   const AProportion: Double);
 begin
@@ -1120,6 +1106,14 @@ begin
   end;
 end;
 
+procedure TA3nalogGauge.SetTextDist(I: Integer);
+begin
+  if I <> FTextDist then begin
+    FTextDist := I;
+    RedrawScale;
+  end;
+end;
+
 procedure TA3nalogGauge.SetMaximum(I: Integer);
 begin
   if I <> FMaximum then begin