From e4985bdc49a72a79b54f139f17c96735625f6f72 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 22 Apr 2019 11:26:52 +0000 Subject: [PATCH] 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 | 2 +- .../industrialstuff/source/indcyBaseLed.pas | 7 +- .../industrialstuff/source/indcyGraphics.pas | 4 +- .../industrialstuff/source/indgnoumeter.pas | 161 +++++++++++++++--- .../industrialstuff/source/lednumber.pas | 6 +- 5 files changed, 143 insertions(+), 37 deletions(-) diff --git a/components/industrialstuff/source/AdvLed.pas b/components/industrialstuff/source/AdvLed.pas index da4b00194..dc20f043f 100644 --- a/components/industrialstuff/source/AdvLed.pas +++ b/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; diff --git a/components/industrialstuff/source/indcyBaseLed.pas b/components/industrialstuff/source/indcyBaseLed.pas index 94815f0b9..cd603477f 100644 --- a/components/industrialstuff/source/indcyBaseLed.pas +++ b/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 diff --git a/components/industrialstuff/source/indcyGraphics.pas b/components/industrialstuff/source/indcyGraphics.pas index de0678ac8..d5aadb04e 100644 --- a/components/industrialstuff/source/indcyGraphics.pas +++ b/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, - ExtCtrls, SysUtils, indcyTypes; + LCLIntf, LCLType, Types, Classes, Forms, Graphics, Buttons, Controls, + ExtCtrls, SysUtils; // Objects painting functions : procedure cyFrame3D(Canvas: TCanvas; var Rect: TRect; TopLeftColor, BottomRightColor: TColor; Width: Integer; diff --git a/components/industrialstuff/source/indgnoumeter.pas b/components/industrialstuff/source/indgnoumeter.pas index bfa38e816..1395114c7 100644 --- a/components/industrialstuff/source/indgnoumeter.pas +++ b/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 GapBottom: Word read fGapBottom write SetGapBottom; - property BarThickness: Word read fBarThickness write SetBarThickness; + property GapTop: Word + read fGapTop write SetGapTop stored IsGapTopStored; + 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; - fGapBottom := 10; - fBarThickness := 5; + fGapTop := Scale96ToFont(DEFAULT_GAP_TOP); + fGapBottom := Scale96ToFont(DEFAULT_GAP_BOTTOM); + 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; - Brush.Style := bsClear; - 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)); + dx := FMarkerSize; + dy := round(FMarkerSize * sin(pi/6)); - pen.color := fMarkerColor; - Brush.color := fMarkerColor; + // 3D edges + 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)), - Point(LeftMeter - 5, ValueToPixels(fValue) - 2), - Point(LeftMeter - 5, ValueToPixels(fValue) + 2), - Point(LeftMeter - 3, ValueToPixels(fValue))]); + Polygon([ + Point(LeftMeter - FMarkerDist, v), + Point(LeftMeter - FMarkerDist - dx, v - dy), + 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; diff --git a/components/industrialstuff/source/lednumber.pas b/components/industrialstuff/source/lednumber.pas index ef748e418..4904a4f20 100644 --- a/components/industrialstuff/source/lednumber.pas +++ b/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