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

First package with visual db controls, created

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1969 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jujibo
2011-09-19 11:25:08 +00:00
parent 7888b8f656
commit 210a9b2ddd
14 changed files with 1675 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/jujiboutils/changes.txt
View File

@ -5,5 +5,6 @@ JUJIBOUTILS
Version pre-1.0 Version pre-1.0
-------------------------------------------------- --------------------------------------------------
2011-09-19 First package: TJDBIntegerEdit, TJDBCurrencyEdit, TJDBDateEdit and example
2011-09-14 Add Non Database input controls example 2011-09-14 Add Non Database input controls example
2011-09-13 Initial commit to lazarus-ccr 2011-09-13 Initial commit to lazarus-ccr

157
components/jujiboutils/jujibo-utils/example1/main.lfm Normal file
View File

@ -0,0 +1,157 @@
object Form1: TForm1
Left = 285
Height = 243
Top = 159
Width = 366
Caption = 'Form1'
ClientHeight = 243
ClientWidth = 366
OnCreate = FormCreate
LCLVersion = '0.9.31'
object Label1: TLabel
Left = 13
Height = 18
Top = 16
Width = 150
Caption = 'Testing jujibo db controls'
ParentColor = False
end
object DBNavigator1: TDBNavigator
Left = 21
Height = 25
Top = 96
Width = 241
BevelOuter = bvNone
ChildSizing.EnlargeHorizontal = crsScaleChilds
ChildSizing.EnlargeVertical = crsScaleChilds
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 100
ClientHeight = 25
ClientWidth = 241
DataSource = Datasource1
Options = []
TabOrder = 0
end
object Label2: TLabel
Left = 24
Height = 18
Top = 133
Width = 14
Caption = 'Id'
ParentColor = False
end
object Label3: TLabel
Left = 104
Height = 18
Top = 133
Width = 29
Caption = 'Date'
ParentColor = False
end
object Label4: TLabel
Left = 187
Height = 18
Top = 133
Width = 21
Caption = 'Id2'
ParentColor = False
end
object Label5: TLabel
Left = 272
Height = 18
Top = 133
Width = 30
Caption = 'Total'
ParentColor = False
end
object JDBIntegerEdit1: TJDBIntegerEdit
Left = 21
Height = 27
Top = 152
Width = 80
Alignment = taRightJustify
TabOrder = 1
DataField = 'ID'
DataSource = Datasource1
end
object JDBDateEdit1: TJDBDateEdit
Left = 104
Height = 27
Top = 152
Width = 80
TabOrder = 2
DataField = 'DATE'
DataSource = Datasource1
end
object JDBIntegerEdit2: TJDBIntegerEdit
Left = 187
Height = 27
Top = 152
Width = 80
Alignment = taRightJustify
TabOrder = 3
DataField = 'ID2'
DataSource = Datasource1
end
object JDBCurrencyEdit1: TJDBCurrencyEdit
Left = 270
Height = 27
Top = 152
Width = 80
Alignment = taRightJustify
TabOrder = 4
Text = '0,00 €'
DisplayFormat = '#,0.00 €'
DataField = 'TOTAL'
DataSource = Datasource1
Decimals = 2
end
object BitBtn1: TBitBtn
Left = 273
Height = 30
Top = 200
Width = 77
Anchors = [akRight, akBottom]
Caption = '&Cerrar'
Kind = bkClose
ModalResult = 11
TabOrder = 5
end
object Datasource1: TDatasource
DataSet = MemDataset1
left = 224
top = 8
end
object MemDataset1: TMemDataset
Active = True
FieldDefs = <
item
Name = 'ID'
DataType = ftInteger
Precision = 0
Size = 0
end
item
Name = 'DATE'
DataType = ftDate
Precision = 0
Size = 0
end
item
Name = 'TOTAL'
DataType = ftFloat
Precision = 0
Size = 0
end
item
Name = 'ID2'
DataType = ftInteger
Precision = 0
Size = 0
end>
left = 184
top = 8
end
end

64
components/jujiboutils/jujibo-utils/example1/main.pas Normal file
View File

@ -0,0 +1,64 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, db, memds, FileUtil, Forms, Controls, Graphics,
Dialogs, StdCtrls, DbCtrls, Buttons, jdbintegeredit, jdbdateedit,
jdbcurrencyedit;
type
{ TForm1 }
TForm1 = class(TForm)
BitBtn1: TBitBtn;
Datasource1: TDatasource;
DBNavigator1: TDBNavigator;
JDBCurrencyEdit1: TJDBCurrencyEdit;
JDBDateEdit1: TJDBDateEdit;
JDBIntegerEdit1: TJDBIntegerEdit;
JDBIntegerEdit2: TJDBIntegerEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
MemDataset1: TMemDataset;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
// populate the memDataset
for i := 1 to 10 do
begin
MemDataset1.Append;
MemDataset1.FieldByName('ID').AsInteger := i;
MemDataset1.FieldByName('DATE').AsDateTime := Now;
MemDataset1.FieldByName('ID2').AsInteger := i * i;
MemDataset1.FieldByName('TOTAL').AsFloat := i * i * i;
MemDataset1.Post;
end;
MemDataset1.First;
end;
end.

81
components/jujiboutils/jujibo-utils/example1/project1.lpi Normal file
View File

@ -0,0 +1,81 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<MainUnit Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)/example1/"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="jujibocontrols"/>
</Item1>
<Item2>
<PackageName Value="MemDSLaz"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="main"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<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>

22
components/jujiboutils/jujibo-utils/example1/project1.lpr Normal file
View File

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

52
components/jujiboutils/jujibo-utils/jujibocontrols.lpk Normal file
View File

@ -0,0 +1,52 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="4">
<Name Value="jujibocontrols"/>
<CompilerOptions>
<Version Value="10"/>
<SearchPaths>
<OtherUnitFiles Value="src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="4">
<Item1>
<Filename Value="src/jdbcurrencyedit.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="jdbcurrencyedit"/>
</Item1>
<Item2>
<Filename Value="src/jdbdateedit.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="jdbdateedit"/>
</Item2>
<Item3>
<Filename Value="src/jdbintegeredit.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="jdbintegeredit"/>
</Item3>
<Item4>
<Filename Value="src/jcontrolutils.pas"/>
<UnitName Value="jcontrolutils"/>
</Item4>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

24
components/jujiboutils/jujibo-utils/jujibocontrols.pas Normal file
View File

@ -0,0 +1,24 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit jujibocontrols;
interface
uses
jdbcurrencyedit, jdbdateedit, jdbintegeredit, jcontrolutils,
LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('jdbcurrencyedit', @jdbcurrencyedit.Register);
RegisterUnit('jdbdateedit', @jdbdateedit.Register);
RegisterUnit('jdbintegeredit', @jdbintegeredit.Register);
end;
initialization
RegisterPackage('jujibocontrols', @Register);
end.

29
components/jujiboutils/jujibo-utils/src/currencydbicon.lrs Normal file
View File

@ -0,0 +1,29 @@
LazarusResources.Add('TJDBCurrencyEdit','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#9#19#8
+'6'#30#134#145'!'#226#0#0#2#23'IDATH'#199#213#148#191'k'#19'a'#24#199'?o'#169
+#21'!'#180#182#160#130#208#128#129'b'#7#219#14'9'#16#9'8'#196#213#127'@;8T'
+#151'7'#131#184#164#131' ]'#28#226#160#22#188'S'#8#25':'#248'c'#21#234#152#14
+#154#226#146')'#22','#4#130#182#232'pBLJ'#10'IL'#242':'#180'w'#190'w'#151#132
+'&'#213#193#7'^'#238'}'#30#222#251'~'#238#251#240#220#11#255'8'#132#158#188
+'~'#255']'#165#215'K]'#15#222#185#30#225#198#213#243'b('#128'.'#188#154'X'
+#224'R8'#196#214'N'#13#187#210#192#174'6'#177'+'#13#222#230#190#13#5#26#5'H'
+#175#151#152#159#153#226#194#185'S'#216#149#6'['#224#17#183#171'M'#230'g'#166
+#168#213'['#244'r'#216#23#16#153#30#167'P,S('#194#217#211#17#0#143#248'~'#189
+'M'#161'X'#198'9'#187'1('#0'`'#182#246#10#128#15'o`;t'#147#141'G1'#226#201'M'
+#247#224#149#185'3'#236#215#219#212#234#173#193#29#140'}~'#129'iZn1'#145#128
+#213#175#11#216#149'Y'#143#19#128#210#238#222'@'#128#17')'#165#210#197#1'L'
+#211#226'yj'#217'S'#251#248#233#7#133'b'#153#200#244#248#224#14#18#9#233's '
+#1'x'#248'r'#251#239#180#200'4-WT'#207#239'/'#30#191'E'#163#186#168'?'#190
+#228#223#1#16':\'#140#192#220'EX'#204#172#169#163#136'/-'#221#18'BJ'#169#252
+#0#199#205#201#19#205#161#175#136#149#149#7'LL'#134'E'#223#22'=~'#154#30#26
+#176'W'#217'='#216'H)'#149'R'#4#214'A]'#169'x2'#167#244#136'''sn'#237'W'#171
+#237#201#163#209#168#251#172#254#220'Q.'#192#15#249'S'#11#2'tP'#167#211#241
+#228':'#196#1#244'mQ'#183'PJ!'#132#240#228'COQ/'#225'k'#203#155'dS1w'#15#184
+'y'#224'O'#214#167#198'?E'#158'{'#253'P'#220#255#245#217'T'#140'l*'#230#130#2
+#14','#203#18'RJ'#229#23'}'#242#204#236#250#130#254#245':'#172#231']'#4#16
+#141'^'#14#136#143#137#160#176#190'wrg'#159'M'#197'0'#12#131'|>'#143'a'#24
+#253#169#153#204#154#186'w'#247'v`j'#6#9'g'#138#186'ztg'#248#152'11'#25#22
+#252#247#241#27#224#191#193'Dc2"&'#0#0#0#0'IEND'#174'B`'#130
]);

26
components/jujiboutils/jujibo-utils/src/datedbicon.lrs Normal file
View File

@ -0,0 +1,26 @@
LazarusResources.Add('TJDBDateEdit','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#9#19#9
+#0'8'#220'B_]'#0#0#1#192'IDATH'#199#181'V=H'#195'@'#20#254#174#136'"'#168#20
+#7#197#161#6#11#221'D'#135'f'#171#191'uu'#169't'#16#4#135#162#147#136#186#168
+#208#185'P'#23#169'8'#138#5#133#130#131#16#4'W'#193#182#233#150#169't'#11#20
+#180#136#208#161#182'EA'#163#242#156'"I'#147#180'I'#180#15#30#151#187'w'#247
+'}w'#223'{'#199#133#17#17#186'i='#218#206'U'#254#153#206'n'#203#166#19'7'#151
+#253'X'#157#29'cN'#9#24#17#233#128'O'#182#166'19>'#128#210#227'+'#170#245#15
+'T'#27#10#170#245#15#220#136'O'#174#136#24#17'a'#233#160'@S'#129'aL'#140#246
+'c'#146#27#196#136#183'O'#7'^m(x{'#255#198#235#251#23#202#149'&'#238#142'B'
+#204#145'D~'#223#16#138'r'#13'E'#25#24#241#250#1#192#0'^'#148'kP'#231':'#150
+#232#240#240#244'O'#153'N&'#183'Y'#199'$'#239#238'F\'#129#167'R'#130#253'*'
+#178#179#192'lC'#217#156'H'#243's3'#204#22#129#219#147#216'>'#1#0'D'#18'2'#0
+'@'#136#7#12'c'#170'ic'#142#8'Z'#129#180#22']'#224#176#22#234'5'#141#165#211
+#151#134'B'#137#197#214#153#167'uP'#136#7#16']'#224'LA'#174#239#31',7P*'#230
+'u'#30']Y'#180#150#200#204'TI2'#5#5#145#132'l'#144#232'8u'#166#235'7'#235#21
+#0#128#199'.A'#166#160#180#141#243'<'#175'k'#219'&'#217'J'#30#128#179#140'K'
+#146#4#158#231'!I'#146#253'$k'#171'I'#136#7'L'#171#203'q'#21#181'['#236#4#216
+'@`'#247#6#187'"H&'#183'Y6''v'#231'i#"'#131#159#159'_'#208#222#206#6#17#17
+#133#247'E'#250#252#250#166#240#190#248#235#234#184#250'MD'#20#12#6'um'#227
+#229#145#136#168'3'#129'[S'#9#152#217#163#223#172'W'#254'E'#174'!'#175#143
+#177'n'#255'Ux'#208'e'#251#1#216#144'T='#167' '#26#22#0#0#0#0'IEND'#174'B`'
+#130
]);

28
components/jujiboutils/jujibo-utils/src/integerdbicon.lrs Normal file
View File

@ -0,0 +1,28 @@
LazarusResources.Add('TJDBIntegerEdit','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0'B'#0'v'#0#196#23#5#162#29#0#0#0
+#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#219#9#18#17#13#29
+#136'a`'#250#0#0#2#1'IDATH'#199#213'V'#177'K'#27'a'#20#255'}'#161'('#133'6'
+#30#213'$8'#164'b'#160'4'#208'h'#135#28#130#136'K'#178#149#254#1'B'#160'C'
+#168#147#131'tI'#6#161#184'8'#184'H'#11'n'#226#208'A'#218#181'PG'#151#154'P'
+#144#155#162'B!4'#168'!-\'#197'&'#209#130#134#220#253':'#148#239'z'#151'\'
+#196'K'#204#208#31'|'#188#239#193#227#253#238#253#222#187#199'''H'#162#159
+#184'cw>'#236#254#224#198#167#146'k'#224#252#243#8#230'fG'#133'W'#2'A'#210
+#145#248#237#194'S'#196#30#222#195#193#201#5#244#234#21#244'Z'#3'z'#245#10#31
+'s'#149#174#136#4'I$'#179'yN>z'#128#241#208']'#196#198#238'#'#168#12':'#146
+#235#181#6'~_'#26#184#184'l'#162'T'#174'cguFx'#146'('#18#246#163'P<C'#161#8#4
+#149#8#0#180'%/'#20#207' c'#187#234#193#244'D'#0#193#161#1't'#234#193#244'D'
+#192#170#194'3A'#169'\GH'#9#0#0#150'RQ$&'#135#219'z'#160#215#26#144#177#158#9
+'"a?'#246#14'Oa'#152'Dl,'#234#26#248'e'#255'go'#18'M='#25'Aph'#0'+[_'#177#178
+#245#31'I$Hb~}'#159#199#149's'#24'&'#177#148#138#226'H'#219#190#149#191'8'
+#157'~!\%J='#6#14#10#187'=%_^~'#253'O'#162#227#202'9B'#202#160'%'#209#145#246
+#13#0#176#246'f'#163'k'#130'z'#181#12#0#240#1'@'#250#217'8'#246#14'O'#173'u`'
+'G2'#155#183#172#188'7'#13#211#225#3#128#170#170#14'k'#129#164'u'#222#127#254
+#206'D&'#199#205#205'w|'#181#248#146'$'#153#200#228'hG"'#147#163'i'#154#14'_'
+'"'#30#143'['#247#218#175#19#146#252'['#129#196#220#236#168#232#180'gZ'#215
+#186#252'(O'#235#186#19'd'#162'd6'#143#157#213#25#135't'#210#239#137'@'#8#209
+'Fh'''#186#142#196'w'#211#169#176'''j%'#236#185#130#166'a'#182#201#210'*'#145
+#170#170#208'4'#205#178#174'S$'#143'}'#138#186#133#156'"'#225'6'#9#245'j'#249
+'V^'#2'~%,D'#191'_'#21'>'#244#25#127#0#156#234#169#234'iI'#212#232#0#0#0#0'I'
+'END'#174'B`'#130
]);

155
components/jujiboutils/jujibo-utils/src/jcontrolutils.pas Normal file
View File

@ -0,0 +1,155 @@
{ jcontrolutils
Copyright (C) 2011 Julio Jiménez Borreguero
Contact: jujibo at gmail dot com
This library is free software; you can redistribute it and/or modify it
under the same terms as the Lazarus Component Library (LCL)
See the file license-jujiboutils.txt and COPYING.LGPL, included in this distribution,
for details about the license.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
unit jcontrolutils;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Dialogs;
function CountChar(const s: string; ch: char): integer;
procedure Split(const Delimiter: char; Input: string; Strings: TStrings);
function NormalizeDate(const Value: string; theValue: TDateTime;
const theFormat: string = ''): string;
function NormalizeDateSeparator(const s: string): string;
function IsValidDateString(const Value: string): boolean;
implementation
function CountChar(const s: string; ch: char): integer;
var
i: integer;
begin
Result := 0;
for i := 1 to length(s) do
if s[i] = ch then
Inc(Result);
end;
procedure Split(const Delimiter: char; Input: string; Strings: TStrings);
begin
Assert(Assigned(Strings));
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
function NormalizeDate(const Value: string; theValue: TDateTime;
const theFormat: string): string;
var
texto: string;
i: integer;
d, m, y: word;
ds, ms, ys: string;
aDate: TDateTime;
tokens: TStringList;
aDateFormat: string;
aChar: char;
procedure LittleEndianForm;
begin
// Note: only numeric input allowed (months names not implemented)
if tokens[0] <> '' then
ds := tokens[0];
if (tokens.Count > 1) and (tokens[1] <> '') then
ms := tokens[1];
if (tokens.Count > 2) and (tokens[2] <> '') then
ys := tokens[2];
texto := ds + DateSeparator + ms + DateSeparator + ys;
end;
procedure MiddleEndianForm;
begin
if tokens[0] <> '' then
ms := tokens[0];
if (tokens.Count > 1) and (tokens[1] <> '') then
ds := tokens[1];
if (tokens.Count > 2) and (tokens[2] <> '') then
ys := tokens[2];
texto := ms + DateSeparator + ds + DateSeparator + ys;
end;
procedure BigEndianForm;
begin
if tokens[0] <> '' then
ys := tokens[0];
if (tokens.Count > 1) and (tokens[1] <> '') then
ms := tokens[1];
if (tokens.Count > 2) and (tokens[2] <> '') then
ds := tokens[2];
texto := ys + DateSeparator + ms + DateSeparator + ds;
end;
begin
if theFormat = '' then
aDateFormat := ShortDateFormat
else
aDateFormat := theFormat;
if theValue = 0 then
DecodeDate(Now, y, m, d)
else
decodedate(theValue, y, m, d);
ds := IntToStr(d);
ms := IntToStr(m);
ys := IntToStr(y);
texto := Value;
texto := NormalizeDateSeparator(texto);
Result := texto; // default value
i := countchar(texto, DateSeparator);
tokens := TStringList.Create;
Split(DateSeparator, texto, tokens);
if tokens.Count > 0 then
begin
aChar := aDateFormat[1];
case aChar of
'd', 'D': LittleEndianForm;
'm', 'M': MiddleEndianForm;
'y', 'Y': BigEndianForm;
end;
if IsValidDateString(texto) then
begin
aDate := StrToDate(texto);
Result := FormatDateTime(aDateFormat, aDate);
end;
end;
tokens.Free;
end;
function NormalizeDateSeparator(const s: string): string;
var
i: integer;
begin
Result := s;
for i := 1 to length(Result) do
if Result[i] in ['.', ',', '/', '-'] then // valid date separators
Result[i] := DateSeparator;
end;
function IsValidDateString(const Value: string): boolean;
begin
if StrToDateDef(Value, MaxDateTime) = MaxDateTime then
Result := False
else
Result := True;
end;
end.

368
components/jujiboutils/jujibo-utils/src/jdbcurrencyedit.pas Normal file
View File

@ -0,0 +1,368 @@
unit jdbcurrencyedit;
{$mode objfpc}{$H+}
interface
uses
Classes, LResources, Controls, StdCtrls, DB, DBCtrls, LMessages, LCLType, Dialogs,
SysUtils;
type
{ TJDBCurrencyEdit }
TJDBCurrencyEdit = class(TEdit)
private
fFormat: string;
FDataLink: TFieldDataLink;
fDecimales: integer;
procedure DataChange(Sender: TObject);
function getDecimals: integer;
procedure setDecimals(AValue: integer);
procedure UpdateData(Sender: TObject);
procedure FocusRequest(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function IsReadOnly: boolean;
function getFormat: string;
procedure setFormat(const AValue: string);
procedure formatInput;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
function IsValidCurrency(const Value: string): boolean;
function ScaleTo(const AValue: currency; const NDecimals: integer): currency;
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ActiveChange(Sender: TObject); virtual;
procedure KeyDown(var Key: word; Shift: TShiftState); override;
procedure KeyPress(var Key: char); override;
procedure DoEnter; override;
function GetReadOnly: boolean; override;
procedure SetReadOnly(Value: boolean); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure EditingDone; override;
property Field: TField read GetField;
published
property DisplayFormat: string read getFormat write setFormat;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property Decimals: integer read getDecimals write setDecimals;
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
// From TEdit
property Action;
property Align;
property Alignment;
property Anchors;
property AutoSize;
property AutoSelect;
property BidiMode;
property BorderStyle;
property BorderSpacing;
property CharCase;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property EchoMode;
property Enabled;
property Font;
property HideSelection;
property MaxLength;
property ParentBidiMode;
property OnChange;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditingDone;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
property OnUTF8KeyPress;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property Visible;
end;
procedure Register;
implementation
uses
Math;
procedure Register;
begin
{$I currencydbicon.lrs}
RegisterComponents('Data Controls', [TJDBCurrencyEdit]);
end;
{ TJDBCurrencyEdit }
procedure TJDBCurrencyEdit.DataChange(Sender: TObject);
begin
if not Focused then
formatInput
else
Caption := FDataLink.Field.AsString;
end;
function TJDBCurrencyEdit.getDecimals: integer;
begin
Result := fDecimales;
end;
procedure TJDBCurrencyEdit.setDecimals(AValue: integer);
begin
if AValue >= 0 then
fDecimales := AValue;
end;
procedure TJDBCurrencyEdit.UpdateData(Sender: TObject);
var
theValue: currency;
begin
if IsValidCurrency(Text) then
begin
theValue := StrToCurr(Text);
theValue := ScaleTo(theValue, fDecimales);
Text := CurrToStr(theValue);
FDataLink.Field.Text := Text;
end
else
begin
if FDataLink.Field <> nil then
begin
ShowMessage(Caption + ' no es un valor válido');
Caption := FDataLink.Field.AsString;
SelectAll;
SetFocus;
end;
end;
end;
procedure TJDBCurrencyEdit.FocusRequest(Sender: TObject);
begin
SetFocus;
end;
function TJDBCurrencyEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TJDBCurrencyEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TJDBCurrencyEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TJDBCurrencyEdit.IsReadOnly: boolean;
begin
if FDatalink.Active then
Result := not FDatalink.CanModify
else
Result := False;
end;
function TJDBCurrencyEdit.getFormat: string;
begin
Result := fFormat;
end;
procedure TJDBCurrencyEdit.setFormat(const AValue: string);
begin
fFormat := AValue;
if not Focused then
formatInput;
end;
procedure TJDBCurrencyEdit.formatInput;
begin
if FDataLink.Field <> nil then
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
if fFormat <> '' then
Caption := FormatFloat(fFormat, FDataLink.Field.AsCurrency)
else
Caption := FDataLink.Field.DisplayText
else
Caption := 'nil';
end;
function TJDBCurrencyEdit.GetReadOnly: boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TJDBCurrencyEdit.SetReadOnly(Value: boolean);
begin
inherited;
FDataLink.ReadOnly := Value;
end;
procedure TJDBCurrencyEdit.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
procedure TJDBCurrencyEdit.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
ChangeDataSource(Self, FDataLink, Value);
end;
procedure TJDBCurrencyEdit.CMGetDataLink(var Message: TLMessage);
begin
Message.Result := PtrUInt(FDataLink); // Delphi dbctrls compatibility?
end;
function TJDBCurrencyEdit.IsValidCurrency(const Value: string): boolean;
begin
if StrToCurrDef(Value, MaxCurrency) = MaxCurrency then
Result := False
else
Result := True;
end;
function TJDBCurrencyEdit.ScaleTo(const AValue: currency;
const NDecimals: integer): currency;
begin
Result := round(AValue * power(10, NDecimals)) / power(10, NDecimals);
end;
procedure TJDBCurrencyEdit.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then
DataChange(Self);
end;
procedure TJDBCurrencyEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
// clean up
if (Operation = opRemove) then
begin
if (FDataLink <> nil) and (AComponent = DataSource) then
DataSource := nil;
end;
end;
procedure TJDBCurrencyEdit.ActiveChange(Sender: TObject);
begin
if FDatalink.Active then
datachange(Sender)
else
Text := '';
end;
procedure TJDBCurrencyEdit.KeyDown(var Key: word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key = VK_ESCAPE then
begin
FDataLink.Reset;
SelectAll;
Key := VK_UNKNOWN;
end
else
if Key in [VK_DELETE, VK_BACK] then
begin
if not IsReadOnly then
FDatalink.Edit
else
Key := VK_UNKNOWN;
end;
end;
procedure TJDBCurrencyEdit.KeyPress(var Key: char);
begin
if (Key in ['.', ',']) then
Key := Decimalseparator;
if (key = DecimalSeparator) and (Pos(key, Text) > 0) then
key := #0;
if not (Key in ['0'..'9', DecimalSeparator, '+', '-', #8, #9]) then
Key := #0;
if (Key = DecimalSeparator) and (fDecimales = 0) then
Key := #0;
if (Key <> #0) and (not IsReadOnly) then
FDatalink.Edit;
inherited KeyPress(Key);
end;
procedure TJDBCurrencyEdit.DoEnter;
begin
if FDataLink.Field <> nil then
Caption := FDataLink.Field.AsString;
inherited DoEnter;
end;
constructor TJDBCurrencyEdit.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
FDataLInk.OnActiveChange := @ActiveChange;
// Set default values
//fDecimales := 2;
//fFormat := '0.00';
end;
destructor TJDBCurrencyEdit.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TJDBCurrencyEdit.EditingDone;
begin
inherited EditingDone;
UpdateData(self);
end;
end.

340
components/jujiboutils/jujibo-utils/src/jdbdateedit.pas Normal file
View File

@ -0,0 +1,340 @@
unit jdbdateedit;
{$mode objfpc}{$H+}
interface
uses
Classes, LResources, Controls, StdCtrls, DB, DBCtrls, LMessages, LCLType, Dialogs,
SysUtils;
type
{ TJDBDateEdit }
TJDBDateEdit = class(TEdit)
private
fFormat: string;
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
procedure FocusRequest(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function IsReadOnly: boolean;
function getFormat: string;
procedure setFormat(const AValue: string);
procedure formatInput;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
function IsValidCurrency(const Value: string): boolean;
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ActiveChange(Sender: TObject); virtual;
procedure KeyDown(var Key: word; Shift: TShiftState); override;
procedure KeyPress(var Key: char); override;
procedure DoEnter; override;
function GetReadOnly: boolean; override;
procedure SetReadOnly(Value: boolean); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure EditingDone; override;
property Field: TField read GetField;
published
property DisplayFormat: string read getFormat write setFormat;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
// From TEdit
property Action;
property Align;
property Alignment;
property Anchors;
property AutoSize;
property AutoSelect;
property BidiMode;
property BorderStyle;
property BorderSpacing;
property CharCase;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property EchoMode;
property Enabled;
property Font;
property HideSelection;
property MaxLength;
property ParentBidiMode;
property OnChange;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditingDone;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
property OnUTF8KeyPress;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property Visible;
end;
procedure Register;
implementation
uses
jcontrolutils;
procedure Register;
begin
{$I datedbicon.lrs}
RegisterComponents('Data Controls', [TJDBDateEdit]);
end;
{ TJDBDateEdit }
procedure TJDBDateEdit.DataChange(Sender: TObject);
begin
if not Focused then
formatInput
else
Caption := FDataLink.Field.AsString;
end;
procedure TJDBDateEdit.UpdateData(Sender: TObject);
var
theValue: string;
begin
if FDataLink.Field <> nil then
begin
theValue := NormalizeDate(Text, FDataLink.Field.AsDateTime);
if Text = '' then
FDataLink.Field.Text := Text
else
if IsValidDateString(theValue) then
begin
FDataLink.Field.Text := theValue;
end
else
begin
ShowMessage(Caption + ' no es un valor válido');
Caption := FDataLink.Field.AsString;
SelectAll;
SetFocus;
end;
end;
end;
procedure TJDBDateEdit.FocusRequest(Sender: TObject);
begin
SetFocus;
end;
function TJDBDateEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TJDBDateEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TJDBDateEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TJDBDateEdit.IsReadOnly: boolean;
begin
if FDatalink.Active then
Result := not FDatalink.CanModify
else
Result := False;
end;
function TJDBDateEdit.getFormat: string;
begin
Result := fFormat;
end;
procedure TJDBDateEdit.setFormat(const AValue: string);
begin
fFormat := AValue;
if not Focused then
formatInput;
end;
procedure TJDBDateEdit.formatInput;
begin
if FDataLink.Field <> nil then
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
if (fFormat <> '') and (not FDataLink.Field.IsNull) then
Caption := FormatDateTime(fFormat, FDataLink.Field.AsDateTime)
else
Caption := FDataLink.Field.DisplayText
else
Caption := 'nil';
end;
function TJDBDateEdit.GetReadOnly: boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TJDBDateEdit.SetReadOnly(Value: boolean);
begin
inherited;
FDataLink.ReadOnly := Value;
end;
procedure TJDBDateEdit.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
procedure TJDBDateEdit.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
ChangeDataSource(Self, FDataLink, Value);
end;
procedure TJDBDateEdit.CMGetDataLink(var Message: TLMessage);
begin
Message.Result := PtrUInt(FDataLink); // Delphi dbctrls compatibility?
end;
function TJDBDateEdit.IsValidCurrency(const Value: string): boolean;
begin
if StrToCurrDef(Value, MaxCurrency) = MaxCurrency then
Result := False
else
Result := True;
end;
procedure TJDBDateEdit.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then
DataChange(Self);
end;
procedure TJDBDateEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
// clean up
if (Operation = opRemove) then
begin
if (FDataLink <> nil) and (AComponent = DataSource) then
DataSource := nil;
end;
end;
procedure TJDBDateEdit.ActiveChange(Sender: TObject);
begin
if FDatalink.Active then
datachange(Sender)
else
Text := '';
end;
procedure TJDBDateEdit.KeyDown(var Key: word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key = VK_ESCAPE then
begin
FDataLink.Reset;
SelectAll;
Key := VK_UNKNOWN;
end
else
if Key in [VK_DELETE, VK_BACK] then
begin
if not IsReadOnly then
FDatalink.Edit
else
Key := VK_UNKNOWN;
end;
end;
procedure TJDBDateEdit.KeyPress(var Key: char);
begin
if not (Key in ['0'..'9', #8, #9, '.', '-', '/']) then
Key := #0
else
if not IsReadOnly then
FDatalink.Edit;
inherited KeyPress(Key);
end;
procedure TJDBDateEdit.DoEnter;
begin
if FDataLink.Field <> nil then
Caption := FDataLink.Field.AsString;
inherited DoEnter;
end;
constructor TJDBDateEdit.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
FDataLInk.OnActiveChange := @ActiveChange;
// Set default values
//fFormat := ShortDateFormat;
end;
destructor TJDBDateEdit.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TJDBDateEdit.EditingDone;
begin
inherited EditingDone;
UpdateData(self);
end;
end.

328
components/jujiboutils/jujibo-utils/src/jdbintegeredit.pas Normal file
View File

@ -0,0 +1,328 @@
unit jdbintegeredit;
{$mode objfpc}{$H+}
interface
uses
Classes, LResources, Controls, StdCtrls, DB, DBCtrls, LMessages, LCLType, Dialogs,
SysUtils;
type
{ TJDBIntegerEdit }
TJDBIntegerEdit = class(TEdit)
private
fFormat: string;
FDataLink: TFieldDataLink;
procedure DataChange(Sender: TObject);
procedure UpdateData(Sender: TObject);
procedure FocusRequest(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function IsReadOnly: boolean;
function getFormat: string;
procedure setFormat(const AValue: string);
procedure formatInput;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
function IsValidInteger(const Value: string): boolean;
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ActiveChange(Sender: TObject); virtual;
procedure KeyDown(var Key: word; Shift: TShiftState); override;
procedure KeyPress(var Key: char); override;
procedure DoEnter; override;
function GetReadOnly: boolean; override;
procedure SetReadOnly(Value: boolean); override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure EditingDone; override;
property Field: TField read GetField;
published
property DisplayFormat: string read getFormat write setFormat;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: boolean read GetReadOnly write SetReadOnly default False;
// From TEdit
property Action;
property Align;
property Alignment;
property Anchors;
property AutoSize;
property AutoSelect;
property BidiMode;
property BorderStyle;
property BorderSpacing;
property CharCase;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property EchoMode;
property Enabled;
property Font;
property HideSelection;
property MaxLength;
property ParentBidiMode;
property OnChange;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditingDone;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
property OnUTF8KeyPress;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
{$I integerdbicon.lrs}
RegisterComponents('Data Controls', [TJDBIntegerEdit]);
end;
{ TJDBIntegerEdit }
procedure TJDBIntegerEdit.DataChange(Sender: TObject);
begin
if not Focused then
formatInput
else
Caption := FDataLink.Field.AsString;
end;
procedure TJDBIntegerEdit.UpdateData(Sender: TObject);
begin
if FDataLink.Field <> nil then
begin
if IsValidInteger(Caption) then
FDataLink.Field.Text := Text
else
begin
ShowMessage(Caption + ' no es un valor válido');
Caption := FDataLink.Field.AsString;
SelectAll;
SetFocus;
end;
end;
end;
procedure TJDBIntegerEdit.FocusRequest(Sender: TObject);
begin
SetFocus;
end;
function TJDBIntegerEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TJDBIntegerEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TJDBIntegerEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
function TJDBIntegerEdit.IsReadOnly: boolean;
begin
if FDatalink.Active then
Result := not FDatalink.CanModify
else
Result := False;
end;
function TJDBIntegerEdit.getFormat: string;
begin
Result := fFormat;
end;
procedure TJDBIntegerEdit.setFormat(const AValue: string);
begin
fFormat := AValue;
if not Focused then
formatInput;
end;
procedure TJDBIntegerEdit.formatInput;
begin
if FDataLink.Field <> nil then
//FDataLink.Field.DisplayText -> formatted (tdbgridcolumns/persistent field DisplayFormat
if fFormat <> '' then
Caption := FormatFloat(fFormat, FDataLink.Field.AsInteger)
else
Caption := FDataLink.Field.DisplayText
else
Caption := 'nil';
end;
function TJDBIntegerEdit.GetReadOnly: boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TJDBIntegerEdit.SetReadOnly(Value: boolean);
begin
inherited;
FDataLink.ReadOnly := Value;
end;
procedure TJDBIntegerEdit.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
procedure TJDBIntegerEdit.SetDataSource(Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
ChangeDataSource(Self, FDataLink, Value);
end;
procedure TJDBIntegerEdit.CMGetDataLink(var Message: TLMessage);
begin
Message.Result := PtrUInt(FDataLink); // Delphi dbctrls compatibility?
end;
function TJDBIntegerEdit.IsValidInteger(const Value: string): boolean;
begin
if StrToIntDef(Value, MaxInt) = MaxInt then
Result := False
else
Result := True;
end;
procedure TJDBIntegerEdit.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then
DataChange(Self);
end;
procedure TJDBIntegerEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
// clean up
if (Operation = opRemove) then
begin
if (FDataLink <> nil) and (AComponent = DataSource) then
DataSource := nil;
end;
end;
procedure TJDBIntegerEdit.ActiveChange(Sender: TObject);
begin
if FDatalink.Active then
datachange(Sender)
else
Text := '';
end;
procedure TJDBIntegerEdit.KeyDown(var Key: word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if Key = VK_ESCAPE then
begin
FDataLink.Reset;
SelectAll;
Key := VK_UNKNOWN;
end
else
if Key in [VK_DELETE, VK_BACK] then
begin
if not IsReadOnly then
FDatalink.Edit
else
Key := VK_UNKNOWN;
end;
end;
procedure TJDBIntegerEdit.KeyPress(var Key: char);
begin
if not (Key in ['0'..'9', #8, #9, '-']) then
Key := #0
else
if not IsReadOnly then
FDatalink.Edit;
inherited KeyPress(Key);
end;
procedure TJDBIntegerEdit.DoEnter;
begin
if FDataLink.Field <> nil then
Caption := FDataLink.Field.AsString;
inherited DoEnter;
end;
constructor TJDBIntegerEdit.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
FDataLInk.OnActiveChange := @ActiveChange;
end;
destructor TJDBIntegerEdit.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TJDBIntegerEdit.EditingDone;
begin
inherited EditingDone;
UpdateData(self);
end;
end.