examples: add example to demonstrate the usage of dbedit with mask

git-svn-id: trunk@25270 -
This commit is contained in:
blikblum 2010-05-09 02:43:40 +00:00
parent 5a4825f660
commit 760240d5c9
5 changed files with 372 additions and 0 deletions

4
.gitattributes vendored
View File

@ -2801,6 +2801,10 @@ examples/database/dblookup/readme.txt svneol=native#text/plain
examples/database/dblookup/unit1.lfm svneol=native#text/plain
examples/database/dblookup/unit1.lrs svneol=native#text/pascal
examples/database/dblookup/unit1.pas svneol=native#text/plain
examples/dbeditmask/Unit1.lfm svneol=native#text/plain
examples/dbeditmask/Unit1.pas svneol=native#text/plain
examples/dbeditmask/project1.lpi svneol=native#text/plain
examples/dbeditmask/project1.lpr svneol=native#text/plain
examples/designerbaseclass/README.txt svneol=native#text/plain
examples/designerbaseclass/customcomponentclass.pas svneol=native#text/plain
examples/designerbaseclass/designbaseclassdemopkg.lpk svneol=native#text/plain

View File

@ -0,0 +1,147 @@
object Form1: TForm1
Left = 363
Height = 443
Top = 307
Width = 513
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Test DBEdit with mask'
ClientHeight = 443
ClientWidth = 513
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '0.9.29'
object Label3: TLabel
Left = 8
Height = 14
Top = 16
Width = 164
Caption = 'ADate Field - Mask: !99/99/00;1;_'
ParentColor = False
end
object DBGrid1: TDBGrid
Left = 8
Height = 273
Top = 112
Width = 497
Columns = <
item
Width = 180
FieldName = 'ADATE'
end
item
Width = 100
FieldName = 'ASTR'
end
item
Width = 100
FieldName = 'AINT'
end>
DataSource = DataSource1
TabOrder = 0
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
end
object DBNavigator1: TDBNavigator
Left = 8
Height = 42
Top = 392
Width = 497
BevelOuter = bvNone
ClientHeight = 42
ClientWidth = 497
DataSource = DataSource1
TabOrder = 1
end
object DBEdit1: TDBEdit
Left = 8
Height = 21
Top = 32
Width = 246
DataField = 'ADate'
DataSource = DataSource1
CharCase = ecNormal
EditMask = '!99/99/00;1;_'
MaxLength = 0
TabOrder = 2
end
object ShowLongDateCheckBox: TCheckBox
Left = 270
Height = 17
Top = 34
Width = 90
Caption = 'Show Full Date'
OnChange = ShowLongDateCheckBoxChange
TabOrder = 3
end
object DBEdit2: TDBEdit
Left = 8
Height = 21
Top = 80
Width = 246
DataField = 'AINT'
DataSource = DataSource1
CharCase = ecNormal
EditMask = '!99;1;_'
MaxLength = 0
TabOrder = 4
end
object Label1: TLabel
Left = 8
Height = 14
Top = 64
Width = 45
Caption = 'AInt Field'
ParentColor = False
end
object DataSource1: TDatasource
DataSet = Dbf1
left = 400
top = 288
end
object Dbf1: TDbf
FilePath = 'D:\repositories\lazarus\examples\dbeditmask\'
IndexDefs = <>
TableName = 'test.db'
TableLevel = 4
Active = True
FilterOptions = []
left = 312
top = 288
object Dbf1ASTR: TStringField
DisplayWidth = 50
FieldKind = fkData
FieldName = 'ASTR'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 50
end
object Dbf1ADATE: TDateField
DisplayWidth = 10
FieldKind = fkData
FieldName = 'ADATE'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
OnSetText = Dbf1ADATESetText
end
object Dbf1AINT: TLargeintField
DisplayWidth = 10
FieldKind = fkData
FieldName = 'AINT'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
OnGetText = Dbf1AINTGetText
end
end
end

View File

@ -0,0 +1,120 @@
unit Unit1;
{$MODE ObjFpc}
{$H+}
interface
uses
LCLIntf, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DBCtrls, ExtCtrls, DBGrids, DB, dbf, FileUtil, LResources;
type
{ TForm1 }
TForm1 = class(TForm)
DBEdit2: TDBEdit;
Dbf1ADATE: TDateField;
Dbf1AINT: TLargeintField;
Dbf1ASTR: TStringField;
Label1: TLabel;
ShowLongDateCheckBox: TCheckBox;
DataSource1: TDataSource;
ClientDataSet1ADate: TDateField;
ClientDataSet1AStr: TStringField;
ClientDataSet1AInt: TLargeintField;
Dbf1: TDbf;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
DBEdit1: TDBEdit;
Label3: TLabel;
procedure Dbf1ADATESetText(Sender: TField; const aText: string);
procedure Dbf1AINTGetText(Sender: TField; var aText: string;
DisplayText: Boolean);
procedure FormCreate(Sender: TObject);
procedure ShowLongDateCheckBoxChange(Sender: TObject);
private
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
strutils;
procedure TForm1.FormCreate(Sender: TObject);
begin
ShortDateFormat := 'd/M/yyyy';
if not FileExistsUTF8(Dbf1.TableName) then
begin
Dbf1.FieldDefs.Clear;
Dbf1.FieldDefs.Add('ADate', ftDate);
Dbf1.FieldDefs.Add('AStr', ftString, 50);
Dbf1.FieldDefs.Add('AInt', ftLargeint);
Dbf1.CreateTable;
//add some data
Dbf1.Open;
Dbf1.Append;
Dbf1.FieldByName('ADate').AsString := '12/09/2003';
Dbf1.Post;
Dbf1.Append;
Dbf1.FieldByName('AInt').AsInteger := 1;
Dbf1.Post;
Dbf1.Append;
Dbf1.FieldByName('ADate').AsString := '12/12/1090';
Dbf1.FieldByName('AInt').AsInteger := 30;
Dbf1.Post;
end
else
Dbf1.Open;
end;
procedure TForm1.Dbf1AINTGetText(Sender: TField; var aText: string;
DisplayText: Boolean);
begin
if DisplayText then
begin
if Sender.IsNull then
aText := '(Undefined)'
else if Sender.AsInteger = 0 then
aText := 'No Item'
else if Sender.AsInteger = 1 then
aText := 'Only One Item'
else if Sender.AsInteger < 10 then
aText := 'Few Itens'
else
aText := 'Many Itens';
end
else
aText := Sender.AsString;
end;
procedure TForm1.Dbf1ADATESetText(Sender: TField; const aText: string);
var
FixedStr: String;
begin
//workaround to fpc bug 15039
FixedStr := AnsiReplaceStr(aText, ' ', '');
Sender.AsString := FixedStr;
end;
procedure TForm1.ShowLongDateCheckBoxChange(Sender: TObject);
var
DateField: TDateTimeField;
begin
DateField := Dbf1.FieldByName('ADate') as TDateTimeField;
if ShowLongDateCheckBox.Checked then
DateField.DisplayFormat := LongDateFormat
else
DateField.DisplayFormat := '';
end;
initialization
{$i unit1.lrs}
end.

View File

@ -0,0 +1,82 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<VersionInfo>
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="DBFLaz"/>
<MinVersion Minor="1" Release="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
</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="8"/>
<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>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

View File

@ -0,0 +1,19 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.