You've already forked lazarus-ccr
First package with visual db controls, created
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1969 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jujibo
@ -5,5 +5,6 @@ JUJIBOUTILS
|
||||
|
||||
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-13 Initial commit to lazarus-ccr
|
||||
|
||||
157
components/jujiboutils/jujibo-utils/example1/main.lfm
Normal file
157
components/jujiboutils/jujibo-utils/example1/main.lfm
Normal 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
64
components/jujiboutils/jujibo-utils/example1/main.pas
Normal 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
81
components/jujiboutils/jujibo-utils/example1/project1.lpi
Normal 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
22
components/jujiboutils/jujibo-utils/example1/project1.lpr
Normal 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
52
components/jujiboutils/jujibo-utils/jujibocontrols.lpk
Normal 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
24
components/jujiboutils/jujibo-utils/jujibocontrols.pas
Normal 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
29
components/jujiboutils/jujibo-utils/src/currencydbicon.lrs
Normal 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
26
components/jujiboutils/jujibo-utils/src/datedbicon.lrs
Normal 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
28
components/jujiboutils/jujibo-utils/src/integerdbicon.lrs
Normal 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
155
components/jujiboutils/jujibo-utils/src/jcontrolutils.pas
Normal 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
368
components/jujiboutils/jujibo-utils/src/jdbcurrencyedit.pas
Normal 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
340
components/jujiboutils/jujibo-utils/src/jdbdateedit.pas
Normal 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
328
components/jujiboutils/jujibo-utils/src/jdbintegeredit.pas
Normal 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.
|
||||
|
||||
Reference in New Issue
Block a user