You've already forked lazarus-ccr
JVCLLaz: Add TJvDBLookupList and TJvDBLookupCombo. Issue #34322, patch by Michal Gawrycki.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6851 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -16,7 +16,7 @@ implementation
|
||||
|
||||
uses
|
||||
Classes, JvDsgnConsts, //JvDBSearchCombobox,
|
||||
JvDBSearchEdit, JvDBTreeView, JvDBControls, JvDBHTLabel;
|
||||
JvDBSearchEdit, JvDBTreeView, JvDBControls, JvDBHTLabel, JvDBLookup;
|
||||
|
||||
procedure Register;
|
||||
const
|
||||
@ -42,7 +42,8 @@ begin
|
||||
TJvDBSearchEdit,
|
||||
// TJvDBSearchCombobox,
|
||||
TJvDBTreeView,
|
||||
TJvDBHTLabel
|
||||
TJvDBHTLabel,
|
||||
TJvDBLookupList, TJvDBLookupCombo
|
||||
]);
|
||||
|
||||
RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cItemField, TFieldProperty); //TJvDataFieldProperty);
|
||||
|
||||
73
components/jvcllaz/examples/JvDBLookup/JvDBLookupDemo.lpi
Normal file
73
components/jvcllaz/examples/JvDBLookup/JvDBLookupDemo.lpi
Normal file
@ -0,0 +1,73 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="JvDBLookupDemo"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="JvDBLazR"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item3>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="JvDBLookupDemo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="..\..\bin\JvDBLookupDemo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
22
components/jvcllaz/examples/JvDBLookup/JvDBLookupDemo.lpr
Normal file
22
components/jvcllaz/examples/JvDBLookup/JvDBLookupDemo.lpr
Normal file
@ -0,0 +1,22 @@
|
||||
program JvDBLookupDemo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, main
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Scaled := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
335
components/jvcllaz/examples/JvDBLookup/main.lfm
Normal file
335
components/jvcllaz/examples/JvDBLookup/main.lfm
Normal file
@ -0,0 +1,335 @@
|
||||
object Form1: TForm1
|
||||
Left = 298
|
||||
Height = 331
|
||||
Top = 119
|
||||
Width = 433
|
||||
Caption = 'JvDBLookup controls'
|
||||
ClientHeight = 331
|
||||
ClientWidth = 433
|
||||
OnShow = FormShow
|
||||
LCLVersion = '2.1.0.0'
|
||||
object DBGrid1: TDBGrid
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = DBEdit1
|
||||
Left = 8
|
||||
Height = 129
|
||||
Top = 8
|
||||
Width = 417
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Around = 8
|
||||
Color = clWindow
|
||||
Columns = <>
|
||||
DataSource = DSCities
|
||||
TabOrder = 0
|
||||
end
|
||||
object JvDBLookupList1: TJvDBLookupList
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = JvDBLookupCombo1
|
||||
Left = 8
|
||||
Height = 116
|
||||
Top = 176
|
||||
Width = 417
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
DataField = 'CITY_ID'
|
||||
DataSource = DSSomeData
|
||||
DisplayEmpty = 'none...'
|
||||
EmptyItemColor = clSilver
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
ImageList = ImageList1
|
||||
LookupField = 'ID'
|
||||
LookupDisplay = 'NAME;COUNTRY'
|
||||
LookupSource = DSCities
|
||||
TabOrder = 1
|
||||
UseRecordCount = True
|
||||
OnGetImageIndex = JvDBLookupList1GetImageIndex
|
||||
end
|
||||
object DBEdit1: TDBEdit
|
||||
AnchorSideLeft.Control = DBGrid1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideBottom.Control = JvDBLookupList1
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 145
|
||||
Width = 112
|
||||
DataField = 'CITY_ID'
|
||||
DataSource = DSSomeData
|
||||
Anchors = [akLeft, akBottom]
|
||||
CharCase = ecNormal
|
||||
MaxLength = 0
|
||||
TabOrder = 2
|
||||
end
|
||||
object JvDBLookupCombo1: TJvDBLookupCombo
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 23
|
||||
Top = 300
|
||||
Width = 417
|
||||
BorderSpacing.Around = 8
|
||||
DisplayAllFields = True
|
||||
DataField = 'CITY_ID'
|
||||
DataSource = DSSomeData
|
||||
DisplayEmpty = 'none...'
|
||||
EmptyItemColor = clSilver
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
ImageList = ImageList1
|
||||
LookupField = 'ID'
|
||||
LookupDisplay = 'NAME;COUNTRY'
|
||||
LookupSource = DSCities
|
||||
TabOrder = 3
|
||||
UseRecordCount = True
|
||||
OnGetImageIndex = JvDBLookupList1GetImageIndex
|
||||
end
|
||||
object SomeData: TBufDataset
|
||||
FieldDefs = <
|
||||
item
|
||||
Name = 'CITY_ID'
|
||||
DataType = ftInteger
|
||||
end>
|
||||
left = 183
|
||||
top = 134
|
||||
end
|
||||
object Cities: TBufDataset
|
||||
FieldDefs = <
|
||||
item
|
||||
Name = 'ID'
|
||||
DataType = ftInteger
|
||||
end
|
||||
item
|
||||
Name = 'NAME'
|
||||
DataType = ftString
|
||||
Size = 16
|
||||
end
|
||||
item
|
||||
Name = 'COUNTRY'
|
||||
DataType = ftString
|
||||
Size = 16
|
||||
end
|
||||
item
|
||||
Name = 'FLAG'
|
||||
DataType = ftInteger
|
||||
end>
|
||||
left = 264
|
||||
top = 134
|
||||
end
|
||||
object ImageList1: TImageList
|
||||
left = 224
|
||||
top = 240
|
||||
Bitmap = {
|
||||
4C69060000001000000010000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000000000000000000058483BE0645442E0645442E0645442E06454
|
||||
42E0645442E0645442E0645442E0645442E0645442E0645442E0645442E06454
|
||||
42E0645442E0645442E058483BE0645240E577644BFF77644BFF77644BFF7764
|
||||
4BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF7764
|
||||
4BFF77644BFF77644BFF645240E5645240E577644BFF77644BFF77644BFF7764
|
||||
4BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF77644BFF7764
|
||||
4BFF77644BFF77644BFF645240E5584B4AF8645650F8645650F8645650F86456
|
||||
50F8645650F8645650F8645650F8645650F8645650F8645650F8645650F86456
|
||||
50F8645650F8645650F8584B4AF86C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE56C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE56C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5595DD6EF6C72E2F16C72E2F16C72E2F16C72
|
||||
E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72E2F16C72
|
||||
E2F16C72E2F16C72E2F1595DD6EF8ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFF8ED9FAE581CEF8E08EDAFAE08EDAFAE08EDAFAE08EDA
|
||||
FAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDAFAE08EDA
|
||||
FAE08EDAFAE08EDAFAE081CEF8E0000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000D7C3B9EDE0CBBAE3D29C75AACB9165A3CB91
|
||||
65A3CB9165A3CE9B75AC897BBBEB897BBBEBCE9B75ACCB9165A3CB9165A3CB91
|
||||
65A3CB9367A3DAC1B0D49389BFF58380CDFFD6D6F3FFFEF8F4FFF5CDAEFFF0B7
|
||||
8BFFF0B78BFFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF0B78BFFF2C0
|
||||
9AFFD9CDDDFF8A8ADCFFCEC6D6FFDDB495EDA9A5DEFFA1A1E3FFF9F9FDFFFAE5
|
||||
D5FFF1BC93FFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF4D3BBFFA9A8
|
||||
E3FFA2A2E3FFFBF9FBFFE5CAB3F3D49A6EE5F1BB91FFDBC7CEFF8B8BDCFFD6D6
|
||||
F3FFFEF8F4FFF6D5BCFF8B8BE5FF8B8BE5FFF4CBACFFE2D5DDFF8989DCFFD5D5
|
||||
F2FFFCF0E7FFF2C39EFFD49A6EE5D9A882EAF3C5A2FFF3C5A2FFF3D3BAFFA8A5
|
||||
DFFFC0C0ECFFFFFFFFFF8B8BE5FF8B8BE5FFD5D4F0FF9B9BE1FFF8F6FBFFF9E1
|
||||
CEFFF3C6A4FFF3C5A2FFD9A882EA7570CDFE8C8CE6FF8C8CE6FF8C8CE6FF8C8C
|
||||
E6FF8C8CE6FF8C8CE6FF8383E8FF8383E8FF8C8CE6FF8C8CE6FF8C8CE6FF8C8C
|
||||
E6FF8C8CE6FF8C8CE6FF7570CDFE7570CDFE8C8CE6FF8C8CE6FF8C8CE6FF8C8C
|
||||
E6FF8C8CE6FF8C8CE6FF8383E8FF8383E8FF8C8CE6FF8C8CE6FF8C8CE6FF8C8C
|
||||
E6FF8C8CE6FF8C8CE6FF7570CDFED9A882EAF3C5A2FFF3C7A5FFF9E5D5FFF8F7
|
||||
FCFF9B9BE1FFD5D4EFFF8B8BE5FF8B8BE5FFFDF4EEFFFCFCFEFFA6A6E4FFBEB7
|
||||
DDFFF5CDAFFFF3C5A2FFD9A882EAD49A6EE5F3C7A4FFFDF3ECFFD5D5F2FF8989
|
||||
DCFFE1D2D9FFF3C9A9FF8B8BE5FF8B8BE5FFF3C5A0FFF7D8C0FFFEFCFBFFB8B8
|
||||
EAFF908FDCFFECCCBDFFD49A6FE5E7CFBBF5FBFAFDFFA2A2E3FFA9A8E2FFF4D1
|
||||
B6FFF0B78BFFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF2C29DFFFCEF
|
||||
E5FFE8E8F8FF8888DBFFC1B5CEFBCEC6D6FF8A8ADCFFD9CCDAFFF2BF98FFF0B7
|
||||
8BFFF0B78BFFF3C49FFF8B8BE5FF8B8BE5FFF3C49FFFF0B78BFFF0B78BFFF0B8
|
||||
8CFFF7D8C0FFFEFCFBFF9F9AD1FF9389BFF5DAC1AED2CB9367A3CB9165A3CB91
|
||||
65A3CB9165A3CE9B75AC897BBBEB897BBBEBCE9B75ACCB9165A3CB9165A3CB91
|
||||
65A3CB9165A3D6AA8AB5DCC7B7EB000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000005656D4E06C6CE2E06C6CE2E06C6CE2E06C6C
|
||||
E2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6C
|
||||
E2E06C6CE2E06C6CE2E05656D4E06C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE56264DBEE7F7FEEFF7F7FEEFF7F7FEEFF7F7F
|
||||
EEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7F
|
||||
EEFF7F7FEEFF7F7FEEFF6264DBEE79B5EEEE88C4F2FF88C4F2FF88C4F2FF88C4
|
||||
F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4
|
||||
F2FF88C4F2FF88C4F2FF79B5EEEE8ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFF8ED9FAE58ED9FAE5A3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EEFFFFA3EE
|
||||
FFFFA3EEFFFFA3EEFFFF8ED9FAE579B5EEEE88C4F2FF88C4F2FF88C4F2FF88C4
|
||||
F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4F2FF88C4
|
||||
F2FF88C4F2FF88C4F2FF79B5EEEE6264DBEE7F7FEEFF7F7FEEFF7F7FEEFF7F7F
|
||||
EEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7FEEFF7F7F
|
||||
EEFF7F7FEEFF7F7FEEFF6264DBEE6C6CDFE58F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE55656D4E06C6CE2E06C6CE2E06C6CE2E06C6C
|
||||
E2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6CE2E06C6C
|
||||
E2E06C6CE2E06C6CE2E05656D4E0000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000C48A5DE0D49B6FE0D49B6FE0D49B6FE0CF95
|
||||
69EAD9C4AFEAE8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0C4B9C6EA6665DCEA6C6C
|
||||
E2E06C6CE2E06C6CE2E05656D4E0D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5D49A6EE5F0B78BFFF0B78BFFF0B78BFFE6AD
|
||||
80FFEBDACAFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FFD7D0DFFF8282EEFF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE5C48A5DE0D49B6FE0D49B6FE0D49B6FE0CF95
|
||||
69EAD9C4AFEAE8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0C4B9C6EA6665DCEA6C6C
|
||||
E2E06C6CE2E06C6CE2E05656D4E0000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000000000000000000080A86EE08CB57EE08CB57EE08CB57EE08CB3
|
||||
7FE6A0B688F6E8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0837FCFF66E6DDFE66C6C
|
||||
E2E06C6CE2E06C6CE2E05656D4E08BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE58BB47DE59EC999FF9EC999FF9EC999FF9EC9
|
||||
99FFADC39BFFFFFAF2FFFFFAF2FFFFFAF2FFFFFAF2FF9491DDFF8F8FF7FF8F8F
|
||||
F7FF8F8FF7FF8F8FF7FF6C6CDFE580A86EE08CB57EE08CB57EE08CB57EE08CB3
|
||||
7FE6A0B688F6E8DBCEE0E8DBCEE0E8DBCEE0E8DBCEE0837FCFF66E6DDFE66C6C
|
||||
E2E06C6CE2E06C6CE2E05656D4E0000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000000000003F3FF1454242
|
||||
E5FF3030EF410000000000000000000000003F3FF1454141DEFF2F2FE7430000
|
||||
00000000000000000000000000000000000000000000000000004242E5FF3D3D
|
||||
E9FF3838E7FF2929EF40000000003939F0434040E5FF3838DBFF3535D2FF0000
|
||||
00000000000000000000000000000000000000000000000000003030EF413838
|
||||
E7FF3232EBFF3333ECFF2B2BEF803C3CE7FF3636DEFF2F2FD4FF2525D7450000
|
||||
0000000000000000000000000000000000000000000000000000000000002929
|
||||
EF403333ECFF2F2FEDFF3030ECFF3131E5FF2D2DD9FF2626DD43000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00002B2BEF803131ECFF2C2CEBFF2B2BE6FF2929ED8000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000003939
|
||||
F0433C3CE7FF3131E5FF2B2BE6FF2A2AE8FF2A2AE3FF2929EF40000000000000
|
||||
00000000000000000000000000000000000000000000000000003F3FF1454040
|
||||
E5FF3636DEFF2D2DD9FF2929ED802A2AE3FF2B2BE5FF2E2EDDFF2828E8410000
|
||||
00000000000000000000000000000000000000000000000000004141DEFF3838
|
||||
DBFF2F2FD4FF2626DD43000000002929EF402E2EDDFF2C2CD8FF2F2FD1FF0000
|
||||
00000000000000000000000000000000000000000000000000002F2FE7433535
|
||||
D2FF2525D7450000000000000000000000002828E8412F2FD1FF2525D7450000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000
|
||||
}
|
||||
end
|
||||
object DSSomeData: TDataSource
|
||||
DataSet = SomeData
|
||||
left = 183
|
||||
top = 184
|
||||
end
|
||||
object DSCities: TDataSource
|
||||
DataSet = Cities
|
||||
left = 264
|
||||
top = 184
|
||||
end
|
||||
end
|
||||
85
components/jvcllaz/examples/JvDBLookup/main.pas
Normal file
85
components/jvcllaz/examples/JvDBLookup/main.pas
Normal file
@ -0,0 +1,85 @@
|
||||
unit main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, BufDataset, DB, Forms, Controls, Graphics, Dialogs,
|
||||
DBGrids, JvDBLookup, ExtCtrls, DBCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Cities: TBufDataset;
|
||||
DBEdit1: TDBEdit;
|
||||
DBGrid1: TDBGrid;
|
||||
DSCities: TDataSource;
|
||||
DSSomeData: TDataSource;
|
||||
ImageList1: TImageList;
|
||||
JvDBLookupCombo1: TJvDBLookupCombo;
|
||||
JvDBLookupList1: TJvDBLookupList;
|
||||
SomeData: TBufDataset;
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure JvDBLookupList1GetImageIndex(Sender: TObject; IsEmpty: Boolean;
|
||||
var ImageIndex: Integer; var TextMargin: Integer);
|
||||
private
|
||||
|
||||
public
|
||||
Image: TImage;
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
const
|
||||
ICON_DE = 0;
|
||||
ICON_UK = 1;
|
||||
ICON_ES = 2;
|
||||
ICON_FR = 3;
|
||||
ICON_IT = 4;
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormShow(Sender: TObject);
|
||||
begin
|
||||
SomeData.CreateDataset;
|
||||
SomeData.Open;
|
||||
Cities.CreateDataset;
|
||||
Cities.Open;
|
||||
Cities.AppendRecord([ 1, 'Paris', 'France', ICON_FR]);
|
||||
Cities.AppendRecord([ 2, 'Marseilles', 'France', ICON_FR]);
|
||||
Cities.AppendRecord([ 3, 'London', 'United Kingdom', ICON_UK]);
|
||||
Cities.AppendRecord([ 4, 'Oxford', 'United Kingdom', ICON_UK]);
|
||||
Cities.AppendRecord([ 5, 'Lyon', 'France', ICON_FR]);
|
||||
Cities.AppendRecord([ 6, 'Berlin', 'Germany', ICON_DE]);
|
||||
Cities.AppendRecord([ 7, 'Hamburg', 'Germany', ICON_DE]);
|
||||
Cities.AppendRecord([ 8, 'Munich', 'Germany', ICON_DE]);
|
||||
Cities.AppendRecord([ 9, 'Frankfurt', 'Germany', ICON_DE]);
|
||||
Cities.AppendRecord([10, 'Rome', 'Italy', ICON_IT]);
|
||||
Cities.AppendRecord([11, 'Venice', 'Italy', ICON_IT]);
|
||||
Cities.AppendRecord([12, 'Madrid', 'Spain', ICON_ES]);
|
||||
Cities.AppendRecord([13, 'Barcelona', 'Spain', ICON_ES]);
|
||||
Cities.FieldByName('NAME').DisplayWidth := 10;
|
||||
Cities.FieldByName('COUNTRY').DisplayWidth := 10;
|
||||
SomeData.Append;
|
||||
end;
|
||||
|
||||
procedure TForm1.JvDBLookupList1GetImageIndex(Sender: TObject;
|
||||
IsEmpty: Boolean; var ImageIndex: Integer; var TextMargin: Integer);
|
||||
begin
|
||||
if IsEmpty then
|
||||
ImageIndex := 5
|
||||
else
|
||||
ImageIndex := Cities.FieldByName('FLAG').AsInteger;
|
||||
TextMargin := ImageList1.Width + 2;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -19,7 +19,7 @@
|
||||
"/>
|
||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="4">
|
||||
<Files Count="6">
|
||||
<Item1>
|
||||
<Filename Value="..\run\JvDB\JvDBHTLabel.pas"/>
|
||||
<UnitName Value="JvDBHTLabel"/>
|
||||
@ -36,6 +36,14 @@
|
||||
<Filename Value="..\run\JvDB\JvDBControls.pas"/>
|
||||
<UnitName Value="JvDBControls"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="..\run\JvDB\jvdblookup.pas"/>
|
||||
<UnitName Value="JvDBLookup"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="..\run\JvDB\jvdbutils.pas"/>
|
||||
<UnitName Value="JvDBUtils"/>
|
||||
</Item6>
|
||||
</Files>
|
||||
<RequiredPkgs Count="4">
|
||||
<Item1>
|
||||
|
||||
Binary file not shown.
@ -339,6 +339,7 @@ type
|
||||
{**** string handling routines}
|
||||
TSetOfChar = TSysCharSet;
|
||||
TCharSet = TSysCharSet;
|
||||
***********)
|
||||
|
||||
TDateOrder = (doMDY, doDMY, doYMD);
|
||||
TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
|
||||
@ -350,6 +351,7 @@ const
|
||||
CenturyOffset: Byte = 60;
|
||||
NullDate: TDateTime = 0; {-693594}
|
||||
|
||||
(*********** NOT CONVERTED
|
||||
type
|
||||
// JvDriveCtrls / JvLookOut
|
||||
TJvImageSize = (isSmall, isLarge);
|
||||
|
||||
4071
components/jvcllaz/run/JvDB/jvdblookup.pas
Normal file
4071
components/jvcllaz/run/JvDB/jvdblookup.pas
Normal file
File diff suppressed because it is too large
Load Diff
986
components/jvcllaz/run/JvDB/jvdbutils.pas
Normal file
986
components/jvcllaz/run/JvDB/jvdbutils.pas
Normal file
@ -0,0 +1,986 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvDBUtils.PAS, released on 2002-07-04.
|
||||
|
||||
The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
||||
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
||||
Copyright (c) 2001,2002 SGB Software
|
||||
All Rights Reserved.
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.delphi-jedi.org
|
||||
|
||||
Contributors:
|
||||
tia
|
||||
|
||||
Lazarus port: Michał Gawrycki
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvDBUtils;
|
||||
|
||||
{.$I jvcl.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Variants, Classes, SysUtils, DB;
|
||||
|
||||
type
|
||||
TDropDownAlign = (daLeft, daRight, daCenter);
|
||||
|
||||
IJvDataControl = interface
|
||||
['{8B6910C8-D5FD-40BA-A427-FC54FE7B85E5}']
|
||||
function GetDataLink: TDataLink;
|
||||
end;
|
||||
|
||||
TJvDataLink = class(TDataLink)
|
||||
protected
|
||||
procedure FocusControl(Field: TFieldRef); overload; override;
|
||||
procedure FocusControl(const Field: TField); reintroduce; overload; virtual;
|
||||
end;
|
||||
|
||||
TCommit = (ctNone, ctStep, ctAll);
|
||||
TJvDBProgressEvent = procedure(UserData: Integer; var Cancel: Boolean; Line: Integer) of object;
|
||||
|
||||
EJvScriptError = class(Exception)
|
||||
private
|
||||
FErrPos: Integer;
|
||||
public
|
||||
// The dummy parameter is only there for BCB compatibility so that
|
||||
// when the hpp file gets generated, this constructor generates
|
||||
// a C++ constructor that doesn't already exist
|
||||
constructor Create(const AMessage: string; AErrPos: Integer; DummyForBCB: Integer = 0); overload;
|
||||
property ErrPos: Integer read FErrPos;
|
||||
end;
|
||||
|
||||
TJvLocateObject = class(TObject)
|
||||
private
|
||||
FDataSet: TDataSet;
|
||||
FLookupField: TField;
|
||||
FLookupValue: string;
|
||||
FLookupExact: Boolean;
|
||||
FCaseSensitive: Boolean;
|
||||
FBookmark: TBookmark;
|
||||
FIndexSwitch: Boolean;
|
||||
procedure SetDataSet(Value: TDataSet);
|
||||
protected
|
||||
function MatchesLookup(Field: TField): Boolean;
|
||||
procedure CheckFieldType(Field: TField); virtual;
|
||||
procedure ActiveChanged; virtual;
|
||||
function LocateFilter: Boolean; virtual;
|
||||
function LocateKey: Boolean; virtual;
|
||||
function LocateFull: Boolean; virtual;
|
||||
function UseKey: Boolean; virtual;
|
||||
function FilterApplicable: Boolean; virtual;
|
||||
property LookupField: TField read FLookupField;
|
||||
property LookupValue: string read FLookupValue;
|
||||
property LookupExact: Boolean read FLookupExact;
|
||||
property CaseSensitive: Boolean read FCaseSensitive;
|
||||
property Bookmark: TBookmark read FBookmark write FBookmark;
|
||||
public
|
||||
function Locate(const KeyField, KeyValue: string; Exact,
|
||||
ACaseSensitive: Boolean; DisableControls: Boolean = True;
|
||||
RightTrimmedLookup: Boolean = False): Boolean;
|
||||
property DataSet: TDataSet read FDataSet write SetDataSet;
|
||||
property IndexSwitch: Boolean read FIndexSwitch write FIndexSwitch;
|
||||
end;
|
||||
|
||||
TCreateLocateObject = function: TJvLocateObject;
|
||||
|
||||
var
|
||||
CreateLocateObject: TCreateLocateObject = nil;
|
||||
|
||||
function CreateLocate(DataSet: TDataSet): TJvLocateObject;
|
||||
|
||||
{ Utility routines }
|
||||
|
||||
function ExtractFieldNameEx(const Fields: String;
|
||||
var Pos: Integer): string;
|
||||
function IsDataSetEmpty(DataSet: TDataSet): Boolean;
|
||||
procedure RefreshQuery(Query: TDataSet);
|
||||
function DataSetSortedSearch(DataSet: TDataSet;
|
||||
const Value, FieldName: string; CaseInsensitive: Boolean): Boolean;
|
||||
//function DataSetSectionName(DataSet: TDataSet): string;
|
||||
//procedure InternalSaveFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage; const Path: string);
|
||||
//procedure InternalRestoreFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage;
|
||||
// const Path: string; RestoreVisible: Boolean);
|
||||
function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
|
||||
const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
||||
(*
|
||||
procedure SaveFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile);
|
||||
procedure RestoreFieldsReg(DataSet: TDataSet; IniFile: TRegIniFile;
|
||||
RestoreVisible: Boolean);
|
||||
*)
|
||||
//procedure SaveFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage; const Path: string = '');
|
||||
//procedure RestoreFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage; const Path: string = '';
|
||||
// RestoreVisible: Boolean = True);
|
||||
procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
|
||||
function ConfirmDelete: Boolean;
|
||||
procedure ConfirmDataSetCancel(DataSet: TDataSet);
|
||||
procedure CheckRequiredField(Field: TField);
|
||||
procedure CheckRequiredFields(const Fields: array of TField);
|
||||
procedure GotoBookmarkEx(DataSet: TDataSet; const Bookmark: TBookmark; Mode: TResyncMode = [rmExact, rmCenter]; ForceScrollEvents: Boolean = False);
|
||||
|
||||
{ SQL expressions }
|
||||
|
||||
function DateToSQL(Value: TDateTime): string;
|
||||
function FormatSQLDateRange(Date1, Date2: TDateTime;
|
||||
const FieldName: string): string;
|
||||
function FormatSQLDateRangeEx(Date1, Date2: TDateTime;
|
||||
const FieldName: string): string;
|
||||
function FormatSQLNumericRange(const FieldName: string;
|
||||
LowValue, HighValue, LowEmpty, HighEmpty: Double; Inclusive: Boolean): string;
|
||||
function StrMaskSQL(const Value: string): string;
|
||||
function FormatSQLCondition(const FieldName, AOperator, Value: string;
|
||||
FieldType: TFieldType; Exact: Boolean): string;
|
||||
function FormatAnsiSQLCondition(const FieldName, AOperator, Value: string;
|
||||
FieldType: TFieldType; Exact: Boolean): string;
|
||||
|
||||
const
|
||||
TrueExpr = '0=0';
|
||||
{$NODEFINE TrueExpr}
|
||||
|
||||
const
|
||||
{ Server Date formats}
|
||||
sdfStandard16 = '''"''mm''/''dd''/''yyyy''"'''; {"mm/dd/yyyy"}
|
||||
sdfStandard32 = '''''''dd/mm/yyyy'''''''; {'dd/mm/yyyy'}
|
||||
sdfOracle = '"TO_DATE(''"dd/mm/yyyy"'', ''DD/MM/YYYY'')"';
|
||||
sdfInterbase = '"CAST(''"mm"/"dd"/"yyyy"'' AS DATE)"';
|
||||
sdfMSSQL = '"CONVERT(datetime, ''"mm"/"dd"/"yyyy"'', 103)"';
|
||||
|
||||
const
|
||||
ServerDateFmt: string = sdfStandard16;
|
||||
|
||||
{.$NODEFINE ftNonTextTypes}
|
||||
(*$HPPEMIT 'namespace JvDBUtils'*)
|
||||
(*$HPPEMIT '{'*)
|
||||
(*$HPPEMIT '#define ftNonTextTypes (System::Set<TFieldType, ftUnknown, ftCursor> () \'*)
|
||||
(*$HPPEMIT ' << ftBytes << ftVarBytes << ftBlob << ftMemo << ftGraphic \'*)
|
||||
(*$HPPEMIT ' << ftFmtMemo << ftParadoxOle << ftDBaseOle << ftTypedBinary << ftCursor )'*)
|
||||
(*$HPPEMIT '}'*)
|
||||
|
||||
type
|
||||
Largeint = Longint;
|
||||
{$NODEFINE Largeint}
|
||||
|
||||
function NameDelimiter(C: Char): Boolean;
|
||||
function IsLiteral(C: Char): Boolean;
|
||||
procedure _DBError(const Msg: string);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DBConst, Math, Controls, Forms, Dialogs, DateUtils,
|
||||
JvJCLUtils, JvTypes, JvConsts, JvResources;
|
||||
|
||||
resourcestring
|
||||
SDeleteRecordQuestion = 'Delete record?';
|
||||
SFieldTypeMismatch = 'Field type mismatch: %s';
|
||||
|
||||
{ TJvDataLink }
|
||||
|
||||
procedure TJvDataLink.FocusControl(Field: TFieldRef);
|
||||
begin
|
||||
FocusControl(Field^);
|
||||
end;
|
||||
|
||||
procedure TJvDataLink.FocusControl(const Field: TField);
|
||||
begin
|
||||
end;
|
||||
|
||||
{ Utility routines }
|
||||
|
||||
function NameDelimiter(C: Char): Boolean;
|
||||
begin
|
||||
Result := CharInSet(C, [' ', ',', ';', ')', '.', Cr, Lf]);
|
||||
end;
|
||||
|
||||
function IsLiteral(C: Char): Boolean;
|
||||
begin
|
||||
Result := CharInSet(C, ['''', '"']);
|
||||
end;
|
||||
|
||||
procedure _DBError(const Msg: string);
|
||||
begin
|
||||
DatabaseError(Msg);
|
||||
end;
|
||||
|
||||
constructor EJvScriptError.Create(const AMessage: string; AErrPos: Integer; DummyForBCB: Integer);
|
||||
begin
|
||||
inherited Create(AMessage);
|
||||
FErrPos := AErrPos;
|
||||
end;
|
||||
|
||||
// (rom) better use Windows dialogs which are localized
|
||||
|
||||
function ConfirmDelete: Boolean;
|
||||
begin
|
||||
Screen.Cursor := crDefault;
|
||||
Result := MessageDlg(SDeleteRecordQuestion, mtConfirmation,
|
||||
[mbYes, mbNo], 0) = mrYes;
|
||||
end;
|
||||
|
||||
procedure ConfirmDataSetCancel(DataSet: TDataSet);
|
||||
begin
|
||||
if DataSet.State in [dsEdit, dsInsert] then
|
||||
begin
|
||||
DataSet.UpdateRecord;
|
||||
if DataSet.Modified then
|
||||
begin
|
||||
case MessageDlg(RsConfirmSave, mtConfirmation, mbYesNoCancel, 0) of
|
||||
mrYes:
|
||||
DataSet.Post;
|
||||
mrNo:
|
||||
DataSet.Cancel;
|
||||
else
|
||||
SysUtils.Abort;
|
||||
end;
|
||||
end
|
||||
else
|
||||
DataSet.Cancel;
|
||||
end;
|
||||
end;
|
||||
|
||||
function SetToBookmark(ADataSet: TDataSet; ABookmark: TBookmark): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if ADataSet.Active and (ABookmark <> nil) and not (ADataSet.Bof and ADataSet.Eof) and
|
||||
ADataSet.BookmarkValid(ABookmark) then
|
||||
try
|
||||
ADataSet.GotoBookmark(ABookmark);
|
||||
Result := True;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Refresh Query procedure }
|
||||
|
||||
procedure RefreshQuery(Query: TDataSet);
|
||||
var
|
||||
BookMk: TBookmark;
|
||||
begin
|
||||
Query.DisableControls;
|
||||
try
|
||||
if Query.Active then
|
||||
BookMk := Query.GetBookmark
|
||||
else
|
||||
BookMk := nil;
|
||||
try
|
||||
Query.Close;
|
||||
Query.Open;
|
||||
SetToBookmark(Query, BookMk);
|
||||
finally
|
||||
if BookMk <> nil then
|
||||
Query.FreeBookmark(BookMk);
|
||||
end;
|
||||
finally
|
||||
Query.EnableControls;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvLocateObject.SetDataSet(Value: TDataSet);
|
||||
begin
|
||||
ActiveChanged;
|
||||
FDataSet := Value;
|
||||
end;
|
||||
|
||||
function TJvLocateObject.LocateFull: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
DataSet.First;
|
||||
while not DataSet.Eof do
|
||||
begin
|
||||
if MatchesLookup(FLookupField) then
|
||||
begin
|
||||
Result := True;
|
||||
Break;
|
||||
end;
|
||||
DataSet.Next;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvLocateObject.LocateKey: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TJvLocateObject.FilterApplicable: Boolean;
|
||||
begin
|
||||
Result := FLookupField.FieldKind in [fkData, fkInternalCalc];
|
||||
end;
|
||||
|
||||
function TJvLocateObject.LocateFilter: Boolean;
|
||||
var
|
||||
SaveCursor: TCursor;
|
||||
Options: TLocateOptions;
|
||||
Value: Variant;
|
||||
begin
|
||||
SaveCursor := Screen.Cursor;
|
||||
Screen.Cursor := crHourGlass;
|
||||
try
|
||||
Options := [];
|
||||
if not FCaseSensitive then
|
||||
Include(Options, loCaseInsensitive);
|
||||
if not FLookupExact then
|
||||
Include(Options, loPartialKey);
|
||||
if FLookupValue = '' then
|
||||
VarClear(Value)
|
||||
else
|
||||
Value := FLookupValue;
|
||||
Result := DataSet.Locate(FLookupField.FieldName, Value, Options);
|
||||
finally
|
||||
Screen.Cursor := SaveCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvLocateObject.CheckFieldType(Field: TField);
|
||||
begin
|
||||
end;
|
||||
|
||||
function TJvLocateObject.Locate(const KeyField, KeyValue: string;
|
||||
Exact, ACaseSensitive: Boolean; DisableControls: Boolean; RightTrimmedLookup: Boolean): Boolean;
|
||||
var
|
||||
LookupKey: TField;
|
||||
|
||||
function IsStringType(FieldType: TFieldType): Boolean;
|
||||
const
|
||||
cStringTypes = [ftString, ftWideString];
|
||||
begin
|
||||
Result := FieldType in cStringTypes;
|
||||
end;
|
||||
|
||||
begin
|
||||
if DataSet = nil then
|
||||
begin
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
DataSet.CheckBrowseMode;
|
||||
LookupKey := DataSet.FieldByName(KeyField);
|
||||
DataSet.CursorPosChanged;
|
||||
FLookupField := LookupKey;
|
||||
if RightTrimmedLookup then
|
||||
FLookupValue := TrimRight(KeyValue)
|
||||
else
|
||||
FLookupValue := KeyValue;
|
||||
FLookupExact := Exact;
|
||||
FCaseSensitive := ACaseSensitive;
|
||||
if not IsStringType(FLookupField.DataType) then
|
||||
begin
|
||||
FCaseSensitive := True;
|
||||
try
|
||||
CheckFieldType(FLookupField);
|
||||
except
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
FCaseSensitive := ACaseSensitive;
|
||||
if DisableControls then
|
||||
DataSet.DisableControls;
|
||||
try
|
||||
FBookmark := DataSet.GetBookmark;
|
||||
try
|
||||
Result := MatchesLookup(FLookupField);
|
||||
if not Result then
|
||||
begin
|
||||
if UseKey then
|
||||
Result := LocateKey
|
||||
else
|
||||
begin
|
||||
if FilterApplicable then
|
||||
Result := LocateFilter
|
||||
else
|
||||
Result := LocateFull;
|
||||
end;
|
||||
if not Result then
|
||||
SetToBookmark(DataSet, FBookmark);
|
||||
end;
|
||||
finally
|
||||
FLookupValue := '';
|
||||
FLookupField := nil;
|
||||
DataSet.FreeBookmark(FBookmark);
|
||||
FBookmark := nil;
|
||||
end;
|
||||
finally
|
||||
if DisableControls then
|
||||
DataSet.EnableControls;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvLocateObject.UseKey: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TJvLocateObject.ActiveChanged;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TJvLocateObject.MatchesLookup(Field: TField): Boolean;
|
||||
var
|
||||
Temp: string;
|
||||
begin
|
||||
Temp := Field.AsString;
|
||||
if not LookupExact then
|
||||
SetLength(Temp, Min(Length(FLookupValue), Length(Temp)));
|
||||
if CaseSensitive then
|
||||
Result := AnsiSameStr(Temp, LookupValue)
|
||||
else
|
||||
Result := AnsiSameText(Temp, LookupValue);
|
||||
end;
|
||||
|
||||
function CreateLocate(DataSet: TDataSet): TJvLocateObject;
|
||||
begin
|
||||
if Assigned(CreateLocateObject) then
|
||||
Result := CreateLocateObject()
|
||||
else
|
||||
Result := TJvLocateObject.Create;
|
||||
if (Result <> nil) and (DataSet <> nil) then
|
||||
Result.DataSet := DataSet;
|
||||
end;
|
||||
|
||||
{ DataSet locate routines }
|
||||
|
||||
function DataSetLocateThrough(DataSet: TDataSet; const KeyFields: string;
|
||||
const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
||||
var
|
||||
FieldCount: Integer;
|
||||
Fields: TList;
|
||||
Bookmark: TBookmark;
|
||||
|
||||
function CompareField(Field: TField; const Value: Variant): Boolean;
|
||||
var
|
||||
S: string;
|
||||
begin
|
||||
if Field.DataType in [ftString{$IFDEF UNICODE}, ftWideString{$ENDIF UNICODE}] then
|
||||
begin
|
||||
if Value = Null then
|
||||
Result := Field.IsNull
|
||||
else
|
||||
begin
|
||||
S := Field.AsString;
|
||||
if loPartialKey in Options then
|
||||
Delete(S, Length(Value) + 1, MaxInt);
|
||||
if loCaseInsensitive in Options then
|
||||
Result := AnsiSameText(S, Value)
|
||||
else
|
||||
Result := AnsiSameStr(S, Value);
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := (Field.Value = Value);
|
||||
end;
|
||||
|
||||
function CompareRecord: Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
// Works with the KeyValues variant like TCustomClientDataSet.LocateRecord
|
||||
if (FieldCount = 1) and not VarIsArray(KeyValues) then
|
||||
Result := CompareField(TField(Fields[0]), KeyValues)
|
||||
else
|
||||
begin
|
||||
Result := True;
|
||||
for I := 0 to FieldCount - 1 do
|
||||
Result := Result and CompareField(TField(Fields[I]), KeyValues[I]);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
DataSet.CheckBrowseMode;
|
||||
if DataSet.IsEmpty then
|
||||
Exit;
|
||||
Fields := TList.Create;
|
||||
try
|
||||
DataSet.GetFieldList(Fields, KeyFields);
|
||||
FieldCount := Fields.Count;
|
||||
Result := CompareRecord;
|
||||
if Result then
|
||||
Exit;
|
||||
DataSet.DisableControls;
|
||||
try
|
||||
Bookmark := DataSet.Bookmark;
|
||||
try
|
||||
DataSet.First;
|
||||
while not DataSet.Eof do
|
||||
begin
|
||||
Result := CompareRecord;
|
||||
if Result then
|
||||
Break;
|
||||
DataSet.Next;
|
||||
end;
|
||||
finally
|
||||
if not Result and DataSet.BookmarkValid(TBookmark(Bookmark)) then
|
||||
DataSet.Bookmark := Bookmark;
|
||||
end;
|
||||
finally
|
||||
DataSet.EnableControls;
|
||||
end;
|
||||
finally
|
||||
Fields.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ DataSetSortedSearch. Navigate on sorted DataSet routine. }
|
||||
|
||||
function DataSetSortedSearch(DataSet: TDataSet; const Value,
|
||||
FieldName: string; CaseInsensitive: Boolean): Boolean;
|
||||
var
|
||||
L, H, I: Longint;
|
||||
CurrentPos: Longint;
|
||||
CurrentValue: string;
|
||||
BookMk: TBookmark;
|
||||
Field: TField;
|
||||
|
||||
function UpStr(const Value: string): string;
|
||||
begin
|
||||
if CaseInsensitive then
|
||||
Result := AnsiUpperCase(Value)
|
||||
else
|
||||
Result := Value;
|
||||
end;
|
||||
|
||||
function GetCurrentStr: string;
|
||||
begin
|
||||
Result := Field.AsString;
|
||||
if Length(Result) > Length(Value) then
|
||||
SetLength(Result, Length(Value));
|
||||
Result := UpStr(Result);
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
if DataSet = nil then
|
||||
Exit;
|
||||
Field := DataSet.FindField(FieldName);
|
||||
if Field = nil then
|
||||
Exit;
|
||||
if Field.DataType in [ftString{$IFDEF UNICODE}, ftWideString{$ENDIF UNICODE}] then
|
||||
begin
|
||||
DataSet.DisableControls;
|
||||
BookMk := DataSet.GetBookmark;
|
||||
try
|
||||
L := 0;
|
||||
DataSet.First;
|
||||
CurrentPos := 0;
|
||||
H := DataSet.RecordCount - 1;
|
||||
if Value <> '' then
|
||||
begin
|
||||
while L <= H do
|
||||
begin
|
||||
I := (L + H) shr 1;
|
||||
if I <> CurrentPos then
|
||||
DataSet.MoveBy(I - CurrentPos);
|
||||
CurrentPos := I;
|
||||
CurrentValue := GetCurrentStr;
|
||||
if UpStr(Value) > CurrentValue then
|
||||
L := I + 1
|
||||
else
|
||||
begin
|
||||
H := I - 1;
|
||||
if UpStr(Value) = CurrentValue then
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
if Result then
|
||||
begin
|
||||
if L <> CurrentPos then
|
||||
DataSet.MoveBy(L - CurrentPos);
|
||||
while (L < DataSet.RecordCount) and
|
||||
(UpStr(Value) <> GetCurrentStr) do
|
||||
begin
|
||||
Inc(L);
|
||||
DataSet.MoveBy(1);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := True;
|
||||
if not Result then
|
||||
SetToBookmark(DataSet, BookMk);
|
||||
finally
|
||||
DataSet.FreeBookmark(BookMk);
|
||||
DataSet.EnableControls;
|
||||
end;
|
||||
end
|
||||
else
|
||||
DatabaseErrorFmt(SFieldTypeMismatch, [Field.DisplayName]);
|
||||
end;
|
||||
|
||||
{ Save and restore DataSet Fields layout }
|
||||
|
||||
//function DataSetSectionName(DataSet: TDataSet): string;
|
||||
//begin
|
||||
// if (DataSet.Owner <> nil) and (DataSet.Owner is TCustomForm) then
|
||||
// Result := GetDefaultSection(DataSet.Owner as TCustomForm)
|
||||
// else
|
||||
// Result := DataSet.Name;
|
||||
//end;
|
||||
//
|
||||
//function CheckSection(DataSet: TDataSet; const Section: string): string;
|
||||
//begin
|
||||
// Result := Section;
|
||||
// if Result = '' then
|
||||
// Result := DataSetSectionName(DataSet);
|
||||
//end;
|
||||
//
|
||||
//procedure InternalSaveFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage; const Path: string);
|
||||
//var
|
||||
// I: Integer;
|
||||
// Field: TField;
|
||||
//begin
|
||||
// AppStorage.BeginUpdate;
|
||||
// try
|
||||
// for I := 0 to DataSet.FieldCount - 1 do
|
||||
// begin
|
||||
// Field := DataSet.Fields[i];
|
||||
// AppStorage.WriteString(AppStorage.ConcatPaths([CheckSection(DataSet, Path),
|
||||
// DataSet.Name + Field.FieldName]),
|
||||
// Format('%d,%d,%d', [Field.Index, Field.DisplayWidth, Integer(Field.Visible)]));
|
||||
// end;
|
||||
// finally
|
||||
// AppStorage.EndUpdate;
|
||||
// end;
|
||||
//end;
|
||||
//
|
||||
//procedure InternalRestoreFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage;
|
||||
// const Path: string; RestoreVisible: Boolean);
|
||||
//type
|
||||
// TFieldInfo = record
|
||||
// Field: TField;
|
||||
// EndIndex: Integer;
|
||||
// end;
|
||||
// TFieldArray = array of TFieldInfo;
|
||||
//const
|
||||
// Delims = [' ', ','];
|
||||
//var
|
||||
// I, J: Integer;
|
||||
// S: string;
|
||||
// FieldArray: TFieldArray;
|
||||
//begin
|
||||
// SetLength(FieldArray, DataSet.FieldCount);
|
||||
// AppStorage.BeginUpdate;
|
||||
// try
|
||||
// for I := 0 to DataSet.FieldCount - 1 do
|
||||
// begin
|
||||
// S := AppStorage.ReadString(AppStorage.ConcatPaths([CheckSection(DataSet, Path),
|
||||
// DataSet.Name + DataSet.Fields[I].FieldName]), '');
|
||||
// FieldArray[I].Field := DataSet.Fields[I];
|
||||
// FieldArray[I].EndIndex := DataSet.Fields[I].Index;
|
||||
// if S <> '' then
|
||||
// begin
|
||||
// FieldArray[I].EndIndex := StrToIntDef(ExtractWord(1, S, Delims),
|
||||
// FieldArray[I].EndIndex);
|
||||
// DataSet.Fields[I].DisplayWidth := StrToIntDef(ExtractWord(2, S, Delims),
|
||||
// DataSet.Fields[I].DisplayWidth);
|
||||
// if RestoreVisible then
|
||||
// DataSet.Fields[I].Visible := Boolean(StrToIntDef(ExtractWord(3, S, Delims),
|
||||
// Integer(DataSet.Fields[I].Visible)));
|
||||
// end;
|
||||
// end;
|
||||
// for I := 0 to DataSet.FieldCount - 1 do
|
||||
// begin
|
||||
// for J := 0 to DataSet.FieldCount - 1 do
|
||||
// begin
|
||||
// if FieldArray[J].EndIndex = I then
|
||||
// begin
|
||||
// FieldArray[J].Field.Index := FieldArray[J].EndIndex;
|
||||
// Break;
|
||||
// end;
|
||||
// end;
|
||||
// end;
|
||||
// finally
|
||||
// AppStorage.EndUpdate;
|
||||
// FieldArray := nil;
|
||||
// end;
|
||||
//end;
|
||||
//
|
||||
//procedure SaveFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage; const Path: string);
|
||||
//begin
|
||||
// InternalSaveFields(DataSet, AppStorage, AppStorage.ConcatPaths([Path, DataSetSectionName(DataSet)]));
|
||||
//end;
|
||||
//
|
||||
//procedure RestoreFields(DataSet: TDataSet; AppStorage: TJvCustomAppStorage; const Path: string;
|
||||
// RestoreVisible: Boolean);
|
||||
//begin
|
||||
// InternalRestoreFields(DataSet, AppStorage, AppStorage.ConcatPaths([DataSetSectionName(DataSet)]),
|
||||
// RestoreVisible);
|
||||
//end;
|
||||
|
||||
function ExtractFieldNameEx(const Fields: String;
|
||||
var Pos: Integer): string;
|
||||
begin
|
||||
Result := ExtractFieldName(Fields, Pos);
|
||||
end;
|
||||
|
||||
function IsDataSetEmpty(DataSet: TDataSet): Boolean;
|
||||
begin
|
||||
Result := (not DataSet.Active) or (DataSet.Eof and DataSet.Bof);
|
||||
end;
|
||||
|
||||
{ SQL expressions }
|
||||
|
||||
function DateToSQL(Value: TDateTime): string;
|
||||
begin
|
||||
Result := IntToStr(Trunc(Value));
|
||||
end;
|
||||
|
||||
function FormatSQLDateRange(Date1, Date2: TDateTime;
|
||||
const FieldName: string): string;
|
||||
begin
|
||||
Result := TrueExpr;
|
||||
if (Date1 = Date2) and (Date1 <> NullDate) then
|
||||
begin
|
||||
Result := Format('%s = %s', [FieldName, FormatDateTime(ServerDateFmt,
|
||||
Date1)]);
|
||||
end
|
||||
else
|
||||
if (Date1 <> NullDate) or (Date2 <> NullDate) then
|
||||
begin
|
||||
if Date1 = NullDate then
|
||||
Result := Format('%s < %s', [FieldName,
|
||||
FormatDateTime(ServerDateFmt, IncDay(Date2, 1))])
|
||||
else
|
||||
if Date2 = NullDate then
|
||||
Result := Format('%s > %s', [FieldName,
|
||||
FormatDateTime(ServerDateFmt, IncDay(Date1, -1))])
|
||||
else
|
||||
Result := Format('(%s < %s) AND (%s > %s)',
|
||||
[FieldName, FormatDateTime(ServerDateFmt, IncDay(Date2, 1)),
|
||||
FieldName, FormatDateTime(ServerDateFmt, IncDay(Date1, -1))]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function FormatSQLDateRangeEx(Date1, Date2: TDateTime;
|
||||
const FieldName: string): string;
|
||||
begin
|
||||
Result := TrueExpr;
|
||||
if (Date1 <> NullDate) or (Date2 <> NullDate) then
|
||||
begin
|
||||
if Date1 = NullDate then
|
||||
Result := Format('%s < %s', [FieldName,
|
||||
FormatDateTime(ServerDateFmt, IncDay(Date2, 1))])
|
||||
else
|
||||
if Date2 = NullDate then
|
||||
Result := Format('%s >= %s', [FieldName,
|
||||
FormatDateTime(ServerDateFmt, Date1)])
|
||||
else
|
||||
Result := Format('(%s < %s) AND (%s >= %s)',
|
||||
[FieldName, FormatDateTime(ServerDateFmt, IncDay(Date2, 1)),
|
||||
FieldName, FormatDateTime(ServerDateFmt, Date1)]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function FormatSQLNumericRange(const FieldName: string;
|
||||
LowValue, HighValue, LowEmpty, HighEmpty: Double; Inclusive: Boolean): string;
|
||||
const
|
||||
Operators: array[Boolean, 1..2] of string[2] = (('>', '<'), ('>=', '<='));
|
||||
begin
|
||||
Result := TrueExpr;
|
||||
if (LowValue = HighValue) and (LowValue <> LowEmpty) then
|
||||
Result := Format('%s = %g', [FieldName, LowValue])
|
||||
else
|
||||
if (LowValue <> LowEmpty) or (HighValue <> HighEmpty) then
|
||||
begin
|
||||
if LowValue = LowEmpty then
|
||||
Result := Format('%s %s %g', [FieldName, Operators[Inclusive, 2], HighValue])
|
||||
else
|
||||
if HighValue = HighEmpty then
|
||||
Result := Format('%s %s %g', [FieldName, Operators[Inclusive, 1], LowValue])
|
||||
else
|
||||
Result := Format('(%s %s %g) AND (%s %s %g)',
|
||||
[FieldName, Operators[Inclusive, 2], HighValue,
|
||||
FieldName, Operators[Inclusive, 1], LowValue]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function StrMaskSQL(const Value: string): string;
|
||||
begin
|
||||
if (Pos('*', Value) = 0) and (Pos('?', Value) = 0) and (Value <> '') then
|
||||
Result := '*' + Value + '*'
|
||||
else
|
||||
Result := Value;
|
||||
end;
|
||||
|
||||
function FormatSQLCondition(const FieldName, AOperator, Value: string;
|
||||
FieldType: TFieldType; Exact: Boolean): string;
|
||||
var
|
||||
EmptyValue: Boolean;
|
||||
FieldValue: string;
|
||||
DateValue: TDateTime;
|
||||
LogicOperator: string;
|
||||
begin
|
||||
FieldValue := '';
|
||||
DateValue := NullDate;
|
||||
Exact := Exact or not (FieldType in
|
||||
[ftString{$IFDEF UNICODE}, ftWideString{$ENDIF UNICODE}, ftDate, ftTime, ftDateTime]);
|
||||
if FieldType in [ftDate, ftTime, ftDateTime] then
|
||||
begin
|
||||
DateValue := StrToDateDef(Value, NullDate);
|
||||
EmptyValue := (DateValue = NullDate);
|
||||
FieldValue := FormatDateTime(ServerDateFmt, DateValue);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FieldValue := Value;
|
||||
EmptyValue := FieldValue = '';
|
||||
if not (Exact or EmptyValue) then
|
||||
FieldValue := ReplaceStr(ReplaceStr(StrMaskSQL(FieldValue),
|
||||
'*', '%'), '?', '_');
|
||||
if FieldType in [ftString{$IFDEF UNICODE}, ftWideString{$ENDIF UNICODE}] then
|
||||
FieldValue := '''' + FieldValue + '''';
|
||||
end;
|
||||
LogicOperator := AOperator;
|
||||
if LogicOperator = '' then
|
||||
begin
|
||||
if Exact then
|
||||
LogicOperator := '='
|
||||
else
|
||||
begin
|
||||
if FieldType in [ftString{$IFDEF UNICODE}, ftWideString{$ENDIF UNICODE}] then
|
||||
LogicOperator := 'LIKE'
|
||||
else
|
||||
LogicOperator := '>=';
|
||||
end;
|
||||
end;
|
||||
if EmptyValue then
|
||||
Result := TrueExpr
|
||||
else
|
||||
if (FieldType = ftDateTime) and Exact then
|
||||
begin
|
||||
DateValue := IncDay(DateValue, 1);
|
||||
Result := Format('(%s >= %s) and (%s < %s)', [FieldName, FieldValue,
|
||||
FieldName, FormatDateTime(ServerDateFmt, DateValue)]);
|
||||
end
|
||||
else
|
||||
Result := Format('%s %s %s', [FieldName, LogicOperator, FieldValue]);
|
||||
end;
|
||||
|
||||
function FormatAnsiSQLCondition(const FieldName, AOperator, Value: string;
|
||||
FieldType: TFieldType; Exact: Boolean): string;
|
||||
var
|
||||
S, Esc: string;
|
||||
begin
|
||||
Esc := '';
|
||||
if not Exact and (FieldType in [ftString{$IFDEF UNICODE}, ftWideString{$ENDIF UNICODE}]) then
|
||||
begin
|
||||
S := ReplaceStr(ReplaceStr(ReplaceStr(Value, '/', '//'),
|
||||
'_', '/_'), '%', '/%');
|
||||
if S <> Value then
|
||||
Esc := ' ESCAPE''/''';
|
||||
end
|
||||
else
|
||||
S := Value;
|
||||
Result := FormatSQLCondition(FieldName, AOperator, S, FieldType, Exact) + Esc;
|
||||
end;
|
||||
|
||||
procedure CheckRequiredField(Field: TField);
|
||||
begin
|
||||
if not Field.ReadOnly and not Field.Calculated and Field.IsNull then
|
||||
begin
|
||||
Field.FocusControl;
|
||||
DatabaseErrorFmt(SNeedField, [Field.DisplayName]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CheckRequiredFields(const Fields: array of TField);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := Low(Fields) to High(Fields) do
|
||||
CheckRequiredField(Fields[I]);
|
||||
end;
|
||||
|
||||
type
|
||||
TDataSetAccess = class(TDataSet);
|
||||
|
||||
procedure GotoBookmarkEx(DataSet: TDataSet; const Bookmark: TBookmark; Mode: TResyncMode; ForceScrollEvents: Boolean);
|
||||
var
|
||||
DS: TDataSetAccess;
|
||||
begin
|
||||
if (DataSet <> nil) and (Bookmark <> nil) then
|
||||
begin
|
||||
DS := TDataSetAccess(DataSet);
|
||||
DS.CheckBrowseMode;
|
||||
if ForceScrollEvents or (rmCenter in Mode) then DS.DoBeforeScroll;
|
||||
DS.InternalGotoBookmark(Pointer(Bookmark));
|
||||
DS.Resync(Mode);
|
||||
if ForceScrollEvents or (rmCenter in Mode) then DS.DoAfterScroll;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AssignRecord(Source, Dest: TDataSet; ByName: Boolean);
|
||||
var
|
||||
I: Integer;
|
||||
F, FSrc: TField;
|
||||
begin
|
||||
if not (Dest.State in dsEditModes) then
|
||||
_DBError(SNotEditing);
|
||||
if ByName then
|
||||
begin
|
||||
for I := 0 to Source.FieldCount - 1 do
|
||||
begin
|
||||
F := Dest.FindField(Source.Fields[I].FieldName);
|
||||
FSrc := Source.Fields[i];
|
||||
if (F <> nil) and (F.DataType <> ftAutoInc) then
|
||||
begin
|
||||
if FSrc.IsNull then
|
||||
F.Value := FSrc.Value
|
||||
else
|
||||
case F.DataType of
|
||||
ftString: F.AsString := FSrc.AsString;
|
||||
ftInteger: F.AsInteger := FSrc.AsInteger;
|
||||
ftBoolean: F.AsBoolean := FSrc.AsBoolean;
|
||||
ftFloat: F.AsFloat := FSrc.AsFloat;
|
||||
ftCurrency: F.AsCurrency := FSrc.AsCurrency;
|
||||
ftDate: F.AsDateTime := FSrc.AsDateTime;
|
||||
ftDateTime: F.AsDateTime := FSrc.AsDateTime;
|
||||
else
|
||||
F.Value := FSrc.Value;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
for I := 0 to Min(Source.FieldDefs.Count - 1, Dest.FieldDefs.Count - 1) do
|
||||
begin
|
||||
F := Dest.FindField(Dest.FieldDefs[I].Name);
|
||||
FSrc := Source.FindField(Source.FieldDefs[I].Name);
|
||||
if (F <> nil) and (FSrc <> nil) and (F.DataType <> ftAutoInc) then
|
||||
begin
|
||||
if FSrc.IsNull then
|
||||
F.Value := FSrc.Value
|
||||
else
|
||||
case F.DataType of
|
||||
ftString: F.AsString := FSrc.AsString;
|
||||
ftInteger: F.AsInteger := FSrc.AsInteger;
|
||||
ftBoolean: F.AsBoolean := FSrc.AsBoolean;
|
||||
ftFloat: F.AsFloat := FSrc.AsFloat;
|
||||
ftCurrency: F.AsCurrency := FSrc.AsCurrency;
|
||||
ftDate: F.AsDateTime := FSrc.AsDateTime;
|
||||
ftDateTime: F.AsDateTime := FSrc.AsDateTime;
|
||||
else
|
||||
F.Value := FSrc.Value;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user