tutorials/lazarus-tutorials
1
0
Fork 0
Code Releases Activity

Add test dateform example

Browse Source
This commit is contained in:
Timothy Warren 2021-10-14 15:21:08 -04:00
parent 39728691b3
commit 09eac57f84
7 changed files with 327 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
test_dateform/dateform.lfm Normal file
View File

@ -0,0 +1,81 @@
object dForm: TdForm
Left = 418
Height = 180
Top = 276
Width = 220
Caption = 'Date entry'
ClientHeight = 180
ClientWidth = 220
LCLVersion = '2.0.12.0'
object ButtonPanel1: TButtonPanel
Left = 6
Height = 34
Top = 140
Width = 208
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
ButtonOrder = boCloseCancelOK
TabOrder = 3
ShowButtons = [pbOK, pbCancel]
end
object seDay: TSpinEdit
Left = 120
Height = 21
Top = 12
Width = 50
MaxValue = 31
MinValue = 1
TabOrder = 0
Value = 1
end
object seMonth: TSpinEdit
Left = 120
Height = 21
Top = 56
Width = 50
MaxValue = 12
MinValue = 1
TabOrder = 1
Value = 1
end
object seYear: TSpinEdit
Left = 105
Height = 21
Top = 96
Width = 65
MaxValue = 9999
MinValue = 1
TabOrder = 2
Value = 1
end
object LDay: TLabel
Left = 45
Height = 16
Top = 20
Width = 23
Caption = 'Day'
ParentColor = False
end
object LMonth: TLabel
Left = 45
Height = 16
Top = 60
Width = 39
Caption = 'Month'
ParentColor = False
end
object LYear: TLabel
Left = 45
Height = 16
Top = 100
Width = 27
Caption = 'Year'
ParentColor = False
end
end

73
test_dateform/dateform.pas Normal file
View File

@ -0,0 +1,73 @@
unit dateform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ButtonPanel, Spin,
StdCtrls, dateUtils;
type
TDForm = class(TForm)
ButtonPanel1: TButtonPanel;
LDay: TLabel;
LMonth: TLabel;
LYear: TLabel;
seYear: TSpinEdit;
seDay: TSpinEdit;
seMonth: TSpinEdit;
private
public
end;
function GetDate(var dt: TDateTime): boolean;
var
dForm: TDForm;
implementation
function GetDate(var dt: TDateTime): boolean;
var
frm: TDForm;
d, m, y: word;
begin
frm := TDForm.Create(nil);
try
if dt = 0
then dt := Now;
DecodeDate(dt, y, m, d);
frm.seYear.Value := y;
frm.seMonth.Value := m;
frm.seDay.Value := d;
if (frm.ShowModal = mrOK) then
begin
y := frm.seYear.Value;
m := frm.seMonth.Value;
d := frm.seDay.Value;
case IsValidDate(y, m, d) of
False: Result := False;
else
dt := EncodeDate(y, m, d);
Result := True;
end;
end
else Result := False;
finally
frm.Free;
end;
end;
{$R *.lfm}
{ TDForm }
end.

20
test_dateform/maintest.lfm Normal file
View File

@ -0,0 +1,20 @@
object Form1: TForm1
Left = 361
Height = 240
Top = 125
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
LCLVersion = '2.0.12.0'
object Button1: TButton
Left = 0
Height = 240
Top = 0
Width = 320
Align = alClient
Caption = 'Button1'
OnClick = Button1Click
TabOrder = 0
end
end

45
test_dateform/maintest.pas Normal file
View File

@ -0,0 +1,45 @@
unit maintest;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, dateform;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var d: TDateTime = 0;
begin
if GetDate(d) then
ShowMessageFmt(
'The date obtained via GetDate() was %s',
[FormatDateTime('dd/mm/yyyy', d)]
)
else
ShowMessage('The date entry dialog was cancelled or an invalid date was entered');
end;
end.

BIN
test_dateform/test_dateform.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

85
test_dateform/test_dateform.lpi Normal file
View File

@ -0,0 +1,85 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="test_dateform"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="test_dateform.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="maintest.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="dateform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="dForm"/>
<ResourceBaseClass Value="Form"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="test_dateform"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2"/>
</Debugging>
<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>

23
test_dateform/test_dateform.lpr Normal file
View File

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