industrial: Make TindGnouMeter high-dpi aware. Some clean-up.

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

components/industrialstuff/source/AdvLed.pas

@@ -47,7 +47,7 @@ type
     procedure SetGlyph(const Index: Integer; const Value: TLedBitmap);
     procedure SetBlinkDuration(const Value: Integer);
     procedure SetBlink(const Value: Boolean);
-    function StoredGlyph(const Index: Integer): Boolean;
+    function StoredGlyph(const {%H-}Index: Integer): Boolean;
     procedure SelectLedBitmap(const LedKind: TLedKind);
     function BitmapToDraw: TLedBitmap;
     procedure BitmapNeeded;

components/industrialstuff/source/indcyBaseLed.pas

@@ -59,7 +59,7 @@ type
     procedure Loaded; override;
     procedure SetEnabled(Value: Boolean); override;
     procedure CMButtonPressed(var Message: TLMessage); message CM_BUTTONPRESSED;  // Called in UpdateExclusive procedure ...
-    function  TransparentColorAtPos(Point: TPoint): boolean; virtual;
+    function  TransparentColorAtPos({%H-}Point: TPoint): boolean; virtual;
     procedure LedStatusChanged; virtual;
     procedure SetInternalLedValue(Value: Boolean);
     function  GetLedStatus: TLedStatus; virtual;
@@ -113,11 +113,12 @@ end;
 
 function TcyBaseLed.TransparentColorAtPos(Point: TPoint): boolean;
 begin
-  RESULT := false;
+  Result := false;
 end;
 
 procedure TcyBaseLed.Click;
-var aPt: TPoint;
+var
+  aPt: TPoint = (x:0; y:0);
 begin
   if not FReadOnly
   then begin

components/industrialstuff/source/indcyGraphics.pas

@@ -44,8 +44,8 @@ interface
 
 // We need to put jpeg to the uses for avoid run-time not handled jpeg image ...
 uses
-  LCLIntf, LCLType, Types, Classes, Forms, Graphics, Math, Buttons, Controls,
+  LCLIntf, LCLType, Types, Classes, Forms, Graphics, Buttons, Controls,
-  ExtCtrls, SysUtils, indcyTypes;
+  ExtCtrls, SysUtils;
 
 // Objects painting functions :
 procedure cyFrame3D(Canvas: TCanvas; var Rect: TRect; TopLeftColor, BottomRightColor: TColor; Width: Integer;

components/industrialstuff/source/indgnoumeter.pas

@@ -23,9 +23,16 @@ unit indGnouMeter;
 interface
 
 uses
-  Classes, Controls, Graphics, SysUtils, //Messages,
+  Classes, Controls, Graphics, SysUtils,
   LMessages, Types, LCLType, LCLIntf;
 
+const
+  DEFAULT_BAR_THICKNESS = 5;
+  DEFAULT_GAP_TOP = 20;
+  DEFAULT_GAP_BOTTOM = 10;
+  DEFAULT_MARKER_DIST = 4;
+  DEFAULT_MARKER_SIZE = 6;
+
 type
   TindGnouMeter = class(TGraphicControl)
   private
@@ -42,14 +49,21 @@ type
     fGapBottom: Word;
     fBarThickness: Word;
     fMarkerColor: TColor;
+    fMarkerDist: Integer;
+    fMarkerSize: Integer;
     fShowMarker: Boolean;
     //Variables used internally
     TopTextHeight: Word;
-    LeftMeter: Word;
+    LeftMeter: Integer;
     DisplayValue: String;
     DrawStyle: integer;
     TheRect: TRect;
     //End of variables used internally
+    function IsBarThicknessStored: Boolean;
+    function IsGapBottomStored: Boolean;
+    function IsGapTopStored: Boolean;
+    function IsMarkerDistStored: Boolean;
+    function IsMarkerSizeStored: Boolean;
     procedure SetValue(val: Double);
     procedure SetColorBack(val: TColor);
     procedure SetColorFore(val: TColor);
@@ -65,6 +79,8 @@ type
     procedure SetGapBottom(val: Word);
     procedure SetBarThickness(val: Word);
     procedure SetMarkerColor(val: TColor);
+    procedure SetMarkerDist(val: Integer);
+    procedure SetMarkerSize(val: Integer);
     procedure SetShowMarker(val: Boolean);
     procedure DrawTopText;
     procedure DrawMeterBar;
@@ -74,8 +90,10 @@ type
     procedure DrawValueMin;
     procedure DrawMarker;
   protected
+    procedure CMTextChanged(var {%H-}Message: TLMessage); message CM_TEXTCHANGED;
+    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); override;
     procedure Paint; override;
-    procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -97,10 +115,17 @@ type
     property Increment: Double read fIncrement write SetIncrement;
     property ShowIncrements: Boolean read fShowIncrements write SetShowIncrements;
     property Transparent: Boolean read GetTransparent write SetTransparent;
-    property GapTop: Word read fGapTop write SetGapTop;
+    property GapTop: Word
-    property GapBottom: Word read fGapBottom write SetGapBottom;
+      read fGapTop write SetGapTop stored IsGapTopStored;
-    property BarThickness: Word read fBarThickness write SetBarThickness;
+    property GapBottom: Word
+      read fGapBottom write SetGapBottom stored IsGapBottomStored;
+    property BarThickness: Word
+      read fBarThickness write SetBarThickness stored IsBarThicknessStored;
     property MarkerColor: TColor read fMarkerColor write SetMarkerColor;
+    property MarkerDist: Integer
+      read fMarkerDist write SetMarkerDist stored IsMarkerDistStored;
+    property MarkerSize: Integer
+      read fMarkerSize write SetMarkerSize stored IsMarkerSizeStored;
     property ShowMarker: Boolean read fShowMarker write SetShowMarker;
   end;
 
@@ -122,9 +147,11 @@ begin
   fShowIncrements := True;
   fShowMarker := True;
   fValue := 0;
-  fGapTop := 20;
+  fGapTop := Scale96ToFont(DEFAULT_GAP_TOP);
-  fGapBottom := 10;
+  fGapBottom := Scale96ToFont(DEFAULT_GAP_BOTTOM);
-  fBarThickness := 5;
+  fBarThickness := Scale96ToFont(DEFAULT_BAR_THICKNESS);
+  fMarkerDist := Scale96ToFont(DEFAULT_MARKER_DIST);
+  fMarkerSize := Scale96ToFont(DEFAULT_MARKER_SIZE);
   fSignalUnit := 'Units';
 end;
 
@@ -138,6 +165,56 @@ begin
   Invalidate;
 end;
 
+procedure TindGnouMeter.DoAutoAdjustLayout(
+  const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    DisableAutosizing;
+    try
+      if IsBarThicknessStored then
+        FBarThickness := Round(FBarThickness * AXProportion);
+      if IsGapBottomStored then
+        FGapBottom := Round(FGapBottom * AYProportion);
+      if IsGapTopStored then
+        FGapTop := Round(FGapTop * AYProportion);
+      if IsMarkerDistStored then
+        FMarkerDist := Round(FMarkerDist * AXProportion);
+      if IsMarkerSizeStored then
+        FMarkerSize := Round(FMarkerSize * AXProportion);
+    finally
+      EnableAutoSizing;
+    end;
+  end;
+end;
+
+function TindGnouMeter.IsBarThicknessStored: Boolean;
+begin
+  Result := FBarThickness <> Scale96ToFont(DEFAULT_BAR_THICKNESS);
+end;
+
+function TindGnouMeter.IsGapBottomStored: Boolean;
+begin
+  Result := FGapBottom <> Scale96ToFont(DEFAULT_GAP_BOTTOM);
+end;
+
+function TindGnouMeter.IsGapTopStored: Boolean;
+begin
+  Result := FGapTop <> Scale96ToFont(DEFAULT_GAP_TOP);
+end;
+
+function TindGnouMeter.IsMarkerDistStored: Boolean;
+begin
+  Result := FMarkerDist <> Scale96ToFont(DEFAULT_MARKER_DIST);
+end;
+
+function TindGnouMeter.IsMarkerSizeStored: Boolean;
+begin
+  Result := FMarkerSize <> Scale96ToFont(DEFAULT_MARKER_SIZE);
+end;
+
 procedure TindGnouMeter.SetValue(val: Double);
 begin
   if (val <> fValue) and (val >= fValueMin) and (val <= fValueMax) then
@@ -272,6 +349,24 @@ begin
   end;
 end;
 
+procedure TindGnouMeter.SetMarkerDist(val: Integer);
+begin
+  if (val <> fMarkerDist) then
+  begin
+    fMarkerDist := val;
+    Invalidate;
+  end;
+end;
+
+procedure TindGnouMeter.SetMarkerSize(val: Integer);
+begin
+  if (val <> fMarkerSize) then
+  begin
+    fMarkerSize := val;
+    Invalidate;
+  end;
+end;
+
 procedure TindGnouMeter.SetShowMarker(val: Boolean);
 begin
   if (val <> fShowMarker) then
@@ -307,26 +402,36 @@ begin
 end;
 
 procedure TindGnouMeter.DrawMarker;
+var
+  v: Integer;
+  dx, dy: Integer;
 begin
   if fShowMarker then
   begin
+    v := ValueToPixels(fValue);
     with Canvas do
     begin
-      pen.color := clWhite;
+      dx := FMarkerSize;
-      Brush.Style := bsClear;
+      dy := round(FMarkerSize * sin(pi/6));
-      MoveTo(LeftMeter - 2, ValueToPixels(fValue));
-      LineTo(LeftMeter - 6, ValueToPixels(fValue) - 4);
-      LineTo(LeftMeter - 6, ValueToPixels(fValue) + 4);
-      pen.color := clGray;
-      LineTo(LeftMeter - 2, ValueToPixels(fValue));
 
-      pen.color := fMarkerColor;
+      // 3D edges
-      Brush.color := fMarkerColor;
+      Pen.Color := clWhite;
+      Brush.Style := bsClear;
+      MoveTo(LeftMeter - FMarkerDist + 1, v);
+      LineTo(LeftMeter - FMarkerDist - dx - 1, v - dy - 1);
+      LineTo(LeftMeter - FMarkerDist - dx - 1, v + dy + 1);
+      Pen.Color := clGray;
+      LineTo(LeftMeter - FMarkerDist + 1, v);
+
+      // Triangle
+      Pen.Color := fMarkerColor;
+      Brush.Color := fMarkerColor;
       Brush.Style := bsSolid;
-      Polygon([Point(LeftMeter - 3, ValueToPixels(fValue)),
+      Polygon([
-        Point(LeftMeter - 5, ValueToPixels(fValue) - 2),
+        Point(LeftMeter - FMarkerDist, v),
-        Point(LeftMeter - 5, ValueToPixels(fValue) + 2),
+        Point(LeftMeter - FMarkerDist - dx, v - dy),
-        Point(LeftMeter - 3, ValueToPixels(fValue))]);
+        Point(LeftMeter - FMarkerDist - dx, v + dy)
+      ]);
     end;
   end;
 end;
@@ -387,34 +492,34 @@ procedure TindGnouMeter.DrawMeterBar;
 begin
   with Canvas do
   begin
-    pen.Color := fColorBack;
+    Pen.Color := fColorBack;
     Brush.Color := fColorBack;
     Brush.Style := bsSolid;
     Rectangle(LeftMeter, ValueToPixels(fValueMax), LeftMeter +
       fBarThickness, ValueToPixels(fValueMin));
 
-    pen.Color := fColorFore;
+    Pen.Color := fColorFore;
     Brush.Color := fColorFore;
     Brush.Style := bsSolid;
     Rectangle(LeftMeter + 1, ValueToPixels(fValue), LeftMeter +
       fBarThickness, ValueToPixels(fValueMin));
 
-    pen.color := clWhite;
+    Pen.color := clWhite;
     Brush.Style := bsClear;
     MoveTo(LeftMeter + fBarThickness - 1, ValueToPixels(fValueMax));
     LineTo(LeftMeter, ValueToPixels(fValueMax));
     LineTo(LeftMeter, ValueToPixels(fValueMin) - 1);
 
-    pen.color := clGray;
+    Pen.color := clGray;
     LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMin) - 1);
     LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMax));
 
     if (fValue > fValueMin) and (fValue < fValueMax) then
     begin
-      pen.color := clWhite;
+      Pen.color := clWhite;
       MoveTo(LeftMeter + 1, ValueToPixels(fValue));
       LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue));
-      pen.color := clGray;
+      Pen.color := clGray;
       MoveTo(LeftMeter + 1, ValueToPixels(fValue) - 1);
       LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue) - 1);
     end;

components/industrialstuff/source/lednumber.pas

@@ -57,14 +57,14 @@ type
     FSize      : TSegmentSize;
     lbDrawBmp  : TBitmap;
     procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
-    procedure Initialize(var Points: array of TPoint);
+    procedure Initialize(out Points: array of TPoint);
     function  NewOffset(xOry: char; OldOffset: Integer): Integer;
     procedure ProcessCaption(Points: array of TPoint);
     procedure PaintSegment(Segment: Integer; TheColor: TColor;
                            Points: array of TPoint; OffsetX, OffsetY: Integer);
     procedure ResizeControl(Row, Col, Size: Integer);
     function  GetAbout: string;
-    procedure SetAbout(const Value: string);
+    procedure SetAbout(const {%H-}Value: string);
     procedure SetSize(Value: TSegmentSize);
     procedure SetOnColor(Value: TColor);
     procedure SetOffColor(Value: TColor);
@@ -306,7 +306,7 @@ begin
 end;
 {=====}
 
-procedure TCustomLEDNumber.Initialize(var Points: array of TPoint);
+procedure TCustomLEDNumber.Initialize(out Points: array of TPoint);
 var
   I     : Integer;
 begin