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
|
uses
|
||||||
Classes, JvDsgnConsts, //JvDBSearchCombobox,
|
Classes, JvDsgnConsts, //JvDBSearchCombobox,
|
||||||
JvDBSearchEdit, JvDBTreeView, JvDBControls, JvDBHTLabel;
|
JvDBSearchEdit, JvDBTreeView, JvDBControls, JvDBHTLabel, JvDBLookup;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
const
|
const
|
||||||
@ -42,7 +42,8 @@ begin
|
|||||||
TJvDBSearchEdit,
|
TJvDBSearchEdit,
|
||||||
// TJvDBSearchCombobox,
|
// TJvDBSearchCombobox,
|
||||||
TJvDBTreeView,
|
TJvDBTreeView,
|
||||||
TJvDBHTLabel
|
TJvDBHTLabel,
|
||||||
|
TJvDBLookupList, TJvDBLookupCombo
|
||||||
]);
|
]);
|
||||||
|
|
||||||
RegisterPropertyEditor(TypeInfo(string), TJvDBTreeView, cItemField, TFieldProperty); //TJvDataFieldProperty);
|
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. "/>
|
<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"/>
|
<Version Major="1" Release="4"/>
|
||||||
<Files Count="4">
|
<Files Count="6">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="..\run\JvDB\JvDBHTLabel.pas"/>
|
<Filename Value="..\run\JvDB\JvDBHTLabel.pas"/>
|
||||||
<UnitName Value="JvDBHTLabel"/>
|
<UnitName Value="JvDBHTLabel"/>
|
||||||
@ -36,6 +36,14 @@
|
|||||||
<Filename Value="..\run\JvDB\JvDBControls.pas"/>
|
<Filename Value="..\run\JvDB\JvDBControls.pas"/>
|
||||||
<UnitName Value="JvDBControls"/>
|
<UnitName Value="JvDBControls"/>
|
||||||
</Item4>
|
</Item4>
|
||||||
|
<Item5>
|
||||||
|
<Filename Value="..\run\JvDB\jvdblookup.pas"/>
|
||||||
|
<UnitName Value="JvDBLookup"/>
|
||||||
|
</Item5>
|
||||||
|
<Item6>
|
||||||
|
<Filename Value="..\run\JvDB\jvdbutils.pas"/>
|
||||||
|
<UnitName Value="JvDBUtils"/>
|
||||||
|
</Item6>
|
||||||
</Files>
|
</Files>
|
||||||
<RequiredPkgs Count="4">
|
<RequiredPkgs Count="4">
|
||||||
<Item1>
|
<Item1>
|
||||||
|
|||||||
Binary file not shown.
@ -339,6 +339,7 @@ type
|
|||||||
{**** string handling routines}
|
{**** string handling routines}
|
||||||
TSetOfChar = TSysCharSet;
|
TSetOfChar = TSysCharSet;
|
||||||
TCharSet = TSysCharSet;
|
TCharSet = TSysCharSet;
|
||||||
|
***********)
|
||||||
|
|
||||||
TDateOrder = (doMDY, doDMY, doYMD);
|
TDateOrder = (doMDY, doDMY, doYMD);
|
||||||
TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
|
TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
|
||||||
@ -350,6 +351,7 @@ const
|
|||||||
CenturyOffset: Byte = 60;
|
CenturyOffset: Byte = 60;
|
||||||
NullDate: TDateTime = 0; {-693594}
|
NullDate: TDateTime = 0; {-693594}
|
||||||
|
|
||||||
|
(*********** NOT CONVERTED
|
||||||
type
|
type
|
||||||
// JvDriveCtrls / JvLookOut
|
// JvDriveCtrls / JvLookOut
|
||||||
TJvImageSize = (isSmall, isLarge);
|
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