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 @@
+
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);