1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
unit Unit1;
{$MODE ObjFpc}
{$H+}
interface
uses
SysUtils, Forms, StdCtrls, DBCtrls, DBGrids, DB, dbf, LazFileUtils;
type
{ TForm1 }
TForm1 = class(TForm)
DBEdit1: TDBEdit;
IntEdit: TDBEdit;
Dbf1ADATE: TDateField;
Dbf1AINT: TLargeintField;
Dbf1ASTR: TStringField;
Label1: TLabel;
Label2: TLabel;
ShowLongDateCheckBox: TCheckBox;
DataSource1: TDataSource;
ClientDataSet1ADate: TDateField;
ClientDataSet1AStr: TStringField;
ClientDataSet1AInt: TLargeintField;
Dbf1: TDbf;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
DateEdit: 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
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
strutils;
procedure TForm1.FormCreate(Sender: TObject);
begin
DefaultFormatSettings.ShortDateFormat := 'd/m/yyyy';
DefaultFormatSettings.DateSeparator := '/';
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 := DefaultFormatSettings.LongDateFormat
else
DateField.DisplayFormat := '';
end;
end.
|
