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

tvplanit: Fix TVpClock. Add example. Some refactoring and cosmetic changes.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5041 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-28 21:22:54 +00:00
parent 6e6d5a064a
commit ba7e8c8e0c
8 changed files with 833 additions and 272 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
components/tvplanit/examples/gadgets/clockface.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 11 KiB

82
components/tvplanit/examples/gadgets/project1.lpi Normal file
View File

@@ -0,0 +1,82 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="laz_visualplanit"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/tvplanit/examples/gadgets/project1.lpr Normal file
View File

@@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, laz_visualplanit
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

165
components/tvplanit/examples/gadgets/unit1.lfm Normal file
View File

@@ -0,0 +1,165 @@
object Form1: TForm1
Left = 262
Height = 283
Top = 155
Width = 461
Caption = 'Form1'
ClientHeight = 283
ClientWidth = 461
Font.Color = clWindowText
OnCreate = FormCreate
LCLVersion = '1.7'
object VpLEDLabel1: TVpLEDLabel
Left = 9
Height = 60
Top = 6
Width = 442
Caption = 'Visual PlanIt'
Columns = 13
OffColor = 930866
OnColor = clLime
Size = 3
end
object VpClock1: TVpClock
Left = 11
Height = 200
Top = 72
Width = 200
Active = False
Color = clForm
ClockMode = cmClock
DigitalOptions.MilitaryTime = True
DigitalOptions.OnColor = clLime
DigitalOptions.OffColor = 930866
DigitalOptions.BgColor = clBlack
DigitalOptions.Size = 2
DigitalOptions.ShowSeconds = True
DisplayMode = dmAnalog
AnalogOptions.DrawMarks = True
AnalogOptions.HourHandColor = clBlack
AnalogOptions.HourHandLength = 60
AnalogOptions.HourHandWidth = 4
AnalogOptions.MinuteHandColor = clBlack
AnalogOptions.MinuteHandLength = 80
AnalogOptions.MinuteHandWidth = 3
AnalogOptions.SecondHandColor = clRed
AnalogOptions.SecondHandLength = 90
AnalogOptions.SecondHandWidth = 1
AnalogOptions.ShowSecondHand = True
AnalogOptions.SolidHands = True
MinuteOffset = 0
ParentColor = False
SecondOffset = 0
HourOffset = 0
OnCountdownDone = VpClock1CountdownDone
OnSecondChange = VpClockTimeChange
end
object BtnStartStop: TButton
Left = 351
Height = 51
Top = 80
Width = 99
Caption = 'Start'
OnClick = BtnStartStopClick
TabOrder = 1
end
object RgClockMode: TRadioGroup
Left = 224
Height = 89
Top = 151
Width = 116
AutoFill = True
Caption = 'Clock mode'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 69
ClientWidth = 112
ItemIndex = 0
Items.Strings = (
'Clock'
'Counter'
'Count-down'
)
OnClick = RgClockModeClick
TabOrder = 2
end
object EdCountDownTime: TTimeEdit
Left = 351
Height = 23
Top = 172
Width = 99
ButtonWidth = 23
NumGlyphs = 1
MaxLength = 0
OnChange = EdCountDownTimeChange
TabOrder = 3
Visible = False
Text = '00:30:00'
end
object LblCountDownTime: TLabel
Left = 351
Height = 15
Top = 152
Width = 98
Caption = 'Count-down time:'
FocusControl = EdCountDownTime
ParentColor = False
Visible = False
end
object CbNewClockFace: TCheckBox
Left = 351
Height = 19
Top = 221
Width = 100
Caption = 'New clock face'
OnChange = CbNewClockFaceChange
TabOrder = 4
end
object LblElapsedTime: TLabel
Left = 224
Height = 15
Top = 256
Width = 49
Caption = 'Elapsed...'
ParentColor = False
end
object RgDisplayMode: TRadioGroup
Left = 224
Height = 63
Top = 72
Width = 115
AutoFill = True
Caption = 'Display mode'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 43
ClientWidth = 111
ItemIndex = 0
Items.Strings = (
'Analog'
'Digital'
)
OnClick = RgDisplayModeClick
TabOrder = 5
end
object CbMilitaryTime: TCheckBox
Left = 351
Height = 19
Top = 208
Width = 87
Caption = 'Military time'
OnChange = CbMilitaryTimeChange
TabOrder = 6
Visible = False
end
end

179
components/tvplanit/examples/gadgets/unit1.pas Normal file
View File

@@ -0,0 +1,179 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, EditBtn, VpLEDLabel, VpClock;
type
{ TForm1 }
TForm1 = class(TForm)
BtnStartStop: TButton;
CbNewClockFace: TCheckBox;
CbMilitaryTime: TCheckBox;
LblCountDownTime: TLabel;
LblElapsedTime: TLabel;
RgDisplayMode: TRadioGroup;
RgClockMode: TRadioGroup;
VpClock1: TVpClock;
EdCountDownTime: TTimeEdit;
VpLEDLabel1: TVpLEDLabel;
procedure AnalogClockCountdownDone(Sender: TObject);
procedure CbMilitaryTimeChange(Sender: TObject);
procedure VpClockTimeChange(Sender: TObject);
procedure BtnStartStopClick(Sender: TObject);
procedure CbNewClockFaceChange(Sender: TObject);
procedure EdCountDownTimeChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RgClockModeClick(Sender: TObject);
procedure RgDisplayModeClick(Sender: TObject);
procedure VpClock1CountdownDone(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.AnalogClockCountdownDone(Sender: TObject);
begin
ShowMessage('Countdown finished.');
end;
procedure TForm1.VpClockTimeChange(Sender: TObject);
begin
LblElapsedTime.Caption := Format('Elapsed: %d hrs, %d min, %d sec', [
VpClock1.ElapsedHours, VpClock1.ElapsedMinutes, VpClock1.ElapsedSeconds
]);
end;
procedure TForm1.BtnStartStopClick(Sender: TObject);
var
isStarted: Boolean;
willStart: Boolean;
begin
isStarted := VpClock1.Active;
willStart := not isStarted;
if willStart and (RgClockMode.ItemIndex = ord(cmCountdownTimer)) then
RgClockModeClick(nil);
VpClock1.Active := willStart;
if VpClock1.Active then
BtnStartStop.Caption := 'Stop' else
BtnStartStop.Caption := 'Start';
end;
procedure TForm1.CbMilitaryTimeChange(Sender: TObject);
var
t: TDateTime;
begin
t := VpClock1.Time;
VpClock1.DigitalOptions.MilitaryTime := CbMilitaryTime.Checked;
VpClock1.Time := t;
end;
procedure TForm1.CbNewClockFaceChange(Sender: TObject);
begin
if CbNewClockFace.Checked then begin
VpClock1.AnalogOptions.ClockFace.LoadFromFile('clockface.bmp');
VpClock1.AnalogOptions.HourHandWidth := 2;
VpClock1.AnalogOptions.MinuteHandWidth := 2;
VpClock1.AnalogOptions.SecondHandWidth := 1;
VpClock1.Width := 100;
VpClock1.Height := 100;
end else begin
VpClock1.AnalogOptions.ClockFace := nil;
VpClock1.AnalogOptions.HourHandWidth := 4;
VpClock1.AnalogOptions.MinuteHandWidth := 3;
VpClock1.AnalogOptions.SecondHandWidth := 1;
VpClock1.Width := 200;
VpClock1.Height := 200;
end;
VpClock1.AnalogOptions.DrawMarks := not CbNewClockFace.Checked;
if RgDisplayMode.ItemIndex = ord(dmAnalog) then
VpClock1.Invalidate;
end;
procedure TForm1.EdCountDownTimeChange(Sender: TObject);
begin
if VpClock1.ClockMode = cmCountDownTimer then
VpClock1.Time := EdCountDownTime.Time;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
EdCountDownTime.Time := StrToTime(EdCountDownTime.Text);
CbMilitaryTime.Top := CbNewClockFace.Top;
end;
procedure TForm1.RgClockModeClick(Sender: TObject);
var
h,m,s,ms: Word;
begin
VpClock1.Active := false;
BtnStartStop.Caption := 'Start';
VpClock1.ClockMode := TVpClockMode(RgClockMode.ItemIndex);
case VpClock1.ClockMode of
cmClock:
begin
VpClock1.Time := now;
VpClock1.Active := true;
BtnStartStop.Caption := 'Stop';
end;
cmTimer:
VpClock1.Time := 0;
cmCountdownTimer:
begin
DecodeTime(EdCountDownTime.Time, h,m,s,ms);
VpClock1.HourOffset := h;
VpClock1.MinuteOffset := m;
VpClock1.SecondOffset := s;
end;
end;
EdCountDownTime.Visible := VpClock1.ClockMode = cmCountDownTimer;
LblCountDownTime.Visible := EdCountDownTime.Visible;
end;
procedure TForm1.RgDisplayModeClick(Sender: TObject);
var
t: TDateTime;
begin
t := VpClock1.Time;
VpClock1.DisplayMode := TVpClockDisplayMode(RgDisplayMode.ItemIndex);
case VpClock1.DisplayMode of
dmAnalog:
CbNewClockFaceChange(nil);
dmDigital:
begin
VpClock1.Width := 136;
VpClock1.Height := 30;
end;
end;
CbMilitaryTime.Visible := VpClock1.DisplayMode = dmDigital;
CbNewClockface.Visible := VpClock1.DisplayMode = dmAnalog;
VpClock1.Time := t;
end;
procedure TForm1.VpClock1CountdownDone(Sender: TObject);
begin
ShowMessage('Countdown completed.');
end;
end.

18
components/tvplanit/examples/navbar/unit1.lfm
View File

@@ -1,16 +1,16 @@
object Form1: TForm1
Left = 262
Height = 400
Height = 406
Top = 155
Width = 588
Width = 567
Caption = 'Form1'
ClientHeight = 400
ClientWidth = 588
ClientHeight = 406
ClientWidth = 567
OnCreate = FormCreate
LCLVersion = '1.7'
object VpNavBar1: TVpNavBar
Left = 0
Height = 370
Height = 376
Top = 0
Width = 128
ActiveFolder = 0
@@ -187,17 +187,17 @@ object Form1: TForm1
object Panel1: TPanel
Left = 0
Height = 30
Top = 370
Width = 588
Top = 376
Width = 567
Align = alBottom
ClientHeight = 30
ClientWidth = 588
ClientWidth = 567
TabOrder = 2
object Bevel1: TBevel
Left = 1
Height = 3
Top = 1
Width = 586
Width = 565
Align = alTop
Shape = bsTopLine
end

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

@@ -35,12 +35,12 @@ interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
LMessages, LCLProc, LCLType, LCLIntf, ExtCtrls,
{$ELSE}
Windows, Messages,
Windows, Messages, VpTimerPool,
{$ENDIF}
Classes, Controls, Dialogs, Forms, Graphics, Menus,Math,
SysUtils, VpBase, VpLEDLabel, VpTimerPool;
SysUtils, VpBase, VpLEDLabel;
type
TVpPercent = 0..100;
@@ -154,74 +154,86 @@ type
TVpCustomClock = class(TVpCustomControl)
protected {private}
FTimerPool : TVpTimerPool;
FActive : Boolean;
FClockMode : TVpClockMode;
FDigitalOptions : TVpDigitalOptions;
FDisplayMode : TVpClockDisplayMode;
FElapsedDays : Integer;
FElapsedHours : Integer;
FElapsedMinutes : LongInt;
FElapsedSeconds : LongInt;
FHandOptions : TVpHandOptions;
FTime : TDateTime;
FMilitaryTime : Boolean;
FStartTime : TDateTime;
FHourOffset : Integer; {Hours}
FMinuteOffset : Integer; {Minutes}
FSecondOffset : Integer; {Seconds}
{$IFDEF DELPHI}
FTimerPool: TVpTimerPool;
{$ELSE}
FTimer: TTimer;
{$ENDIF}
FActive: Boolean;
FClockMode: TVpClockMode;
FDigitalOptions: TVpDigitalOptions;
FDisplayMode: TVpClockDisplayMode;
FElapsedDays: Integer;
FElapsedHours: Integer;
FElapsedMinutes: LongInt;
FElapsedSeconds: LongInt;
FHandOptions: TVpHandOptions;
FTime: TDateTime;
FMilitaryTime: Boolean;
FCountdownStartTime: TDateTime;
FHourOffset: Integer; {Hours}
FMinuteOffset: Integer; {Minutes}
FSecondOffset: Integer; {Seconds}
{event variables}
FOnHourChange : TNotifyEvent;
FOnMinuteChange : TNotifyEvent;
FOnSecondChange : TNotifyEvent;
FOnHourChange: TNotifyEvent;
FOnMinuteChange: TNotifyEvent;
FOnSecondChange: TNotifyEvent;
FOnCountdownDone: TNotifyEvent;
{internal variables}
ckAnalogHeight : Integer;
ckAnalogWidth : Integer;
ckLEDDisplay : TVpLEDClockDisplay;
ckDraw : TBitMap;
ckClockHandle : Integer;
ckOldHour : Integer;
ckOldMinute : Integer;
ckOldSecond : Integer;
ckTimerTime : TDateTime;
ckDays : Integer;
ckHours : Integer;
ckMinutes : Integer;
ckSeconds : Integer;
ckTotalSeconds : Integer;
ckAnalogHeight: Integer;
ckAnalogWidth: Integer;
ckLEDDisplay: TVpLEDClockDisplay;
ckDraw: TBitMap;
{$IFDEF DELPHI}
ckClockHandle: Integer;
{$ELSE}
FTimeStarted: TDateTime; {time at which the timer is activated }
{$ENDIF}
ckOldHour: Integer;
ckOldMinute: Integer;
ckOldSecond: Integer;
ckTimerTime: TDateTime;
ckDays: Integer;
ckHours: Integer;
ckMinutes: Integer;
ckSeconds: Integer;
ckTotalSeconds: Integer;
{property methods}
function GetElapsedDays : Integer;
function GetElapsedHours : Integer;
function GetElapsedMinutes : LongInt;
function GetElapsedSeconds : LongInt;
function GetElapsedSecondsTotal : LongInt;
procedure SetActive(Value : Boolean);
procedure SetClockMode(Value : TVpClockMode);
function GetElapsedDays: Integer;
function GetElapsedHours: Integer;
function GetElapsedMinutes: LongInt;
function GetElapsedSeconds: LongInt;
function GetElapsedSecondsTotal: LongInt;
procedure SetActive(Value: Boolean);
procedure SetClockMode(Value: TVpClockMode);
procedure SetDisplayMode(Value: TVpClockDisplayMode);
procedure SetMinuteOffset(Value : Integer);
procedure SetHourOffset(Value : Integer);
procedure SetSecondOffset(Value : Integer);
procedure SetMinuteOffset(Value: Integer);
procedure SetHourOffset(Value: Integer);
procedure SetSecondOffset(Value: Integer);
{internal methods}
function ckConvertMsToDateTime(Value : LongInt) : TDateTime;
procedure ckHandOptionChange(Sender : TObject);
procedure ckDigitalOptionChange(Sender : TObject);
function ckConvertMsToDateTime(Value: LongInt): TDateTime;
procedure ckHandOptionChange(Sender: TObject);
procedure ckDigitalOptionChange(Sender: TObject);
procedure SizeDigitalDisplay;
{$IFDEF DELPHI}
procedure ckTimerEvent(Sender: TObject; Handle: Integer; Interval: Cardinal;
ElapsedTime: LongInt);
{$ELSE}
procedure ckTimerEvent(Sender: TObject);
{$ENDIF}
procedure DoOnHourChange;
procedure DoOnMinuteChange;
procedure DoOnSecondChange;
procedure DoOnCountdownDone;
procedure PaintHands(ACanvas : TCanvas);
procedure PaintHands(ACanvas: TCanvas);
{windows message methods}
{$IFDEF LCL}
procedure WMResize (var Msg: TLMSize); message LM_SIZE;
procedure WMEraseBkgnd (var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
procedure WMResize(var Msg: TLMSize); message LM_SIZE;
procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
{$ELSE}
procedure WMResize (var Msg: TWMSize); message WM_SIZE;
procedure WMEraseBkgnd (var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMGetDlgCode (var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMResize(var Msg: TWMSize); message WM_SIZE;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
{$ENDIF}
protected
procedure Loaded; override;
@@ -229,36 +241,33 @@ type
procedure PaintAnalog;
procedure PaintDigital;
{virtual property methods}
procedure SetTime(Value : TDateTime); virtual;
property Active : Boolean read FActive write SetActive;
property ClockMode : TVpClockMode read FClockMode write SetClockMode;
procedure SetTime(Value: TDateTime); virtual;
property Active: Boolean read FActive write SetActive;
property ClockMode: TVpClockMode read FClockMode write SetClockMode;
property DigitalOptions: TVpDigitalOptions
read FDigitalOptions write FDigitalOptions;
property AnalogOptions : TVpHandOptions
property AnalogOptions: TVpHandOptions
read FHandOptions write FHandOptions;
property MinuteOffset : Integer read FMinuteOffset write SetMinuteOffset;
property HourOffset : Integer read FHourOffset write SetHourOffset;
property MinuteOffset: Integer read FMinuteOffset write SetMinuteOffset;
property HourOffset: Integer read FHourOffset write SetHourOffset;
property SecondOffset: Integer read FSecondOffset write SetSecondOffset;
{events}
property OnHourChange : TNotifyEvent read FOnHourChange write FOnHourChange;
property OnMinuteChange : TNotifyEvent
read FOnMinuteChange write FOnMinuteChange;
property OnSecondChange : TNotifyEvent
read FOnSecondChange write FOnSecondChange;
property OnCountdownDone : TNotifyEvent
read FOnCountdownDone write FOnCountdownDone;
property OnHourChange: TNotifyEvent read FOnHourChange write FOnHourChange;
property OnMinuteChange: TNotifyEvent read FOnMinuteChange write FOnMinuteChange;
property OnSecondChange: TNotifyEvent read FOnSecondChange write FOnSecondChange;
property OnCountdownDone: TNotifyEvent read FOnCountdownDone write FOnCountdownDone;
public
constructor Create(AOwner : TComponent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer); override;
property DisplayMode: TVpClockDisplayMode
read FDisplayMode write SetDisplayMode;
property ElapsedDays : Integer read GetElapsedDays;
property ElapsedHours : Integer read GetElapsedHours;
property ElapsedMinutes : LongInt read GetElapsedMinutes;
property ElapsedSeconds : LongInt read GetElapsedSeconds;
property ElapsedSecondsTotal : LongInt read GetElapsedSecondsTotal;
property Time : TDateTime read FTime write SetTime;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property DisplayMode: TVpClockDisplayMode read FDisplayMode write SetDisplayMode;
property ElapsedDays: Integer read GetElapsedDays;
property ElapsedHours: Integer read GetElapsedHours;
property ElapsedMinutes: LongInt read GetElapsedMinutes;
property ElapsedSeconds: LongInt read GetElapsedSeconds;
property ElapsedSecondsTotal: LongInt read GetElapsedSecondsTotal;
property Time: TDateTime read FTime write SetTime;
end;
TVpClock = class(TVpCustomClock)
@@ -393,7 +402,6 @@ end;
constructor TVpHandOptions.Create;
begin
inherited;
FClockFace := TBitMap.Create;
FDrawMarks := True;
end;
@@ -403,12 +411,11 @@ destructor TVpHandOptions.Destroy;
begin
FClockFace.Free;
FClockFace := nil;
inherited;
end;
{=====}
procedure TVpHandOptions.Assign(Source : TPersistent);
procedure TVpHandOptions.Assign(Source: TPersistent);
begin
if Source is TVpHandOptions then begin
FHourHandColor := TVpHandOptions(Source).FHourHandColor;
@@ -428,7 +435,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetClockFace(Value : TBitMap);
procedure TVpHandOptions.SetClockFace(Value: TBitMap);
begin
if Assigned(Value) then
FClockFace.Assign(Value)
@@ -440,7 +447,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetDrawMarks(Value : Boolean);
procedure TVpHandOptions.SetDrawMarks(Value: Boolean);
begin
if Value <> FDrawMarks then begin
FDrawMarks := Value;
@@ -456,7 +463,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetHourHandColor(Value : TColor);
procedure TVpHandOptions.SetHourHandColor(Value: TColor);
begin
if Value <> FHourHandColor then begin
FHourHandColor := Value;
@@ -465,7 +472,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetHourHandLength(Value : TVpPercent);
procedure TVpHandOptions.SetHourHandLength(Value: TVpPercent);
begin
if Value <> FHourHandLength then begin
FHourHandLength := Value;
@@ -474,7 +481,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetHourHandWidth(Value : Integer);
procedure TVpHandOptions.SetHourHandWidth(Value: Integer);
begin
if (Value <> FHourHandWidth) and (Value > 0) then begin
FHourHandWidth := Value;
@@ -483,7 +490,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetMinuteHandColor(Value : TColor);
procedure TVpHandOptions.SetMinuteHandColor(Value: TColor);
begin
if Value <> FMinuteHandColor then begin
FMinuteHandColor := Value;
@@ -492,7 +499,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetMinuteHandLength(Value : TVpPercent);
procedure TVpHandOptions.SetMinuteHandLength(Value: TVpPercent);
begin
if Value <> FMinuteHandLength then begin
FMinuteHandLength := Value;
@@ -501,7 +508,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetMinuteHandWidth(Value : Integer);
procedure TVpHandOptions.SetMinuteHandWidth(Value: Integer);
begin
if (Value <> FMinuteHandWidth) and (Value > 0) then begin
FMinuteHandWidth := Value;
@@ -510,7 +517,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetSecondHandColor(Value : TColor);
procedure TVpHandOptions.SetSecondHandColor(Value: TColor);
begin
if Value <> FSecondHandColor then begin
FSecondHandColor := Value;
@@ -519,7 +526,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetSecondHandLength(Value : TVpPercent);
procedure TVpHandOptions.SetSecondHandLength(Value: TVpPercent);
begin
if Value <> FSecondHandLength then begin
FSecondHandLength := Value;
@@ -528,7 +535,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetSecondHandWidth(Value : Integer);
procedure TVpHandOptions.SetSecondHandWidth(Value: Integer);
begin
if (Value <> FSecondHandWidth) and (Value > 0) then begin
FSecondHandWidth := Value;
@@ -537,7 +544,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetShowSecondHand(Value : Boolean);
procedure TVpHandOptions.SetShowSecondHand(Value: Boolean);
begin
if Value <> FShowSecondHand then begin
FShowSecondHand := Value;
@@ -546,7 +553,7 @@ begin
end;
{=====}
procedure TVpHandOptions.SetSolidHands(Value : Boolean);
procedure TVpHandOptions.SetSolidHands(Value: Boolean);
begin
if Value <> FSolidHands then begin
FSolidHands := Value;
@@ -556,7 +563,7 @@ end;
{===== TOvcCustomClock ===============================================}
constructor TVpCustomClock.Create(AOwner : TComponent);
constructor TVpCustomClock.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -565,7 +572,11 @@ begin
FClockMode := cmClock;
{$IFDEF DELPHI}
FTimerPool := TVpTimerPool.Create(self);
{$ELSE}
FTimer := TTimer.Create(self);
{$ENDIF}
FHandOptions := TVpHandOptions.Create;
FHandOptions.OnChange := ckHandOptionChange;
@@ -588,7 +599,11 @@ begin
ckDraw.Width := Width;
ckDraw.Height := Height;
{$IFDEF DELPHI}
ckClockHandle := -1;
{$ELSE}
FTimer.Enabled := false;
{$ENDIF}
end;
{=====}
@@ -608,10 +623,10 @@ begin
end;
{=====}
function TVpCustomClock.ckConvertMsToDateTime(Value : LongInt) : TDateTime;
function TVpCustomClock.ckConvertMsToDateTime(Value: LongInt) : TDateTime;
var
S, Days : LongInt;
Hour, Minute, Second : Word;
S, Days: LongInt;
Hour, Minute, Second: Word;
begin
S := Value div 1000;
Days := S div SecondsInDay;
@@ -624,14 +639,14 @@ begin
end;
{=====}
procedure TVpCustomClock.ckHandOptionChange(Sender : TObject);
procedure TVpCustomClock.ckHandOptionChange(Sender: TObject);
begin
if FDisplayMode = dmAnalog then
Invalidate;
end;
{=====}
procedure TVpCustomClock.ckDigitalOptionChange(Sender : TObject);
procedure TVpCustomClock.ckDigitalOptionChange(Sender: TObject);
begin
if FDisplayMode = dmDigital then begin
ckLEDDisplay.Size := FDigitalOptions.Size;
@@ -660,6 +675,7 @@ begin
end;
{=====}
{$IFDEF DELPHI}
procedure TVpCustomClock.ckTimerEvent(Sender: TObject; Handle: Integer;
Interval: Cardinal; ElapsedTime: LongInt);
var
@@ -694,6 +710,35 @@ begin
SetTime(FStartTime - ckConvertMsToDateTime(ElapsedTime));
end;
end;
{$ELSE}
procedure TVpCustomClock.ckTimerEvent(Sender: TObject);
var
Hour, Minute, Second, MSecond: Word;
C, D: Integer;
elapsed: TDateTime;
begin
elapsed := now - FTimeStarted;
case FClockMode of
cmClock:
begin { Clock }
DecodeTime(Now, Hour, Minute, Second, MSecond);
D := Minute + FMinuteOffset;
Minute := Abs(D mod 60);
C := Hour + FHourOffset + D div 60;
if C > 23 then
Dec(C, 24);
if C < 0 then
Inc(C, 24);
Hour := C;
SetTime(EncodeTime(Hour, Minute, Second, MSecond));
end;
cmTimer: { Count-up timer }
SetTime(elapsed);
cmCountDownTimer: { Count-down timer }
SetTime(FCountdownStartTime - elapsed);
end;
end;
{$ENDIF}
{=====}
procedure TVpCustomClock.DoOnHourChange;
@@ -728,70 +773,97 @@ function TVpCustomClock.GetElapsedDays: Integer;
var
ClockDate : TDateTime;
begin
{$IFDEF DELPHI}
if ckClockHandle > -1 then begin
ClockDate := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]);
ckDays := Trunc(ClockDate);
end;
{$ELSE}
if FTimer.Enabled then begin
ClockDate := now - FTimeStarted;
ckDays := Trunc(ClockDate);
end;
{$ENDIF}
Result := ckDays;
end;
{=====}
function TVpCustomClock.GetElapsedHours: Integer;
var
Hour : Word;
Min : Word;
Sec : Word;
MSec : Word;
Hour, Min, Sec, MSec: Word;
TempTime : TDateTime;
begin
Result := 0;
{$IFDEF DELPHI}
if ckClockHandle > -1 then begin
TempTime := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]);
DecodeTime(TempTime, Hour, Min, Sec, MSec);
ckHours := Hour
Result := Hour;
end;
Result := ckHours;
{$ELSE}
if FTimer.Enabled then begin
Temptime := now - FTimeStarted;
DecodeTime(TempTime, Hour, Min, Sec, MSec);
Result := Hour;
end;
{$ENDIF}
end;
{=====}
function TVpCustomClock.GetElapsedMinutes: LongInt;
var
Hour : Word;
Min : Word;
Sec : Word;
MSec : Word;
Hour, Min, Sec, MSec: Word;
TempTime : TDateTime;
begin
Result := 0;
{$IFDEF DELPHI}
if ckClockHandle > -1 then begin
TempTime := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]);
DecodeTime(TempTime, Hour, Min, Sec, MSec);
ckMinutes := Min;
Result := Min;
end;
Result := ckMinutes;
{$ELSE}
if FTimer.Enabled then begin
TempTime := now - FTimeStarted;
DecodeTime(TempTime, Hour, Min, Sec, MSec);
Result := Min;
end;
{$ENDIF}
end;
{=====}
function TVpCustomClock.GetElapsedSeconds : LongInt;
var
Hour : Word;
Min : Word;
Sec : Word;
MSec : Word;
Hour, Min, Sec, MSec: Word;
TempTime : TDateTime;
begin
Result := 0;
{$IFDEF DELPHI}
if ckClockHandle > -1 then begin
TempTime := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]);
DecodeTime(TempTime, Hour, Min, Sec, MSec);
ckSeconds := Sec;
Result := Sec;
end;
Result := ckSeconds;
{$ELSE}
if FTimer.Enabled then begin
TempTime := now - FTimeStarted;
DecodeTime(TempTime, Hour, Min, Sec, MSec);
Result := Sec;
end;
{$ENDIF}
end;
{=====}
function TVpCustomClock.GetElapsedSecondsTotal : LongInt;
begin
Result := 0;
{$IFDEF DELPHI}
if ckClockHandle > -1 then
ckTotalSeconds := FTimerPool.ElapsedTime[ckClockHandle] div 1000;
Result := ckTotalSeconds;
Result := FTimerPool.ElapsedTime[ckClockHandle] div 1000;
{$ELSE}
if FTimer.Enabled then
Result := Round((now - FTimeStarted) * SecondsInDay);
{$ENDIF}
end;
{=====}
@@ -836,9 +908,8 @@ var
ElRgn : HRgn;
R : TRect;
procedure DrawTickMark(MarkX, MarkY : Integer;
LColor, MColor, RColor : TColor;
FiveMinute : Boolean);
procedure DrawTickMark(MarkX, MarkY: Integer; LColor, MColor, RColor: TColor;
FiveMinute: Boolean);
begin
with ckDraw.Canvas do begin
Pixels[MarkX, MarkY] := MColor;
@@ -875,7 +946,7 @@ begin
finally
DeleteObject(ElRgn);
end;
SelectClipRgn(ckDraw.Canvas.Handle, 0);{remove clipping region}
SelectClipRgn(ckDraw.Canvas.Handle, 0); {remove clipping region}
end;
{draw marks}
@@ -909,7 +980,7 @@ begin
end;
{=====}
procedure TVpCustomClock.PaintHands(ACanvas : TCanvas);
procedure TVpCustomClock.PaintHands(ACanvas: TCanvas);
type
HandType = (HourHand, MinuteHand, SecondHand);
var
@@ -940,10 +1011,8 @@ var
NewPoint.Y := NewPoint.Y + HalfHeight;
end;
procedure DrawNewHand(PenColor : TColor;
Hand : HandType;
HandLength : Integer;
HipWidth : Integer);
procedure DrawNewHand(PenColor: TColor; Hand: HandType;
HandLength, HipWidth: Integer);
const
MaxPoints = 7;
var
@@ -956,7 +1025,7 @@ var
Var
CPoints : array[1..3] of TPoint;
procedure LoadPoints(Pt1, Pt2, Pt3 : Integer);
procedure LoadPoints(Pt1, Pt2, Pt3: Integer);
begin
CPoints[1] := HandPoints[Pt1];
CPoints[2] := HandPoints[Pt2];
@@ -967,71 +1036,78 @@ var
begin
ACanvas.Brush.Color := clWhite;
case Hand of
HourHand : begin
HourHand:
case Hour of
0..3,
12..15 : begin
0..3, 12..15:
begin
LoadPoints(2,3,4);
LoadPoints(1,2,4);
end;
4..5,
16..17 : begin
4..5, 16..17:
begin
LoadPoints(1,2,4);
LoadPoints(1,2,6);
end;
6..9,
18..21 : begin
6..9, 18..21:
begin
LoadPoints(1,2,6);
LoadPoints(2,3,6);
end;
10..11,
22..23 : begin
10..11, 22..23:
begin
LoadPoints(2,3,4);
LoadPoints(2,3,6);
end;
end;
end;
MinuteHand: begin
MinuteHand:
case Minute of
0..15 : begin
0..15:
begin
LoadPoints(2,3,4);
LoadPoints(1,2,4);
end;
16..25: begin
16..25:
begin
LoadPoints(1,2,4);
LoadPoints(1,2,6);
end;
26..50: begin
26..50:
begin
LoadPoints(1,2,6);
LoadPoints(2,3,6);
end;
51..59: begin
51..59:
begin
LoadPoints(2,3,4);
LoadPoints(2,3,6);
end;
end;
end;
SecondHand: begin
SecondHand:
case Second of
0..15 : begin
0..15:
begin
LoadPoints(2,3,4);
LoadPoints(1,2,4);
end;
16..25: begin
16..25:
begin
LoadPoints(1,2,4);
LoadPoints(1,2,6);
end;
26..50: begin
26..50:
begin
LoadPoints(1,2,6);
LoadPoints(2,3,6);
end;
51..59: begin
51..59:
begin
LoadPoints(2,3,4);
LoadPoints(2,3,6);
end;
end;
end;
end;
end; // case Hand of...
ACanvas.Brush.Color := Color;
end;
@@ -1124,7 +1200,7 @@ begin
end;
{=====}
procedure TVpCustomClock.SetActive(Value : Boolean);
procedure TVpCustomClock.SetActive(Value: Boolean);
begin
if csLoading in ComponentState then begin
FActive := Value;
@@ -1136,26 +1212,40 @@ begin
if FActive then begin
if FDisplayMode = dmDigital then
FMilitaryTime := DigitalOptions.MilitaryTime;
{$IFDEF DELPHI}
if ckClockHandle = -1 then
ckClockHandle := FTimerPool.Add(ckTimerEvent, ckInterval);
if FClockMode = cmClock then
FTime := Now
else if FClockMode = cmCountdownTimer then
FStartTime := EncodeTime(FHourOffset, FMinuteOffset,
FSecondOffset, 0)
else
{$ELSE}
FTimeStarted := now;
FTimer.Interval := ckInterval;
FTimer.Enabled := FActive;
FTimer.OnTimer := ckTimerEvent;
{$ENDIF}
case FClockMode of
cmClock:
FTime := Now;
cmTimer:
FTime := 0;
end else if ckClockHandle > -1 then begin
cmCountdownTimer:
FCountdownStartTime := EncodeTime(FHourOffset, FMinuteOffset, FSecondOffset, 0);
end;
end
else
{$IFDEF DELPHI}
if ckClockHandle > -1 then begin
FTimerPool.Remove(ckClockHandle);
ckClockHandle := -1;
end;
{$ELSE}
if FTimer.Enabled then
FTimer.Enabled := false;
{$ENDIF}
Invalidate;
end;
end;
{=====}
procedure TVpCustomClock.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
procedure TVpCustomClock.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
@@ -1168,7 +1258,7 @@ begin
end;
{=====}
procedure TVpCustomClock.SetClockMode(Value : TVpClockMode);
procedure TVpCustomClock.SetClockMode(Value: TVpClockMode);
begin
if Value <> FClockMode then begin
if FActive then Active := false;
@@ -1222,22 +1312,34 @@ begin
{Initialize the LED display}
if FActive then begin
if FClockMode = cmClock then
{Clock}
SetTime(Now)
else if FClockMode = cmTimer then
{Timer}
SetTime(ckConvertMsToDateTime(FElapsedSeconds * 1000))
else
{Countdown Timer}
if (FStartTime - ckConvertMsToDateTime(
FElapsedSeconds * 1000) <= 0) then
case FClockMode of
cmClock:
SetTime(Now);
cmTimer:
{$IFDEF DELPHI}
SetTime(ckConvertMsToDateTime(FElapsedSeconds * 1000));
{$ELSE}
SetTime(Now - FTimeStarted);
{$ENDIF}
cmCountdownTimer:
{$IFDEF DELPHI}
if (FStartTime - ckConvertMsToDateTime(FElapsedSeconds * 1000) <= 0) then
begin
SetTime(0);
Active := false;
DoOnCountdownDone;
end else
SetTime(FStartTime - ckConvertMsToDateTime(FElapsedSeconds * 1000));
{$ELSE}
if (FCountdownStartTime - (now - FTimeStarted) <= 0) then
begin
SetTime(0);
Active := false;
DoOnCountdownDone;
end else
SetTime(FCountdownStartTime - (now - FTimeStarted));
{$ENDIF}
end;
end;
end;
@@ -1275,15 +1377,16 @@ begin
end;
{=====}
procedure TVpCustomClock.SetTime(Value : TDateTime);
procedure TVpCustomClock.SetTime(Value: TDateTime);
var
Hour1, Minute1, Second1 : Word;
Hour2, Minute2, Second2 : Word;
MSecond : Word;
Hour1, Minute1, Second1: Word;
Hour2, Minute2, Second2: Word;
MSecond: Word;
TimeStr: string;
begin
DecodeTime(Value, Hour1, Minute1, Second1, MSecond);
DecodeTime(FTime, Hour2, Minute2, Second2, MSecond);
if (Hour1 <> Hour2) or (Minute1 <> Minute2) or (Second1 <> Second2) then begin
FTime := Value;
@@ -1300,11 +1403,14 @@ begin
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
else
if FDigitalOptions.ShowSeconds and not FMilitaryTime then
TimeStr := FormatDateTime('hh:nn:ss am/pm', FTime)
else if not FDigitalOptions.ShowSeconds and FMilitaryTime then
else
if not FDigitalOptions.ShowSeconds and FMilitaryTime then
TimeStr := FormatDateTime('hh:nn', FTime)
else if not FDigitalOptions.ShowSeconds and not FMilitaryTime then
else
if not FDigitalOptions.ShowSeconds and not FMilitaryTime then
TimeStr := FormatDateTime('hh:nn am/pm', FTime);
ckLEDDisplay.Caption := TimeStr;
end;
@@ -1314,7 +1420,7 @@ begin
end;
{=====}
procedure TVpCustomClock.SetMinuteOffset(Value : Integer);
procedure TVpCustomClock.SetMinuteOffset(Value: Integer);
begin
if (Value <> FMinuteOffset) and (Abs(Value) <= 60) then begin
FMinuteOffset := Value;
@@ -1325,7 +1431,7 @@ begin
end;
{=====}
procedure TVpCustomClock.SetHourOffset(Value : Integer);
procedure TVpCustomClock.SetHourOffset(Value: Integer);
begin
if (Value <> FHourOffset) and (Abs(Value) <= 24) then begin
FHourOffset := Value;
@@ -1336,7 +1442,7 @@ begin
end;
{=====}
procedure TVpCustomClock.SetSecondOffset(Value : Integer);
procedure TVpCustomClock.SetSecondOffset(Value: Integer);
begin
if (Value <> FSecondOffset) and (Abs(Value) <= 59) then begin
FSecondOffset := Value;
@@ -1363,9 +1469,9 @@ begin
end;
{$IFNDEF LCL}
procedure TVpCustomClock.WMEraseBkgnd(var Msg : TWMEraseBkGnd);
procedure TVpCustomClock.WMEraseBkgnd(var Msg: TWMEraseBkGnd);
{$ELSE}
procedure TVpCustomClock.WMEraseBkgnd(var Msg : TLMEraseBkGnd);
procedure TVpCustomClock.WMEraseBkgnd(var Msg: TLMEraseBkGnd);
{$ENDIF}
begin
Msg.Result := 1;
@@ -1373,7 +1479,7 @@ end;
{=====}
{$IFNDEF LCL}
procedure TVpCustomClock.WMGetDlgCode(var Msg : TWMGetDlgCode);
procedure TVpCustomClock.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
{tell windows we are a static control to avoid receiving the focus}
Msg.Result := DLGC_STATIC;

12
components/tvplanit/source/vptimerpool.pas
View File

@@ -169,7 +169,11 @@ begin
tpList := TList.Create;
{allocate a window handle for the timer}
//TODO: tpHandle := {$IFDEF VERSION6}Classes.{$ENDIF}AllocateHWnd(tpTimerWndProc);
{$IFDEF DELPHI}
tpHandle := {$IFDEF VERSION6}Classes.{$ENDIF}AllocateHWnd(tpTimerWndProc);
{$ELSE}
// ToDo: tpHandle := AllocateHWnd(tpTimerWndProc);
{$ENDIF}
end;
destructor TVpTimerPool.Destroy;
@@ -189,7 +193,11 @@ begin
tpList := nil;
{deallocate our window handle}
//TODO: {$IFDEF VERSION6}Classes.{$ENDIF}DeallocateHWnd(tpHandle);
{$IFDEF DELPHI}
{$IFDEF VERSION6}Classes.{$ENDIF}DeallocateHWnd(tpHandle);
{$ELSE}
// ToDo: DeallocateHWnd(tpHandle);
{$ENDIF}
inherited Destroy;
end;