pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Fix LCLScaling in TVpLEDLabel and TVpClock. Some refactoring.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8474 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-11 22:34:04 +00:00
parent bf1712ff85
commit 91dc676e62
6 changed files with 258 additions and 195 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/tvplanit/examples/gadgets/project1.lpi
View File

@ -9,6 +9,7 @@
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<Title Value="project1"/> <Title Value="project1"/>
<Scaled Value="True"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
</General> </General>

1
components/tvplanit/examples/gadgets/project1.lpr
View File

@ -14,6 +14,7 @@ uses
begin begin
RequireDerivedFormResource := True; RequireDerivedFormResource := True;
Application.Scaled:=True;
Application.Initialize; Application.Initialize;
Application.CreateForm(TForm1, Form1); Application.CreateForm(TForm1, Form1);
Application.Run; Application.Run;

20
components/tvplanit/examples/gadgets/unit1.lfm
View File

@ -1,13 +1,14 @@
object Form1: TForm1 object Form1: TForm1
Left = 320 Left = 142
Height = 292 Height = 292
Top = 160 Top = 71
Width = 457 Width = 459
Caption = 'TvPlanit Gadgets demo' Caption = 'TvPlanit Gadgets demo'
ClientHeight = 292 ClientHeight = 292
ClientWidth = 457 ClientWidth = 459
Font.Color = clWindowText Font.Color = clWindowText
OnShow = FormShow OnShow = FormShow
LCLVersion = '2.3.0.0'
object VpClock: TVpClock object VpClock: TVpClock
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = Panel1
@ -51,14 +52,13 @@ object Form1: TForm1
object BtnStartStop: TButton object BtnStartStop: TButton
AnchorSideLeft.Control = RgClockMode AnchorSideLeft.Control = RgClockMode
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RgClockMode
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = RgClockMode
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 342 Left = 342
Height = 25 Height = 25
Top = 190 Top = 168
Width = 80 Width = 80
Anchors = [akLeft]
AutoSize = True AutoSize = True
BorderSpacing.Left = 16 BorderSpacing.Left = 16
Caption = 'Start' Caption = 'Start'
@ -118,7 +118,7 @@ object Form1: TForm1
AnchorSideBottom.Control = BtnStartStop AnchorSideBottom.Control = BtnStartStop
Left = 342 Left = 342
Height = 19 Height = 19
Top = 159 Top = 137
Width = 98 Width = 98
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -180,7 +180,7 @@ object Form1: TForm1
AnchorSideBottom.Control = BtnStartStop AnchorSideBottom.Control = BtnStartStop
Left = 342 Left = 342
Height = 19 Height = 19
Top = 159 Top = 137
Width = 85 Width = 85
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Top = 12 BorderSpacing.Top = 12
@ -238,7 +238,7 @@ object Form1: TForm1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 342 Left = 342
Height = 25 Height = 25
Top = 217 Top = 195
Width = 80 Width = 80
AutoSize = True AutoSize = True
BorderSpacing.Top = 2 BorderSpacing.Top = 2

27
components/tvplanit/examples/gadgets/unit1.pas
View File

@ -110,18 +110,18 @@ procedure TForm1.CbNewClockFaceChange(Sender: TObject);
begin begin
if CbNewClockFace.Checked then begin if CbNewClockFace.Checked then begin
VpClock.AnalogOptions.ClockFace.LoadFromFile('clockface.bmp'); VpClock.AnalogOptions.ClockFace.LoadFromFile('clockface.bmp');
VpClock.AnalogOptions.HourHandWidth := 2; VpClock.AnalogOptions.HourHandWidth := Scale96ToFont(2);
VpClock.AnalogOptions.MinuteHandWidth := 2; VpClock.AnalogOptions.MinuteHandWidth := Scale96ToFont(2);
VpClock.AnalogOptions.SecondHandWidth := 1; VpClock.AnalogOptions.SecondHandWidth := Scale96ToFont(1);
VpClock.Width := 100; VpClock.Width := Scale96ToFont(100);
VpClock.Height := 100; VpClock.Height := Scale96ToFont(100);
end else begin end else begin
VpClock.AnalogOptions.ClockFace := nil; VpClock.AnalogOptions.ClockFace := nil;
VpClock.AnalogOptions.HourHandWidth := 4; VpClock.AnalogOptions.HourHandWidth := Scale96ToFont(4);
VpClock.AnalogOptions.MinuteHandWidth := 3; VpClock.AnalogOptions.MinuteHandWidth := Scale96ToFont(3);
VpClock.AnalogOptions.SecondHandWidth := 1; VpClock.AnalogOptions.SecondHandWidth := Scale96ToFont(1);
VpClock.Width := 200; VpClock.Width := Scale96ToFont(200);
VpClock.Height := 200; VpClock.Height := Scale96ToFont(200);
end; end;
VpClock.AnalogOptions.DrawMarks := not CbNewClockFace.Checked; VpClock.AnalogOptions.DrawMarks := not CbNewClockFace.Checked;
if RgDisplayMode.ItemIndex = ord(dmAnalog) then if RgDisplayMode.ItemIndex = ord(dmAnalog) then
@ -190,10 +190,9 @@ begin
dmAnalog: dmAnalog:
CbNewClockFaceChange(nil); CbNewClockFaceChange(nil);
dmDigital: dmDigital:
begin ;
VpClock.Width := 136; // The clock is not freely sizeable in digital display mode
VpClock.Height := 30; // VpClock.SetBounds(VpClock.Left, VpClock.Left, Scale96ToForm(136), Scale96ToForm(30));
end;
end; end;
CbMilitaryTime.Visible := VpClock.DisplayMode = dmDigital; CbMilitaryTime.Visible := VpClock.DisplayMode = dmDigital;
CbNewClockface.Visible := VpClock.DisplayMode = dmAnalog; CbNewClockface.Visible := VpClock.DisplayMode = dmAnalog;

187
components/tvplanit/source/vpclock.pas
View File

@ -40,7 +40,7 @@ uses
Windows, Messages, VpTimerPool, Windows, Messages, VpTimerPool,
{$ENDIF} {$ENDIF}
SysUtils, Graphics, Types, Classes, Controls, Dialogs, Forms, Menus, Math, SysUtils, Graphics, Types, Classes, Controls, Dialogs, Forms, Menus, Math,
VpBase, VpLEDLabel; VpBase, VpConst, VpLEDLabel;
type type
TVpPercent = 0..100; TVpPercent = 0..100;
@ -50,25 +50,26 @@ type
TVpLEDClockDisplay = class(TVpCustomLEDLabel) TVpLEDClockDisplay = class(TVpCustomLEDLabel)
public public
procedure PaintSelf; procedure PaintSelf;
property ScaleFactor;
end; end;
TVpDigitalOptions = class(TPersistent) TVpDigitalOptions = class(TPersistent)
protected{private} private
FOwner : TComponent; FBgColor: TColor;
FOnColor: TColor; FOnColor: TColor;
FOffColor: TColor; FOffColor: TColor;
FBgColor : TColor;
FSize: TSegmentSize; FSize: TSegmentSize;
FShowSeconds: Boolean; FShowSeconds: Boolean;
FFlashColon : Boolean; // FFlashColon: Boolean;
FOnChange : TNotifyEvent;
F24Hour: Boolean; F24Hour: Boolean;
FOnChange: TNotifyEvent;
procedure Set24Hour(Value: Boolean); procedure Set24Hour(Value: Boolean);
procedure SetOnColor(Value: TColor); procedure SetOnColor(Value: TColor);
procedure SetOffColor(Value: TColor); procedure SetOffColor(Value: TColor);
procedure SetBgColor(Value: TColor); procedure SetBgColor(Value: TColor);
procedure SetSize(Value: TSegmentSize); procedure SetSize(Value: TSegmentSize);
procedure SetShowSeconds(Value: Boolean); procedure SetShowSeconds(Value: Boolean);
protected
procedure DoOnChange; procedure DoOnChange;
public public
constructor Create; constructor Create;
@ -114,7 +115,7 @@ type
procedure SetSecondHandWidth(Value : Integer); procedure SetSecondHandWidth(Value : Integer);
procedure SetShowSecondHand(Value : Boolean); procedure SetShowSecondHand(Value : Boolean);
procedure SetSolidHands(Value : Boolean); procedure SetSolidHands(Value : Boolean);
{internal methods} { Internal methods }
procedure DoOnChange; procedure DoOnChange;
public public
constructor Create; constructor Create;
@ -179,6 +180,7 @@ type
FMinuteOffset: Integer; {Minutes} FMinuteOffset: Integer; {Minutes}
FSecondOffset: Integer; {Seconds} FSecondOffset: Integer; {Seconds}
FTimeResolution: Integer; {interval of the internal timer, in ms } FTimeResolution: Integer; {interval of the internal timer, in ms }
FScaleFactor: Double;
{event variables} {event variables}
FOnHourChange: TNotifyEvent; FOnHourChange: TNotifyEvent;
FOnMinuteChange: TNotifyEvent; FOnMinuteChange: TNotifyEvent;
@ -211,10 +213,12 @@ type
procedure SetHold(Value: Boolean); procedure SetHold(Value: Boolean);
procedure SetHourOffset(Value: Integer); procedure SetHourOffset(Value: Integer);
procedure SetSecondOffset(Value: Integer); procedure SetSecondOffset(Value: Integer);
{internal methods}
{ Internal methods }
function ckConvertMsToDateTime(Value: LongInt): TDateTime; function ckConvertMsToDateTime(Value: LongInt): TDateTime;
procedure ckHandOptionChange(Sender: TObject); procedure ckHandOptionChange(Sender: TObject);
procedure ckDigitalOptionChange(Sender: TObject); procedure ckDigitalOptionChange(Sender: TObject);
procedure SetDigitalTimeStr(ATime: TDateTime);
procedure SizeDigitalDisplay; procedure SizeDigitalDisplay;
{$IFDEF DELPHI} {$IFDEF DELPHI}
procedure ckTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal; procedure ckTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal;
@ -228,7 +232,8 @@ type
procedure DoOnCountdownDone; procedure DoOnCountdownDone;
procedure PaintHands(ACanvas: TCanvas); procedure PaintHands(ACanvas: TCanvas);
class function GetControlClassDefaultSize: TSize; override; class function GetControlClassDefaultSize: TSize; override;
{windows message methods}
{ Messaging }
{$IFDEF LCL} {$IFDEF LCL}
procedure WMResize(var Msg: TLMSize); message LM_SIZE; procedure WMResize(var Msg: TLMSize); message LM_SIZE;
procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND; procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
@ -237,6 +242,13 @@ type
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE; procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
{$ENDIF} {$ENDIF}
{ LCL scaling }
{$IF VP_LCL_SCALING <> 0}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$IFEND}
protected protected
procedure Loaded; override; procedure Loaded; override;
procedure Paint; override; procedure Paint; override;
@ -271,6 +283,11 @@ type
procedure Pause; procedure Pause;
procedure Resume; 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 DisplayMode: TVpClockDisplayMode read FDisplayMode write SetDisplayMode;
property ElapsedDays: Integer read GetElapsedDays; property ElapsedDays: Integer read GetElapsedDays;
property ElapsedHours: Integer read GetElapsedHours; property ElapsedHours: Integer read GetElapsedHours;
@ -324,7 +341,7 @@ type
implementation implementation
uses uses
VpConst, VpMisc; VpMisc;
const const
ckDToR = (Pi / 180); ckDToR = (Pi / 180);
@ -347,14 +364,12 @@ begin
FShowSeconds := True; FShowSeconds := True;
MilitaryTime := True; MilitaryTime := True;
end; end;
{=====}
procedure TVpDigitalOptions.DoOnChange; procedure TVpDigitalOptions.DoOnChange;
begin begin
if Assigned(FOnChange) then if Assigned(FOnChange) then
FOnChange(Self); FOnChange(Self);
end; end;
{=====}
procedure TVpDigitalOptions.Set24Hour(Value: Boolean); procedure TVpDigitalOptions.Set24Hour(Value: Boolean);
begin begin
@ -363,7 +378,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpDigitalOptions.SetOnColor(Value: TColor); procedure TVpDigitalOptions.SetOnColor(Value: TColor);
begin begin
@ -372,7 +386,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpDigitalOptions.SetOffColor(Value: TColor); procedure TVpDigitalOptions.SetOffColor(Value: TColor);
begin begin
@ -381,7 +394,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpDigitalOptions.SetBgColor(Value: TColor); procedure TVpDigitalOptions.SetBgColor(Value: TColor);
begin begin
@ -390,7 +402,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpDigitalOptions.SetSize(Value: TSegmentSize); procedure TVpDigitalOptions.SetSize(Value: TSegmentSize);
begin begin
@ -399,7 +410,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpDigitalOptions.SetShowSeconds(Value: Boolean); procedure TVpDigitalOptions.SetShowSeconds(Value: Boolean);
begin begin
@ -408,7 +418,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
{===== TVpHandOptions ===============================================} {===== TVpHandOptions ===============================================}
@ -419,7 +428,6 @@ begin
FClockFace := TBitMap.Create; FClockFace := TBitMap.Create;
FDrawMarks := True; FDrawMarks := True;
end; end;
{=====}
destructor TVpHandOptions.Destroy; destructor TVpHandOptions.Destroy;
begin begin
@ -427,7 +435,6 @@ begin
FClockFace := nil; FClockFace := nil;
inherited; inherited;
end; end;
{=====}
procedure TVpHandOptions.Assign(Source: TPersistent); procedure TVpHandOptions.Assign(Source: TPersistent);
begin begin
@ -447,7 +454,6 @@ begin
end else end else
inherited Assign(Source); inherited Assign(Source);
end; end;
{=====}
procedure TVpHandOptions.SetClockFace(Value: TBitMap); procedure TVpHandOptions.SetClockFace(Value: TBitMap);
begin begin
@ -459,7 +465,6 @@ begin
end; end;
FOnChange(self); FOnChange(self);
end; end;
{=====}
procedure TVpHandOptions.SetDrawMarks(Value: Boolean); procedure TVpHandOptions.SetDrawMarks(Value: Boolean);
begin begin
@ -468,14 +473,12 @@ begin
FOnChange(Self); FOnChange(Self);
end; end;
end; end;
{=====}
procedure TVpHandOptions.DoOnChange; procedure TVpHandOptions.DoOnChange;
begin begin
if Assigned(FOnChange) then if Assigned(FOnChange) then
FOnChange(Self); FOnChange(Self);
end; end;
{=====}
procedure TVpHandOptions.SetHourHandColor(Value: TColor); procedure TVpHandOptions.SetHourHandColor(Value: TColor);
begin begin
@ -484,7 +487,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetHourHandLength(Value: TVpPercent); procedure TVpHandOptions.SetHourHandLength(Value: TVpPercent);
begin begin
@ -493,7 +495,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetHourHandWidth(Value: Integer); procedure TVpHandOptions.SetHourHandWidth(Value: Integer);
begin begin
@ -502,7 +503,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetMinuteHandColor(Value: TColor); procedure TVpHandOptions.SetMinuteHandColor(Value: TColor);
begin begin
@ -511,7 +511,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetMinuteHandLength(Value: TVpPercent); procedure TVpHandOptions.SetMinuteHandLength(Value: TVpPercent);
begin begin
@ -520,7 +519,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetMinuteHandWidth(Value: Integer); procedure TVpHandOptions.SetMinuteHandWidth(Value: Integer);
begin begin
@ -538,7 +536,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetSecondHandLength(Value: TVpPercent); procedure TVpHandOptions.SetSecondHandLength(Value: TVpPercent);
begin begin
@ -547,7 +544,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetSecondHandWidth(Value: Integer); procedure TVpHandOptions.SetSecondHandWidth(Value: Integer);
begin begin
@ -556,7 +552,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetShowSecondHand(Value: Boolean); procedure TVpHandOptions.SetShowSecondHand(Value: Boolean);
begin begin
@ -565,7 +560,6 @@ begin
DoOnChange; DoOnChange;
end; end;
end; end;
{=====}
procedure TVpHandOptions.SetSolidHands(Value: Boolean); procedure TVpHandOptions.SetSolidHands(Value: Boolean);
begin begin
@ -575,7 +569,8 @@ begin
end; end;
end; end;
{===== TOvcCustomClock ===============================================}
{===== TVpCustomClock ===============================================}
constructor TVpCustomClock.Create(AOwner: TComponent); constructor TVpCustomClock.Create(AOwner: TComponent);
begin begin
@ -603,6 +598,7 @@ begin
FDigitalOptions := TVpDigitalOptions.Create; FDigitalOptions := TVpDigitalOptions.Create;
FDigitalOptions.FOnChange := ckDigitalOptionChange; FDigitalOptions.FOnChange := ckDigitalOptionChange;
FScaleFactor := 1.0;
ckDraw := TBitMap.Create; ckDraw := TBitMap.Create;
ckDraw.Width := Width; ckDraw.Width := Width;
@ -618,7 +614,6 @@ begin
FTimer.Enabled := false; FTimer.Enabled := false;
{$ENDIF} {$ENDIF}
end; end;
{=====}
destructor TVpCustomClock.Destroy; destructor TVpCustomClock.Destroy;
begin begin
@ -634,7 +629,19 @@ begin
inherited Destroy; inherited Destroy;
end; 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; function TVpCustomClock.ckConvertMsToDateTime(Value: LongInt) : TDateTime;
var var
@ -650,16 +657,17 @@ begin
Second := S mod SecondsInMinute; Second := S mod SecondsInMinute;
Result := EncodeTime(Hour, Minute, Second, 0) + Days; Result := EncodeTime(Hour, Minute, Second, 0) + Days;
end; end;
{=====}
procedure TVpCustomClock.ckHandOptionChange(Sender: TObject); procedure TVpCustomClock.ckHandOptionChange(Sender: TObject);
begin begin
if FDisplayMode = dmAnalog then if FDisplayMode = dmAnalog then
Invalidate; Invalidate;
end; end;
{=====}
procedure TVpCustomClock.ckDigitalOptionChange(Sender: TObject); 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 begin
if FDisplayMode = dmDigital then begin if FDisplayMode = dmDigital then begin
ckLEDDisplay.Size := FDigitalOptions.Size; ckLEDDisplay.Size := FDigitalOptions.Size;
@ -667,26 +675,17 @@ begin
ckLEDDisplay.OnColor := FDigitalOptions.OnColor ; ckLEDDisplay.OnColor := FDigitalOptions.OnColor ;
ckLEDDisplay.OffColor := FDigitalOptions.OffColor; ckLEDDisplay.OffColor := FDigitalOptions.OffColor;
FMilitaryTime := FDigitalOptions.MilitaryTime; FMilitaryTime := FDigitalOptions.MilitaryTime;
if FDigitalOptions.ShowSeconds and FMilitaryTime then ckLEDDisplay.Columns := SHOWSECONDS_COLS[FDigitalOptions.ShowSeconds] + MILITARY_COLS[FMilitaryTime];
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;
SizeDigitalDisplay; SizeDigitalDisplay;
Invalidate; // Invalidate;
end; end;
end; end;
{=====}
procedure TVpCustomClock.SizeDigitalDisplay; procedure TVpCustomClock.SizeDigitalDisplay;
begin begin
Width := ckLEDDisplay.Width; Width := ckLEDDisplay.Width;
Height := ckLEDDisplay.Height; Height := ckLEDDisplay.Height;
end; end;
{=====}
{$IFDEF DELPHI} {$IFDEF DELPHI}
procedure TVpCustomClock.ckTimerEvent(Sender: TObject; Handle: Integer; procedure TVpCustomClock.ckTimerEvent(Sender: TObject; Handle: Integer;
@ -761,7 +760,27 @@ begin
end; end;
end; end;
{$ENDIF} {$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; procedure TVpCustomClock.DoOnHourChange;
begin begin
@ -1229,7 +1248,6 @@ begin
X := Round(HandBase * 0.04) + 1; X := Round(HandBase * 0.04) + 1;
ACanvas.Ellipse(HalfWidth-X, HalfHeight-X, HalfWidth+X, HalfHeight+X); ACanvas.Ellipse(HalfWidth-X, HalfHeight-X, HalfWidth+X, HalfHeight+X);
end; end;
{=====}
procedure TVpCustomClock.SetActive(Value: Boolean); procedure TVpCustomClock.SetActive(Value: Boolean);
begin begin
@ -1278,20 +1296,16 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
procedure TVpCustomClock.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); procedure TVpCustomClock.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight); inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if Assigned(ckDraw) then begin if Assigned(ckDraw) then begin
ckDraw.Width := AWidth; ckDraw.Width := AWidth;
ckDraw.Height := AHeight; ckDraw.Height := AHeight;
end; end;
Invalidate; Invalidate;
end; end;
{=====}
procedure TVpCustomClock.SetClockMode(Value: TVpClockMode); procedure TVpCustomClock.SetClockMode(Value: TVpClockMode);
begin begin
@ -1310,14 +1324,32 @@ begin
Invalidate; Invalidate;
end; end;
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); procedure TVpCustomClock.SetDisplayMode(Value: TVpClockDisplayMode);
begin begin
if Value <> FDisplayMode then begin if Value <> FDisplayMode then begin
FDisplayMode := Value; FDisplayMode := Value;
case FDisplayMode of
case FDisplayMode of
dmDigital: begin dmDigital: begin
{Save the analog height and width} {Save the analog height and width}
ckAnalogHeight := Height; ckAnalogHeight := Height;
@ -1325,25 +1357,40 @@ begin
{Create and initialize the LED display} {Create and initialize the LED display}
ckLEDDisplay := TVpLEDClockDisplay.Create(self); ckLEDDisplay := TVpLEDClockDisplay.Create(self);
ckLEDDisplay.ScaleFactor := FScaleFactor;
ckLEDDisplay.Parent := self; ckLEDDisplay.Parent := self;
ckLEDDisplay.OnColor := FDigitalOptions.OnColor; ckLEDDisplay.OnColor := FDigitalOptions.OnColor;
ckLEDDisplay.OffColor := FDigitalOptions.OffColor; ckLEDDisplay.OffColor := FDigitalOptions.OffColor;
ckLEDDisplay.BgColor := FDigitalOptions.BgColor; ckLEDDisplay.BgColor := FDigitalOptions.BgColor;
ckLEDDisplay.Size := FDigitalOptions.Size; ckLEDDisplay.Size := FDigitalOptions.Size;
if FDigitalOptions.ShowSeconds then begin if FDigitalOptions.ShowSeconds then begin
if FMilitaryTime then
begin
ckLEDDisplay.Columns := 11;
ckLEDDisplay.Caption := '00:00:00 AM';
end else
begin
ckLEDDisplay.Columns := 8; ckLEDDisplay.Columns := 8;
ckLEDDisplay.Caption := '00:00:00'; ckLEDDisplay.Caption := '00:00:00';
end;
end else begin end else begin
if FMilitaryTime then
begin
ckLEDDisplay.Columns := 8;
ckLEDDisplay.Caption := '00:00 AM';
end else
begin
ckLEDDisplay.Columns := 5; ckLEDDisplay.Columns := 5;
ckLEDDisplay.Caption := '00:00'; ckLEDDisplay.Caption := '00:00';
end; end;
end;
{Set the height and width of the control} {Set the height and width of the control}
SizeDigitalDisplay; SizeDigitalDisplay;
{Blank the control} {Blank the control}
Canvas.Brush.Color := FDigitalOptions.BgColor; //Canvas.Brush.Color := FDigitalOptions.BgColor;
Canvas.FillRect(GetClientRect); //Canvas.FillRect(GetClientRect);
{Initialize the LED display} {Initialize the LED display}
if FActive then begin if FActive then begin
@ -1437,24 +1484,11 @@ begin
DoOnSecondChange; DoOnSecondChange;
ckOldSecond := Second1; ckOldSecond := Second1;
if DisplayMode = dmDigital then begin if DisplayMode = dmDigital then
if FDigitalOptions.ShowSeconds and FMilitaryTime then SetDigitalTimeStr(FTime);
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;
Invalidate; Invalidate;
end; end;
{=====}
procedure TVpCustomClock.SetMinuteOffset(Value: Integer); procedure TVpCustomClock.SetMinuteOffset(Value: Integer);
begin begin
@ -1465,7 +1499,6 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
procedure TVpCustomClock.SetHold(Value: Boolean); procedure TVpCustomClock.SetHold(Value: Boolean);
begin begin
@ -1495,7 +1528,6 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
procedure TVpCustomClock.SetSecondOffset(Value: Integer); procedure TVpCustomClock.SetSecondOffset(Value: Integer);
begin begin
@ -1506,7 +1538,6 @@ begin
Invalidate; Invalidate;
end; end;
end; end;
{=====}
procedure TVpCustomClock.Start; procedure TVpCustomClock.Start;
begin begin
@ -1551,7 +1582,6 @@ procedure TVpCustomClock.WMEraseBkgnd(var Msg: TLMEraseBkGnd);
begin begin
Msg.Result := 1; Msg.Result := 1;
end; end;
{=====}
{$IFNDEF LCL} {$IFNDEF LCL}
procedure TVpCustomClock.WMGetDlgCode(var Msg: TWMGetDlgCode); procedure TVpCustomClock.WMGetDlgCode(var Msg: TWMGetDlgCode);
@ -1560,6 +1590,5 @@ begin
Msg.Result := DLGC_STATIC; Msg.Result := DLGC_STATIC;
end; end;
{$ENDIF} {$ENDIF}
{=====}
end. end.

105
components/tvplanit/source/vpledlabel.pas
View File

@ -39,20 +39,29 @@ uses
{$ELSE} {$ELSE}
Windows, Messages, Windows, Messages,
{$ENDIF} {$ENDIF}
Classes, Controls, Graphics, Types, SysUtils; Classes, Controls, Graphics, Types, SysUtils,
VPConst;
type type
TSegmentSize = 2..10; TSegmentSize = 2..10;
TVpCustomLEDLabel = class(TGraphicControl) TVpCustomLEDLabel = class(TGraphicControl)
protected{private} private
FBgColor: TColor; FBgColor: TColor;
FColumns: Integer;
FOffColor: TColor; FOffColor: TColor;
FOnColor: TColor; FOnColor: TColor;
FColumns : Integer;
FRows: Integer; FRows: Integer;
FSize: TSegmentSize; FSize: TSegmentSize;
lbDrawBmp : TBitmap; 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 CMTextChanged(var Message: {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF}); message CM_TEXTCHANGED;
procedure Initialize(out Points: array of TPoint); procedure Initialize(out Points: array of TPoint);
function NewOffset(xOry: char; OldOffset: Integer): Integer; function NewOffset(xOry: char; OldOffset: Integer): Integer;
@ -60,19 +69,18 @@ type
procedure PaintSegment(Segment: Integer; Color: TColor; Points: array of TPoint; procedure PaintSegment(Segment: Integer; Color: TColor; Points: array of TPoint;
OffsetX, OffsetY: Integer); OffsetX, OffsetY: Integer);
procedure ResizeControl(Row, Col, Size: Integer); procedure ResizeControl(Row, Col, Size: Integer);
function GetAbout: string;
procedure SetAbout(const Value: string);
procedure SetSize(Value: TSegmentSize); 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; procedure SelectSegments(Segment: Word; Points: array of TPoint;
OffsetX, OffsetY: Integer); OffsetX, OffsetY: Integer);
protected protected
FScaleFactor: Double;
{$IF VP_LCL_SCALING <> 0}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$IFEND}
class function GetControlClassDefaultSize: TSize; override; class function GetControlClassDefaultSize: TSize; override;
procedure Paint; override; procedure Paint; override;
property ScaleFactor: double read FScaleFactor write FScaleFactor;
public public
constructor Create(AOwner:TComponent);override; constructor Create(AOwner:TComponent);override;
destructor Destroy; override; destructor Destroy; override;
@ -138,7 +146,7 @@ type
implementation implementation
uses uses
VpConst, VpMisc; VpMisc;
{ LED Segment Map } { LED Segment Map }
{ } { }
@ -256,23 +264,38 @@ begin
csSetCaption, csSetCaption,
csClickEvents, csClickEvents,
csDoubleClicks]; csDoubleClicks];
lbDrawBmp := TBitmap.Create; FDrawBmp := TBitmap.Create;
FOnColor := clLime; FOnColor := clLime;
FOffColor := $000E3432; FOffColor := $000E3432;
FBgColor := clBlack; FBgColor := clBlack;
FSize := 2; FSize := 2;
FRows := 1; FRows := 1;
FColumns := 10; FColumns := 10;
FScaleFactor := 1.0;
Caption := 'LED-LABEL'; Caption := 'LED-LABEL';
end; end;
destructor TVpCustomLEDLabel.Destroy; destructor TVpCustomLEDLabel.Destroy;
begin begin
lbDrawBmp.Free; FreeAndNil(FDrawBmp);
lbDrawBmp := nil;
inherited Destroy; inherited Destroy;
end; 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; function TVpCustomLEDLabel.GetAbout : string;
begin begin
Result := VpVersionStr; Result := VpVersionStr;
@ -293,52 +316,53 @@ end;
procedure TVpCustomLEDLabel.Initialize(out Points: array of TPoint); procedure TVpCustomLEDLabel.Initialize(out Points: array of TPoint);
var var
I: Integer; I: Integer;
f: Double;
begin begin
f := FScaleFactor * (FSize - 1);
for I := 0 to MAX_POINTS do begin for I := 0 to MAX_POINTS do begin
Points[i].X := DigitPoints[i].X * (FSize - 1); Points[i].X := round(DigitPoints[i].X * f);
Points[i].Y := DigitPoints[i].Y * (FSize - 1); Points[i].Y := round(DigitPoints[i].Y * f);
end; end;
end; end;
function TVpCustomLEDLabel.NewOffset(xOry:char;oldOffset:integer):integer; function TVpCustomLEDLabel.NewOffset(xOry:char;oldOffset:integer):integer;
begin begin
if (xOry = 'x')then if (xOry = 'x')then
newOffset := oldOffset + 17 * (FSize - 1) newOffset := oldOffset + round(17 * (FSize - 1) * FScaleFactor)
else else
newOffset := oldOffset + 30 * (FSize -1) newOffset := oldOffset + round(30 * (FSize - 1) * FScaleFactor);
end; end;
procedure TVpCustomLEDLabel.Paint; procedure TVpCustomLEDLabel.Paint;
var var
Points: array[0..MAX_POINTS] of TPoint; Points: array[0..MAX_POINTS] of TPoint;
begin begin
lbDrawBMP.Width := Width; FDrawBMP.Width := Width;
lbDrawBMP.Height := Height; FDrawBMP.Height := Height;
Initialize(Points); Initialize(Points);
lbDrawBMP.Canvas.Brush.Color := FBgColor; FDrawBMP.Canvas.Brush.Color := FBgColor;
lbDrawBMP.Canvas.FillRect(ClientRect); FDrawBMP.Canvas.FillRect(ClientRect);
ProcessCaption(Points); ProcessCaption(Points);
Canvas.CopyMode := cmSrcCopy; Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, lbDrawBMP); Canvas.Draw(0, 0, FDrawBMP);
end; end;
procedure TVpCustomLEDLabel.PaintSegment(Segment: Integer; Color: TColor; procedure TVpCustomLEDLabel.PaintSegment(Segment: Integer; Color: TColor;
Points: array of TPoint; Points: array of TPoint; OffsetX, OffsetY: Integer);
OffsetX, OffsetY: Integer);
var var
I: Integer; I: Integer;
DrawPts: array[0..5] of TPoint; DrawPts: array[0..5] of TPoint;
begin begin
Dec(Segment); Dec(Segment);
lbDrawBMP.Canvas.Pen.Style := psClear; FDrawBMP.Canvas.Pen.Style := psClear;
lbDrawBMP.Canvas.Brush.Color := Color; FDrawBMP.Canvas.Brush.Color := Color;
for i := 0 to 5 do begin for i := 0 to 5 do begin
DrawPts[i].X := offsetX + Points[Segment * 6 + i].X; DrawPts[i].X := offsetX + Points[Segment * 6 + i].X;
DrawPts[i].Y := offsetY + Points[Segment * 6 + i].Y; DrawPts[i].Y := offsetY + Points[Segment * 6 + i].Y;
end; end;
lbDrawBMP.Canvas.Polygon(DrawPts); FDrawBMP.Canvas.Polygon(DrawPts);
end; end;
procedure TVpCustomLEDLabel.SelectSegments(Segment: word; Points: array of TPoint; procedure TVpCustomLEDLabel.SelectSegments(Segment: word; Points: array of TPoint;
@ -398,7 +422,8 @@ begin
for I := 1 to Length(Caption) do begin for I := 1 to Length(Caption) do begin
Next := Caption[I]; Next := Caption[I];
case Ord(Next) of case Ord(Next) of
42..58,60,62,65..90,92,97..122: begin 42..58,60,62,65..90,92,97..122:
begin
if ColsPerRow = FColumns then begin if ColsPerRow = FColumns then begin
Row := Row + 1; Row := Row + 1;
if Row > FRows then if Row > FRows then
@ -427,9 +452,11 @@ begin
ColsPerRow := ColsPerRow + 1; ColsPerRow := ColsPerRow + 1;
end; end;
end; end;
10: begin {eat linefeed} 10:
begin {eat linefeed}
end; end;
13: begin 13:
begin
if ColsPerRow < FColumns then if ColsPerRow < FColumns then
for x := 1 to (FColumns - ColsPerRow) do begin for x := 1 to (FColumns - ColsPerRow) do begin
SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY); SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
@ -442,7 +469,8 @@ begin
OffsetX := FSize; OffsetX := FSize;
ColsPerRow := 0; ColsPerRow := 0;
end; end;
else begin else
begin
if ColsPerRow = FColumns then begin if ColsPerRow = FColumns then begin
Row := Row + 1; Row := Row + 1;
if Row > FRows then if Row > FRows then
@ -475,11 +503,15 @@ begin
end; end;
procedure TVpCustomLEDLabel.ResizeControl(Row, Col, Size: Integer); procedure TVpCustomLEDLabel.ResizeControl(Row, Col, Size: Integer);
var
w, h: Integer;
begin begin
FRows := Row; FRows := Row;
FColumns := Col; FColumns := Col;
FSize := Size; 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; Invalidate;
end; end;
@ -528,8 +560,9 @@ end;
procedure TVpCustomLEDLabel.SetSize(Value : TSegmentSize); procedure TVpCustomLEDLabel.SetSize(Value : TSegmentSize);
begin begin
if FSize <> Value then begin if FSize <> Value then begin
if Value {%H-}< 2 then if Integer(Value) < 2 then
{%H-}Value := 2; Value := 2
else
if Integer(Value) > 10 then if Integer(Value) > 10 then
Value := 10; Value := 10;
ResizeControl(FRows, FColumns, Value); ResizeControl(FRows, FColumns, Value);