From 91dc676e627265726fd31d6f5f59ce68bb8fea8e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 11 Sep 2022 22:34:04 +0000 Subject: [PATCH] tvplanit: Fix LCLScaling in TVpLEDLabel and TVpClock. Some refactoring. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8474 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/gadgets/project1.lpi | 1 + .../tvplanit/examples/gadgets/project1.lpr | 1 + .../tvplanit/examples/gadgets/unit1.lfm | 20 +- .../tvplanit/examples/gadgets/unit1.pas | 27 ++- components/tvplanit/source/vpclock.pas | 219 ++++++++++-------- components/tvplanit/source/vpledlabel.pas | 185 +++++++++------ 6 files changed, 258 insertions(+), 195 deletions(-) diff --git a/components/tvplanit/examples/gadgets/project1.lpi b/components/tvplanit/examples/gadgets/project1.lpi index 559083187..45f7fde79 100644 --- a/components/tvplanit/examples/gadgets/project1.lpi +++ b/components/tvplanit/examples/gadgets/project1.lpi @@ -9,6 +9,7 @@ + <Scaled Value="True"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> </General> diff --git a/components/tvplanit/examples/gadgets/project1.lpr b/components/tvplanit/examples/gadgets/project1.lpr index b78ee9b89..f9a3b8347 100644 --- a/components/tvplanit/examples/gadgets/project1.lpr +++ b/components/tvplanit/examples/gadgets/project1.lpr @@ -14,6 +14,7 @@ uses begin RequireDerivedFormResource := True; + Application.Scaled:=True; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; diff --git a/components/tvplanit/examples/gadgets/unit1.lfm b/components/tvplanit/examples/gadgets/unit1.lfm index 3c902c613..af263b424 100644 --- a/components/tvplanit/examples/gadgets/unit1.lfm +++ b/components/tvplanit/examples/gadgets/unit1.lfm @@ -1,13 +1,14 @@ object Form1: TForm1 - Left = 320 + Left = 142 Height = 292 - Top = 160 - Width = 457 + Top = 71 + Width = 459 Caption = 'TvPlanit Gadgets demo' ClientHeight = 292 - ClientWidth = 457 + ClientWidth = 459 Font.Color = clWindowText OnShow = FormShow + LCLVersion = '2.3.0.0' object VpClock: TVpClock AnchorSideLeft.Control = Owner AnchorSideTop.Control = Panel1 @@ -51,14 +52,13 @@ object Form1: TForm1 object BtnStartStop: TButton AnchorSideLeft.Control = RgClockMode AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RgClockMode AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = RgClockMode AnchorSideBottom.Side = asrBottom Left = 342 Height = 25 - Top = 190 + Top = 168 Width = 80 - Anchors = [akLeft] AutoSize = True BorderSpacing.Left = 16 Caption = 'Start' @@ -118,7 +118,7 @@ object Form1: TForm1 AnchorSideBottom.Control = BtnStartStop Left = 342 Height = 19 - Top = 159 + Top = 137 Width = 98 Anchors = [akLeft, akBottom] BorderSpacing.Top = 4 @@ -180,7 +180,7 @@ object Form1: TForm1 AnchorSideBottom.Control = BtnStartStop Left = 342 Height = 19 - Top = 159 + Top = 137 Width = 85 Anchors = [akLeft, akBottom] BorderSpacing.Top = 12 @@ -238,7 +238,7 @@ object Form1: TForm1 AnchorSideRight.Side = asrBottom Left = 342 Height = 25 - Top = 217 + Top = 195 Width = 80 AutoSize = True BorderSpacing.Top = 2 diff --git a/components/tvplanit/examples/gadgets/unit1.pas b/components/tvplanit/examples/gadgets/unit1.pas index 8c96d8742..387f9536c 100644 --- a/components/tvplanit/examples/gadgets/unit1.pas +++ b/components/tvplanit/examples/gadgets/unit1.pas @@ -110,18 +110,18 @@ procedure TForm1.CbNewClockFaceChange(Sender: TObject); begin if CbNewClockFace.Checked then begin VpClock.AnalogOptions.ClockFace.LoadFromFile('clockface.bmp'); - VpClock.AnalogOptions.HourHandWidth := 2; - VpClock.AnalogOptions.MinuteHandWidth := 2; - VpClock.AnalogOptions.SecondHandWidth := 1; - VpClock.Width := 100; - VpClock.Height := 100; + VpClock.AnalogOptions.HourHandWidth := Scale96ToFont(2); + VpClock.AnalogOptions.MinuteHandWidth := Scale96ToFont(2); + VpClock.AnalogOptions.SecondHandWidth := Scale96ToFont(1); + VpClock.Width := Scale96ToFont(100); + VpClock.Height := Scale96ToFont(100); end else begin VpClock.AnalogOptions.ClockFace := nil; - VpClock.AnalogOptions.HourHandWidth := 4; - VpClock.AnalogOptions.MinuteHandWidth := 3; - VpClock.AnalogOptions.SecondHandWidth := 1; - VpClock.Width := 200; - VpClock.Height := 200; + VpClock.AnalogOptions.HourHandWidth := Scale96ToFont(4); + VpClock.AnalogOptions.MinuteHandWidth := Scale96ToFont(3); + VpClock.AnalogOptions.SecondHandWidth := Scale96ToFont(1); + VpClock.Width := Scale96ToFont(200); + VpClock.Height := Scale96ToFont(200); end; VpClock.AnalogOptions.DrawMarks := not CbNewClockFace.Checked; if RgDisplayMode.ItemIndex = ord(dmAnalog) then @@ -190,10 +190,9 @@ begin dmAnalog: CbNewClockFaceChange(nil); dmDigital: - begin - VpClock.Width := 136; - VpClock.Height := 30; - end; + ; + // The clock is not freely sizeable in digital display mode +// VpClock.SetBounds(VpClock.Left, VpClock.Left, Scale96ToForm(136), Scale96ToForm(30)); end; CbMilitaryTime.Visible := VpClock.DisplayMode = dmDigital; CbNewClockface.Visible := VpClock.DisplayMode = dmAnalog; diff --git a/components/tvplanit/source/vpclock.pas b/components/tvplanit/source/vpclock.pas index 75f0b0d2d..d9e276ec6 100644 --- a/components/tvplanit/source/vpclock.pas +++ b/components/tvplanit/source/vpclock.pas @@ -40,7 +40,7 @@ uses Windows, Messages, VpTimerPool, {$ENDIF} SysUtils, Graphics, Types, Classes, Controls, Dialogs, Forms, Menus, Math, - VpBase, VpLEDLabel; + VpBase, VpConst, VpLEDLabel; type TVpPercent = 0..100; @@ -50,25 +50,26 @@ type TVpLEDClockDisplay = class(TVpCustomLEDLabel) public procedure PaintSelf; + property ScaleFactor; end; TVpDigitalOptions = class(TPersistent) - protected{private} - FOwner : TComponent; - FOnColor : TColor; - FOffColor : TColor; - FBgColor : TColor; - FSize : TSegmentSize; - FShowSeconds : Boolean; - FFlashColon : Boolean; - FOnChange : TNotifyEvent; - F24Hour : Boolean; + private + FBgColor: TColor; + FOnColor: TColor; + FOffColor: TColor; + FSize: TSegmentSize; + FShowSeconds: Boolean; +// FFlashColon: Boolean; + F24Hour: Boolean; + FOnChange: TNotifyEvent; procedure Set24Hour(Value: Boolean); procedure SetOnColor(Value: TColor); procedure SetOffColor(Value: TColor); procedure SetBgColor(Value: TColor); procedure SetSize(Value: TSegmentSize); procedure SetShowSeconds(Value: Boolean); + protected procedure DoOnChange; public constructor Create; @@ -114,7 +115,7 @@ type procedure SetSecondHandWidth(Value : Integer); procedure SetShowSecondHand(Value : Boolean); procedure SetSolidHands(Value : Boolean); - {internal methods} + { Internal methods } procedure DoOnChange; public constructor Create; @@ -179,6 +180,7 @@ type FMinuteOffset: Integer; {Minutes} FSecondOffset: Integer; {Seconds} FTimeResolution: Integer; {interval of the internal timer, in ms } + FScaleFactor: Double; {event variables} FOnHourChange: TNotifyEvent; FOnMinuteChange: TNotifyEvent; @@ -211,10 +213,12 @@ type procedure SetHold(Value: Boolean); procedure SetHourOffset(Value: Integer); procedure SetSecondOffset(Value: Integer); - {internal methods} + + { Internal methods } function ckConvertMsToDateTime(Value: LongInt): TDateTime; procedure ckHandOptionChange(Sender: TObject); procedure ckDigitalOptionChange(Sender: TObject); + procedure SetDigitalTimeStr(ATime: TDateTime); procedure SizeDigitalDisplay; {$IFDEF DELPHI} procedure ckTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; @@ -228,7 +232,8 @@ type procedure DoOnCountdownDone; procedure PaintHands(ACanvas: TCanvas); class function GetControlClassDefaultSize: TSize; override; - {windows message methods} + + { Messaging } {$IFDEF LCL} procedure WMResize(var Msg: TLMSize); message LM_SIZE; procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND; @@ -237,6 +242,13 @@ type procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; {$ENDIF} + + { LCL scaling } + {$IF VP_LCL_SCALING <> 0} + procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; + const AXProportion, AYProportion: Double); override; + {$IFEND} + protected procedure Loaded; override; procedure Paint; override; @@ -270,7 +282,12 @@ type procedure Stop; procedure Pause; procedure Resume; - + + {$IF VP_LCL_SCALING <> 0} + procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; + const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); override; + {$IFEND} + property DisplayMode: TVpClockDisplayMode read FDisplayMode write SetDisplayMode; property ElapsedDays: Integer read GetElapsedDays; property ElapsedHours: Integer read GetElapsedHours; @@ -324,7 +341,7 @@ type implementation uses - VpConst, VpMisc; + VpMisc; const ckDToR = (Pi / 180); @@ -340,21 +357,19 @@ end; constructor TVpDigitalOptions.Create; begin inherited Create; - FSize := 2; - FOnColor := clLime; - FOffColor := $000E3432; - FBgColor := clBlack; - FShowSeconds := True; - MilitaryTime := True; + FSize := 2; + FOnColor := clLime; + FOffColor := $000E3432; + FBgColor := clBlack; + FShowSeconds := True; + MilitaryTime := True; end; -{=====} procedure TVpDigitalOptions.DoOnChange; begin if Assigned(FOnChange) then FOnChange(Self); end; -{=====} procedure TVpDigitalOptions.Set24Hour(Value: Boolean); begin @@ -363,7 +378,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpDigitalOptions.SetOnColor(Value: TColor); begin @@ -372,7 +386,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpDigitalOptions.SetOffColor(Value: TColor); begin @@ -381,7 +394,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpDigitalOptions.SetBgColor(Value: TColor); begin @@ -390,7 +402,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpDigitalOptions.SetSize(Value: TSegmentSize); begin @@ -399,7 +410,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpDigitalOptions.SetShowSeconds(Value: Boolean); begin @@ -408,7 +418,6 @@ begin DoOnChange; end; end; -{=====} {===== TVpHandOptions ===============================================} @@ -419,7 +428,6 @@ begin FClockFace := TBitMap.Create; FDrawMarks := True; end; -{=====} destructor TVpHandOptions.Destroy; begin @@ -427,7 +435,6 @@ begin FClockFace := nil; inherited; end; -{=====} procedure TVpHandOptions.Assign(Source: TPersistent); begin @@ -447,7 +454,6 @@ begin end else inherited Assign(Source); end; -{=====} procedure TVpHandOptions.SetClockFace(Value: TBitMap); begin @@ -459,7 +465,6 @@ begin end; FOnChange(self); end; -{=====} procedure TVpHandOptions.SetDrawMarks(Value: Boolean); begin @@ -468,14 +473,12 @@ begin FOnChange(Self); end; end; -{=====} procedure TVpHandOptions.DoOnChange; begin if Assigned(FOnChange) then FOnChange(Self); end; -{=====} procedure TVpHandOptions.SetHourHandColor(Value: TColor); begin @@ -484,7 +487,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetHourHandLength(Value: TVpPercent); begin @@ -493,7 +495,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetHourHandWidth(Value: Integer); begin @@ -502,7 +503,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetMinuteHandColor(Value: TColor); begin @@ -511,7 +511,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetMinuteHandLength(Value: TVpPercent); begin @@ -520,7 +519,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetMinuteHandWidth(Value: Integer); begin @@ -538,7 +536,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetSecondHandLength(Value: TVpPercent); begin @@ -547,7 +544,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetSecondHandWidth(Value: Integer); begin @@ -556,7 +552,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetShowSecondHand(Value: Boolean); begin @@ -565,7 +560,6 @@ begin DoOnChange; end; end; -{=====} procedure TVpHandOptions.SetSolidHands(Value: Boolean); begin @@ -575,7 +569,8 @@ begin end; end; -{===== TOvcCustomClock ===============================================} + +{===== TVpCustomClock ===============================================} constructor TVpCustomClock.Create(AOwner: TComponent); begin @@ -603,6 +598,7 @@ begin FDigitalOptions := TVpDigitalOptions.Create; FDigitalOptions.FOnChange := ckDigitalOptionChange; + FScaleFactor := 1.0; ckDraw := TBitMap.Create; ckDraw.Width := Width; @@ -618,7 +614,6 @@ begin FTimer.Enabled := false; {$ENDIF} end; -{=====} destructor TVpCustomClock.Destroy; begin @@ -634,7 +629,19 @@ begin inherited Destroy; end; -{=====} + +{$IF VP_LCL_SCALING <> 0} +procedure TVpCustomClock.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; + const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); +begin + inherited; + if ckLEDDisplay <> nil then + with ckLEDDisplay do + begin + AutoAdjustLayout(AMode, AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth); + end; +end; +{$IFEND} function TVpCustomClock.ckConvertMsToDateTime(Value: LongInt) : TDateTime; var @@ -650,16 +657,17 @@ begin Second := S mod SecondsInMinute; Result := EncodeTime(Hour, Minute, Second, 0) + Days; end; -{=====} procedure TVpCustomClock.ckHandOptionChange(Sender: TObject); begin if FDisplayMode = dmAnalog then Invalidate; end; -{=====} procedure TVpCustomClock.ckDigitalOptionChange(Sender: TObject); +const + SHOWSECONDS_COLS: array[boolean] of Integer = (8, 11); // ShowSeconds + MILITARY_COLS: array[boolean] of integer = (0, -3); // Military time begin if FDisplayMode = dmDigital then begin ckLEDDisplay.Size := FDigitalOptions.Size; @@ -667,26 +675,17 @@ begin ckLEDDisplay.OnColor := FDigitalOptions.OnColor ; ckLEDDisplay.OffColor := FDigitalOptions.OffColor; FMilitaryTime := FDigitalOptions.MilitaryTime; - if FDigitalOptions.ShowSeconds and FMilitaryTime then - ckLEDDisplay.Columns := 8 - else if FDigitalOptions.ShowSeconds and not FMilitaryTime then - ckLEDDisplay.Columns := 11 - else if not FDigitalOptions.ShowSeconds and FMilitaryTime then - ckLEDDisplay.Columns := 5 - else if not FDigitalOptions.ShowSeconds and not FMilitaryTime then - ckLEDDisplay.Columns := 8; + ckLEDDisplay.Columns := SHOWSECONDS_COLS[FDigitalOptions.ShowSeconds] + MILITARY_COLS[FMilitaryTime]; SizeDigitalDisplay; - Invalidate; +// Invalidate; end; end; -{=====} procedure TVpCustomClock.SizeDigitalDisplay; begin Width := ckLEDDisplay.Width; Height := ckLEDDisplay.Height; end; -{=====} {$IFDEF DELPHI} procedure TVpCustomClock.ckTimerEvent(Sender: TObject; Handle: Integer; @@ -761,7 +760,27 @@ begin end; end; {$ENDIF} -{=====} + +{$IF VP_LCL_SCALING <> 0} +procedure TVpCustomClock.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; + const AXProportion, AYProportion: Double); +begin + inherited; + if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then + begin + AnalogOptions.HourHandLength := round(AnalogOptions.HourHandLength * AXProportion); + AnalogOptions.HourHandWidth := round(AnalogOptions.HourHandWidth * AXProportion); + + AnalogOptions.MinuteHandLength := round(AnalogOptions.MinuteHandLength * AXProportion); + AnalogOptions.MinuteHandWidth := round(AnalogOptions.MinuteHandWidth * AXProportion); + + AnalogOptions.SecondHandLength := round(AnalogOptions.SecondHandLength * AXProportion); + AnalogOptions.SecondHandWidth := round(AnalogOptions.SecondHandWidth * AXProportion); + + FScaleFactor := AXProportion; + end; +end; +{$IFEND} procedure TVpCustomClock.DoOnHourChange; begin @@ -1229,7 +1248,6 @@ begin X := Round(HandBase * 0.04) + 1; ACanvas.Ellipse(HalfWidth-X, HalfHeight-X, HalfWidth+X, HalfHeight+X); end; -{=====} procedure TVpCustomClock.SetActive(Value: Boolean); begin @@ -1278,20 +1296,16 @@ begin Invalidate; end; end; -{=====} procedure TVpCustomClock.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); begin inherited SetBounds(ALeft, ATop, AWidth, AHeight); - if Assigned(ckDraw) then begin ckDraw.Width := AWidth; ckDraw.Height := AHeight; end; - Invalidate; end; -{=====} procedure TVpCustomClock.SetClockMode(Value: TVpClockMode); begin @@ -1310,14 +1324,32 @@ begin Invalidate; end; end; -{=====} + +procedure TVpCustomClock.SetDigitalTimeStr(ATime: TDateTime); +var + timeStr: String; +begin + if FDigitalOptions.ShowSeconds and FMilitaryTime then + timeStr := FormatDateTime('hh:nn:ss', ATime) + else + if FDigitalOptions.ShowSeconds and not FMilitaryTime then + timeStr := FormatDateTime('hh:nn:ss am/pm', ATime) + else + if not FDigitalOptions.ShowSeconds and FMilitaryTime then + timeStr := FormatDateTime('hh:nn', ATime) + else + if not FDigitalOptions.ShowSeconds and not FMilitaryTime then + timeStr := FormatDateTime('hh:nn am/pm', ATime); + + ckLEDDisplay.Caption := timeStr; +end; procedure TVpCustomClock.SetDisplayMode(Value: TVpClockDisplayMode); begin if Value <> FDisplayMode then begin FDisplayMode := Value; - case FDisplayMode of + case FDisplayMode of dmDigital: begin {Save the analog height and width} ckAnalogHeight := Height; @@ -1325,25 +1357,40 @@ begin {Create and initialize the LED display} ckLEDDisplay := TVpLEDClockDisplay.Create(self); + ckLEDDisplay.ScaleFactor := FScaleFactor; ckLEDDisplay.Parent := self; ckLEDDisplay.OnColor := FDigitalOptions.OnColor; ckLEDDisplay.OffColor := FDigitalOptions.OffColor; ckLEDDisplay.BgColor := FDigitalOptions.BgColor; ckLEDDisplay.Size := FDigitalOptions.Size; if FDigitalOptions.ShowSeconds then begin - ckLEDDisplay.Columns := 8; - ckLEDDisplay.Caption := '00:00:00'; + if FMilitaryTime then + begin + ckLEDDisplay.Columns := 11; + ckLEDDisplay.Caption := '00:00:00 AM'; + end else + begin + ckLEDDisplay.Columns := 8; + ckLEDDisplay.Caption := '00:00:00'; + end; end else begin - ckLEDDisplay.Columns := 5; - ckLEDDisplay.Caption := '00:00'; + if FMilitaryTime then + begin + ckLEDDisplay.Columns := 8; + ckLEDDisplay.Caption := '00:00 AM'; + end else + begin + ckLEDDisplay.Columns := 5; + ckLEDDisplay.Caption := '00:00'; + end; end; {Set the height and width of the control} SizeDigitalDisplay; {Blank the control} - Canvas.Brush.Color := FDigitalOptions.BgColor; - Canvas.FillRect(GetClientRect); + //Canvas.Brush.Color := FDigitalOptions.BgColor; + //Canvas.FillRect(GetClientRect); {Initialize the LED display} if FActive then begin @@ -1437,24 +1484,11 @@ begin DoOnSecondChange; ckOldSecond := Second1; - if DisplayMode = dmDigital then begin - if FDigitalOptions.ShowSeconds and FMilitaryTime then - TimeStr := FormatDateTime('hh:nn:ss', FTime) - else - if FDigitalOptions.ShowSeconds and not FMilitaryTime then - TimeStr := FormatDateTime('hh:nn:ss am/pm', FTime) - else - if not FDigitalOptions.ShowSeconds and FMilitaryTime then - TimeStr := FormatDateTime('hh:nn', FTime) - else - if not FDigitalOptions.ShowSeconds and not FMilitaryTime then - TimeStr := FormatDateTime('hh:nn am/pm', FTime); - ckLEDDisplay.Caption := TimeStr; - end; + if DisplayMode = dmDigital then + SetDigitalTimeStr(FTime); Invalidate; end; -{=====} procedure TVpCustomClock.SetMinuteOffset(Value: Integer); begin @@ -1465,7 +1499,6 @@ begin Invalidate; end; end; -{=====} procedure TVpCustomClock.SetHold(Value: Boolean); begin @@ -1495,7 +1528,6 @@ begin Invalidate; end; end; -{=====} procedure TVpCustomClock.SetSecondOffset(Value: Integer); begin @@ -1506,7 +1538,6 @@ begin Invalidate; end; end; -{=====} procedure TVpCustomClock.Start; begin @@ -1551,7 +1582,6 @@ procedure TVpCustomClock.WMEraseBkgnd(var Msg: TLMEraseBkGnd); begin Msg.Result := 1; end; -{=====} {$IFNDEF LCL} procedure TVpCustomClock.WMGetDlgCode(var Msg: TWMGetDlgCode); @@ -1560,6 +1590,5 @@ begin Msg.Result := DLGC_STATIC; end; {$ENDIF} -{=====} end. diff --git a/components/tvplanit/source/vpledlabel.pas b/components/tvplanit/source/vpledlabel.pas index 287c475e8..d00da76df 100644 --- a/components/tvplanit/source/vpledlabel.pas +++ b/components/tvplanit/source/vpledlabel.pas @@ -39,20 +39,29 @@ uses {$ELSE} Windows, Messages, {$ENDIF} - Classes, Controls, Graphics, Types, SysUtils; + Classes, Controls, Graphics, Types, SysUtils, + VPConst; type TSegmentSize = 2..10; TVpCustomLEDLabel = class(TGraphicControl) - protected{private} - FBgColor : TColor; - FOffColor : TColor; - FOnColor : TColor; - FColumns : Integer; - FRows : Integer; - FSize : TSegmentSize; - lbDrawBmp : TBitmap; + private + FBgColor: TColor; + FColumns: Integer; + FOffColor: TColor; + FOnColor: TColor; + FRows: Integer; + FSize: TSegmentSize; + FDrawBmp: TBitmap; + function GetAbout: string; + procedure SetAbout(const Value: string); + procedure SetBgColor(Value: TColor); + procedure SetColumns(Value: Integer); + procedure SetOffColor(Value: TColor); + procedure SetOnColor(Value: TColor); + procedure SetRows(Value: Integer); + protected procedure CMTextChanged(var Message: {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF}); message CM_TEXTCHANGED; procedure Initialize(out Points: array of TPoint); function NewOffset(xOry: char; OldOffset: Integer): Integer; @@ -60,19 +69,18 @@ type procedure PaintSegment(Segment: Integer; Color: TColor; Points: array of TPoint; OffsetX, OffsetY: Integer); procedure ResizeControl(Row, Col, Size: Integer); - function GetAbout: string; - procedure SetAbout(const Value: string); procedure SetSize(Value: TSegmentSize); - procedure SetOnColor(Value: TColor); - procedure SetOffColor(Value: TColor); - procedure SetRows(Value: Integer); - procedure SetColumns(Value: Integer); - procedure SetbgColor(Value: TColor); procedure SelectSegments(Segment: Word; Points: array of TPoint; OffsetX, OffsetY: Integer); protected + FScaleFactor: Double; + {$IF VP_LCL_SCALING <> 0} + procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; + const AXProportion, AYProportion: Double); override; + {$IFEND} class function GetControlClassDefaultSize: TSize; override; procedure Paint; override; + property ScaleFactor: double read FScaleFactor write FScaleFactor; public constructor Create(AOwner:TComponent);override; destructor Destroy; override; @@ -138,7 +146,7 @@ type implementation uses - VpConst, VpMisc; + VpMisc; { LED Segment Map } { } @@ -256,23 +264,38 @@ begin csSetCaption, csClickEvents, csDoubleClicks]; - lbDrawBmp := TBitmap.Create; + FDrawBmp := TBitmap.Create; FOnColor := clLime; FOffColor := $000E3432; FBgColor := clBlack; FSize := 2; FRows := 1; FColumns := 10; + FScaleFactor := 1.0; + Caption := 'LED-LABEL'; end; destructor TVpCustomLEDLabel.Destroy; begin - lbDrawBmp.Free; - lbDrawBmp := nil; + FreeAndNil(FDrawBmp); inherited Destroy; end; +{ LCL scaling. This method is called whenever the screen pixel density changes. + We memorize the scaling factor which is multiplied to the segment coordinates. } +{$IF VP_LCL_SCALING <> 0} +procedure TVpCustomLEDLabel.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; + const AXProportion, AYProportion: Double); +begin + inherited; + if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then + begin + FScaleFactor := AXProportion; + end; +end; +{$IFEND} + function TVpCustomLEDLabel.GetAbout : string; begin Result := VpVersionStr; @@ -293,52 +316,53 @@ end; procedure TVpCustomLEDLabel.Initialize(out Points: array of TPoint); var I: Integer; + f: Double; begin + f := FScaleFactor * (FSize - 1); for I := 0 to MAX_POINTS do begin - Points[i].X := DigitPoints[i].X * (FSize - 1); - Points[i].Y := DigitPoints[i].Y * (FSize - 1); + Points[i].X := round(DigitPoints[i].X * f); + Points[i].Y := round(DigitPoints[i].Y * f); end; end; function TVpCustomLEDLabel.NewOffset(xOry:char;oldOffset:integer):integer; begin if (xOry = 'x')then - newOffset := oldOffset + 17 * (FSize - 1) + newOffset := oldOffset + round(17 * (FSize - 1) * FScaleFactor) else - newOffset := oldOffset + 30 * (FSize -1) + newOffset := oldOffset + round(30 * (FSize - 1) * FScaleFactor); end; procedure TVpCustomLEDLabel.Paint; var Points: array[0..MAX_POINTS] of TPoint; begin - lbDrawBMP.Width := Width; - lbDrawBMP.Height := Height; + FDrawBMP.Width := Width; + FDrawBMP.Height := Height; Initialize(Points); - lbDrawBMP.Canvas.Brush.Color := FBgColor; - lbDrawBMP.Canvas.FillRect(ClientRect); + FDrawBMP.Canvas.Brush.Color := FBgColor; + FDrawBMP.Canvas.FillRect(ClientRect); ProcessCaption(Points); Canvas.CopyMode := cmSrcCopy; - Canvas.Draw(0, 0, lbDrawBMP); + Canvas.Draw(0, 0, FDrawBMP); end; procedure TVpCustomLEDLabel.PaintSegment(Segment: Integer; Color: TColor; - Points: array of TPoint; - OffsetX, OffsetY: Integer); + Points: array of TPoint; OffsetX, OffsetY: Integer); var I: Integer; DrawPts: array[0..5] of TPoint; begin Dec(Segment); - lbDrawBMP.Canvas.Pen.Style := psClear; - lbDrawBMP.Canvas.Brush.Color := Color; + FDrawBMP.Canvas.Pen.Style := psClear; + FDrawBMP.Canvas.Brush.Color := Color; for i := 0 to 5 do begin DrawPts[i].X := offsetX + Points[Segment * 6 + i].X; DrawPts[i].Y := offsetY + Points[Segment * 6 + i].Y; end; - lbDrawBMP.Canvas.Polygon(DrawPts); + FDrawBMP.Canvas.Polygon(DrawPts); end; procedure TVpCustomLEDLabel.SelectSegments(Segment: word; Points: array of TPoint; @@ -366,7 +390,7 @@ begin Color := FOffColor; end; if (not Skip) and (Color <> FBgColor) then - PaintSegment(I, Color, Points, OffsetX, OffsetY); + PaintSegment(I, Color, Points, OffsetX, OffsetY); Bit := Bit div 2; end; end; @@ -398,51 +422,55 @@ begin for I := 1 to Length(Caption) do begin Next := Caption[I]; case Ord(Next) of - 42..58,60,62,65..90,92,97..122: begin - if ColsPerRow = FColumns then begin + 42..58,60,62,65..90,92,97..122: + begin + if ColsPerRow = FColumns then begin + Row := Row + 1; + if Row > FRows then + exit; + offsetY := newOffset('y',offsetY); + offsetX := FSize; + ColsPerRow := 0 + end; + if (Next = '.') or (Next = ',') then + if (Last = '.') or (Last = ',') then begin + SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points, + OffsetX, OffsetY); + OffsetX := NewOffset('x', OffsetX); + end + else begin + OffsetX := OffsetX - (17 * (FSize - 1)); + Tmp := (Characters[CharacterNDX[Ord(Next)]] + or Characters[CharacterNDX[Ord(Last)]]); + SelectSegments(Tmp, Points, OffsetX, OffsetY); + OffsetX := NewOffset('x', OffsetX); + end + else begin + SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points, OffsetX, + OffsetY); + offsetX := NewOffset('x', OffsetX); + ColsPerRow := ColsPerRow + 1; + end; + end; + 10: + begin {eat linefeed} + end; + 13: + begin + if ColsPerRow < FColumns then + for x := 1 to (FColumns - ColsPerRow) do begin + SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY); + OffsetX := NewOffset('x', OffsetX); + end; Row := Row + 1; if Row > FRows then exit; - offsetY := newOffset('y',offsetY); - offsetX := FSize; - ColsPerRow := 0 - end; - if (Next = '.') or (Next = ',') then - if (Last = '.') or (Last = ',') then begin - SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points, - OffsetX, OffsetY); - OffsetX := NewOffset('x', OffsetX); - end - else begin - OffsetX := OffsetX - (17 * (FSize - 1)); - Tmp := (Characters[CharacterNDX[Ord(Next)]] - or Characters[CharacterNDX[Ord(Last)]]); - SelectSegments(Tmp, Points, OffsetX, OffsetY); - OffsetX := NewOffset('x', OffsetX); - end - else begin - SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points, OffsetX, - OffsetY); - offsetX := NewOffset('x', OffsetX); - ColsPerRow := ColsPerRow + 1; - end; - end; - 10: begin {eat linefeed} - end; - 13: begin - if ColsPerRow < FColumns then - for x := 1 to (FColumns - ColsPerRow) do begin - SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY); - OffsetX := NewOffset('x', OffsetX); - end; - Row := Row + 1; - if Row > FRows then - exit; OffsetY := NewOffset('y', OffsetY); OffsetX := FSize; ColsPerRow := 0; end; - else begin + else + begin if ColsPerRow = FColumns then begin Row := Row + 1; if Row > FRows then @@ -475,11 +503,15 @@ begin end; procedure TVpCustomLEDLabel.ResizeControl(Row, Col, Size: Integer); +var + w, h: Integer; begin FRows := Row; FColumns := Col; FSize := Size; - SetBounds(Left, Top, FColumns * 17 * (FSize - 1), FRows * 30 * (FSize - 1)); + w := round(FColumns * 17 * (FSize - 1) * FScaleFactor); + h := round(FRows * 30 * (FSize - 1) * FScaleFactor); + SetBounds(Left, Top, w, h); Invalidate; end; @@ -528,8 +560,9 @@ end; procedure TVpCustomLEDLabel.SetSize(Value : TSegmentSize); begin if FSize <> Value then begin - if Value {%H-}< 2 then - {%H-}Value := 2; + if Integer(Value) < 2 then + Value := 2 + else if Integer(Value) > 10 then Value := 10; ResizeControl(FRows, FColumns, Value);