diff --git a/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi b/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi index c7a55417c..339ebf931 100644 --- a/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi +++ b/components/industrialstuff/Example/A3nalogGaugeSample/demo.lpi @@ -24,7 +24,6 @@ - diff --git a/components/industrialstuff/Example/A3nalogGaugeSample/main.lfm b/components/industrialstuff/Example/A3nalogGaugeSample/main.lfm index a552e9152..41d367255 100644 --- a/components/industrialstuff/Example/A3nalogGaugeSample/main.lfm +++ b/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 diff --git a/components/industrialstuff/Example/A3nalogGaugeSample/main.pas b/components/industrialstuff/Example/A3nalogGaugeSample/main.pas index 4f2ca9ebf..3db2ea779 100644 --- a/components/industrialstuff/Example/A3nalogGaugeSample/main.pas +++ b/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, - Y: Integer); + procedure AboutLabelMouseMove(Sender: TObject; Shift: TShiftState; X,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 - V := AnalogGauge1.Scale; + if V > AnalogGauge1.ScaleMax then begin + 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; - AnalogGauge2.Scale := ScaleMaxEdit.Value; - AnalogGauge3.Scale := ScaleMaxEdit.Value; + AnalogGauge1.ScaleMax := ScaleMaxEdit.Value; + AnalogGauge2.ScaleMax := ScaleMaxEdit.Value; + AnalogGauge3.ScaleMax := ScaleMaxEdit.Value; end; end; diff --git a/components/industrialstuff/source/a3naloggauge.pas b/components/industrialstuff/source/a3naloggauge.pas index f41e5e60a..9d803e105 100644 --- a/components/industrialstuff/source/a3naloggauge.pas +++ b/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); - FCenterRadius := Scale96ToFont(DEFAULT_CENTER_RADIUS); + FCircleRadius := DEFAULT_CIRCLE_RADIUS; + FCenterRadius := DEFAULT_CENTER_RADIUS; + FTextDist := DEFAULT_TEXT_DIST; FNumMainTicks := 5; - FLengthMainTicks := Scale96ToFont(DEFAULT_LENGTH_MAINTICKS); - FLengthSubTicks := Scale96ToFont(DEFAULT_LENGTH_SUBTICKS); + FLengthMainTicks := DEFAULT_LENGTH_MAINTICKS; + 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; - 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; + FCenterRadius := Round(FCenterRadius * AXProportion); + FCircleRadius := Round(FCircleRadius * AXProportion); + FLengthMainTicks := Round(FLengthMainTicks * AXProportion); + FLengthSubTicks := Round(FLengthSubTicks * AXProportion); + FMargin := Round(FMargin * AXProportion); + FTextDist := Round(FTextDist * AXProportion); 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(Y-(J-(FLengthMainTicks+txtDist)*K)*sinA) - hTxt div 2, + Round(C-(J-(FLengthMainTicks+FTextDist)*K-I)*cosA) - wTxt 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