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

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

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>

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.

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

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.

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

File diff suppressed because it is too large Load Diff

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;