mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-21 03:39:18 +02:00
LCL, implements TDBLookupCombobox and TDBLookupListBox from Leslie Kaye, issue #1719
git-svn-id: trunk@18468 -
This commit is contained in:
jesus
parent
ace2f932cb
commit
cdf16d4ab8
7
.gitattributes
vendored
7
.gitattributes
vendored
@ -2990,6 +2990,8 @@ images/components/tdbgrid.png -text svneol=unset#image/png
|
||||
images/components/tdbgroupbox.png -text svneol=unset#image/png
|
||||
images/components/tdbimage.png -text svneol=unset#image/png
|
||||
images/components/tdblistbox.png -text svneol=unset#image/png
|
||||
images/components/tdblookupcombobox.png -text svneol=unset#image/png
|
||||
images/components/tdblookuplistbox.png -text svneol=unset#image/png
|
||||
images/components/tdbmemo.png -text svneol=unset#image/png
|
||||
images/components/tdbnavigator.png -text svneol=unset#image/png
|
||||
images/components/tdbradiogroup.png -text svneol=unset#image/png
|
||||
@ -3516,6 +3518,8 @@ lcl/include/customcheckbox.inc svneol=native#text/pascal
|
||||
lcl/include/customcheckgroup.inc svneol=native#text/pascal
|
||||
lcl/include/customcombobox.inc svneol=native#text/pascal
|
||||
lcl/include/customcontrol.inc svneol=native#text/pascal
|
||||
lcl/include/customdbcombobox.inc svneol=native#text/plain
|
||||
lcl/include/customdblistbox.inc svneol=native#text/plain
|
||||
lcl/include/customdockform.inc svneol=native#text/pascal
|
||||
lcl/include/customedit.inc svneol=native#text/pascal
|
||||
lcl/include/customform.inc svneol=native#text/pascal
|
||||
@ -3542,6 +3546,9 @@ lcl/include/dbedit.inc svneol=native#text/pascal
|
||||
lcl/include/dbgroupbox.inc svneol=native#text/pascal
|
||||
lcl/include/dbimage.inc svneol=native#text/pascal
|
||||
lcl/include/dblistbox.inc svneol=native#text/pascal
|
||||
lcl/include/dblookup.inc svneol=native#text/plain
|
||||
lcl/include/dblookupcombobox.inc svneol=native#text/plain
|
||||
lcl/include/dblookuplistbox.inc svneol=native#text/plain
|
||||
lcl/include/dbmemo.inc svneol=native#text/pascal
|
||||
lcl/include/dbradiogroup.inc svneol=native#text/pascal
|
||||
lcl/include/dbtext.inc svneol=native#text/pascal
|
||||
|
||||
@ -24,7 +24,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, ObjInspStrConsts, PropEdits, Componenteditors, TypInfo, DB, SysUtils,
|
||||
DBGrids;
|
||||
DbCtrls, DBGrids;
|
||||
|
||||
type
|
||||
TFieldProperty = class(TStringPropertyEditor)
|
||||
@ -34,6 +34,13 @@ type
|
||||
procedure FillValues(const Values: TStringList); virtual;
|
||||
end;
|
||||
|
||||
{ TLookupFieldProperty }
|
||||
|
||||
TLookupFieldProperty = class(TFieldProperty)
|
||||
public
|
||||
procedure FillValues(const Values: TStringList); override;
|
||||
end;
|
||||
|
||||
TDBGridFieldProperty = class(TFieldProperty)
|
||||
public
|
||||
procedure FillValues(const Values: TStringList); override;
|
||||
@ -120,8 +127,23 @@ begin
|
||||
if Assigned(Hook) then Hook.Modified(Self);
|
||||
end;
|
||||
|
||||
{ TLookupFieldProperty }
|
||||
|
||||
procedure TLookupFieldProperty.FillValues(const Values: TStringList);
|
||||
var
|
||||
DataSource: TDataSource;
|
||||
begin
|
||||
DataSource := GetObjectProp(GetComponent(0), 'ListSource') as TDataSource;
|
||||
if (DataSource is TDataSource) and Assigned(DataSource.DataSet) then
|
||||
DataSource.DataSet.GetFieldNames(Values);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPropertyEditor(TypeInfo(string), TComponent, 'DataField', TFieldProperty);
|
||||
RegisterPropertyEditor(TypeInfo(string), TDBLookupListBox, 'KeyField', TLookupFieldProperty);
|
||||
RegisterPropertyEditor(TypeInfo(string), TDBLookupListBox, 'ListField', TLookupFieldProperty);
|
||||
RegisterPropertyEditor(TypeInfo(string), TDBLookupComboBox, 'KeyField', TLookupFieldProperty);
|
||||
RegisterPropertyEditor(TypeInfo(string), TDBLookupComboBox, 'ListField', TLookupFieldProperty);
|
||||
RegisterPropertyEditor(TypeInfo(string), TColumn, 'FieldName', TDBGridFieldProperty);
|
||||
RegisterComponentEditor(TDBGrid,TDBGridComponentEditor);
|
||||
|
||||
|
||||
BIN
images/components/tdblookupcombobox.png
Normal file
BIN
images/components/tdblookupcombobox.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 717 B |
BIN
images/components/tdblookuplistbox.png
Normal file
BIN
images/components/tdblookuplistbox.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 732 B |
@ -537,6 +537,37 @@ LazarusResources.Add('tdbcombobox','PNG',[
|
||||
+'nd'#179'4'#192#8#166')'#252#15':'#201#17#229#236#26'Q'#139#241'@'#222#0#0#0
|
||||
+#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('tdblookupcombobox','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
|
||||
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#217#1#23#22
|
||||
+#26'8'#137#207'<V'#0#0#2'MIDATH'#199#181#150'_HSQ'#28#199'?g'#13'G'#145'z1'
|
||||
+#220#22'Q'#226'@'#240#193'? '#13#178#17#133#246' '#17'h'#15#131#129'o'#129
|
||||
+#250#16#129#15#225'.'#238'Y'#154#209#131'Q'#4':'#168#151#4#193' '#130#213#131
|
||||
+'X*'#180#151#17'#'#214#31#2'aQ"'#200#8#155'f'#224'F'#219#233'!'#238'e'#238
|
||||
+#221'?'#240#251't'#238#229#156#239#247#252#190#223#223'9'#28'!'#165#228'(a'#5
|
||||
+#200#230#254#139',Gvd('#156'0'#156'8v'#221#133#215#227#20#0#199','#2#0'ubB'
|
||||
+#206'., '#165#20#0'B'#8#233#31#31'''8?/'#10#4#242#137#31#220#234#165#235#220
|
||||
+'I>'#253'8 '#153'J'#147#220#203#144'L'#165#9#133#19#132#194#9#153'/T'#13#132
|
||||
+#148#146'AD'#246't'#180#208#238'8NW[#v'#197'V@'#158#220#203#240#231'0'#203
|
||||
+#193#225'_'#18'['#251#172#220#189'XP'#137#16'B'#2'z%%'#22#185#206'6'#17#223
|
||||
+#220'%'#190#9'v'#197#5'PB'#30#223#220'E'#155#171#239#174#136#216'H'#200#170
|
||||
+#13#250#187'['#177'77`'#150'Aw'#171'^E'#205'!'#223#254#141'C'#177#1#16#24
|
||||
+#237'd'#160#231'TI'#6#201#189#12#0#137#173'}}q'#177'%'#166#22#181#157'i$'#250
|
||||
+#249''''#217#156#164#171#173#19#128'g'#143#159#150#236#198#6#184#5#4#166'ce{'
|
||||
+'[UG'#175'(J'#203#134#30#242#216#163#143#210#161#216#176'77'#240#242#221'6'#0
|
||||
+'n'#17'#'#24#188']'#149#13#170#250#144#201#201#27#250#247#220#220#11']'#196
|
||||
+#212'"U'#141#1#208#215'w'#190',y,'#246'^'#31#251'|'#163',--'#2#176#190#17']'
|
||||
+#31#25#30#18#166#22#25#17'T'#130'F^r'#14#204','#210'`'#177#252'B'#136#180')q'
|
||||
+'.'#215#132#148''''#10#254']'#232#239'@'#175#192#184#139'z'#245#238#249#240
|
||||
+#234'y'#213'yh'#153#20't'#209#205'k'#237'<y'#253#205#208#162'|T'#202#195#200
|
||||
+'R+'#128#215#227#20'^'#143#147#229#200#142#156'Y'#252#202'L'#145#149'nQ{'#30
|
||||
+#5#2#218#157#226#187'tZx='#206#146'I'#129#233#152'|'#187#250#166#254#235':'
|
||||
+#31#154#152#17#238'L'#249'+'#18#222#191'7[^'#160#150#197'uU`'#134#129#171#131
|
||||
+'U'#147#174#172'~'#169#175#130#186#187#168'Z'#212#221'E'#181#30#158'Z '#170
|
||||
+'}U'#164'R'#187#151#215#214#162#235#250'BK'#229'5#'#195'CB'#28#245#179#229#31
|
||||
+'}'#248'"'#242'f'#254''#27#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('tdbedit','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
|
||||
@ -677,6 +708,38 @@ LazarusResources.Add('tdblistbox','PNG',[
|
||||
+' '#222'&'#147'W'#172'9'#243':'#157'n'#179'|'#7'U'#230#15#21'jH'#31#206#211
|
||||
+'J'#173#0#0#0#0'IEND'#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('tdblookuplistbox','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#0#1'sRGB'#0#174#206#28#233#0#0#0#6'bKGD'#0#255#0#255#0#255#160#189#167#147
|
||||
+#0#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#7'tIME'#7#217#1#23#22
|
||||
+#28#23'tD'#166#137#0#0#2'\IDATH'#199#181'TMh'#19'a'#16'}'#31'.'#17#15#154'R'
|
||||
+#205'O'#15'R'#218#26#168#216#164'$Tk'#8#189'$'#20#169'x(H'#160#144#155#208
|
||||
+#156#244#218','#180'x'#144#22#246'*z'#11'xKr(B'#145#160#24#244#18#26#180'"'#9
|
||||
+'1'#245#7'J'#183#196'b('#177'HmRH'#165#201'x'#136#187#205'f'#147#236#166#234
|
||||
+'\'#246#155#221#225#205#190'7'#239#27'V'#171#213#192#24#131#222' '#162#174
|
||||
+#234'9'#198#24#170'5'#2#0','#167'v('#28#23'['#22#206#222#26#132#223'ce'#0'pJ'
|
||||
+'?~'#253#143'b'#201#2'y'#231'V'#201';'#183'J'#185'|'#137#136#136'r'#249#18
|
||||
+#189#206#238'R,Y'#160#135#207#182#228#239#177'd'#129#136#8'D'#132'P0Hu'#136
|
||||
+'z'#14#128'B'#193#160#156#19#17'8'#0#8#199'E8l'#189#24#176#156'Aq'#239#16#235
|
||||
+#0#138'{'#135'('#254#252'%?'#29#182'^'#148'+G'#8#199'E'#204'L'#244#233'&'#192
|
||||
+#136#8#179#143's$n'#239#203'R'#152#141#6#5#248'A'#165#138#15#27'?'#0#0#131#23
|
||||
+#207'!|'#215#174#16#137'1F'#212'P'#137#199'I'#7#183#221#4#179#209#128'v3p'
|
||||
+#219'M8'#168'TQ'#174#28#181#5'n'#213#136#3#0'q{'#31#150#30#19#0'`>0'#12#175
|
||||
+#227'<'#214#191#150'U2I'#181#221#4''''#209'~'#247'q'#23#213#26'a'#164''#184
|
||||
+'e'#225#155#220'wY'#162#6#131#176'&'#195#180#151#232#218#149#11'0'#27#13'X'
|
||||
+#138'|'#193'RD'#159'D'#186#135#236#11#165'H'#154#193'H'#255'Y'#133'D'#137'h'
|
||||
+#20''''#137'@`'#10'v'#251'%'#166'K"'#158#15'h'#2#10'BDQ'''#8#17#8#194'=m'#137
|
||||
+#174'6'#168':=}['#5#188#178#242'T'#145'_'#31#31#199#219#181'5'#229#12#242#223
|
||||
+'J'#176#244#156'n'#233#162'D4'#221#22#172'U4'#130#203#13#238#220#28#192#147
|
||||
+#231'['#29']'#164#135#129' '#168#221#193#17#17#252#30'+'#243'{'#172'XN'#237
|
||||
+'P'''#137#180#24#220#152#186#12#231#168#11#153'l'#26'/_|>'#222#166#210'v'#156
|
||||
+#153#232'c'#205'{'#134#231#211#148'~'#159#209#229#28#9#220'9'#234':n'#208#141
|
||||
+#245#30',.'#170#222#221'_X'#144#207#18'x&'#155'V_4='#209#8#246'O'#25#184#198
|
||||
+#156#154'5'#137'W'#159#228'!K'#224']3'#208'rQ'#243'E'#235#186#129#158'{04d'
|
||||
+#195#230#230#198#255'a'#0'@'#1'./'#187'N'#193#243#143#232'$'#203#206#231#27
|
||||
+#195#228#164#155'i6'#248#219#248#13#195#166'\'#225#136'^L'#179#0#0#0#0'IEND'
|
||||
+#174'B`'#130
|
||||
]);
|
||||
LazarusResources.Add('tdbmemo','PNG',[
|
||||
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
|
||||
+#0#2#158'IDATx^'#181#148']HSa'#24#199#255#239'>'#220#154'17k'#155'"b'#13'2'
|
||||
|
||||
@ -24,11 +24,13 @@ components/tdateedit.png
|
||||
components/tdbcalendar.png
|
||||
components/tdbcheckbox.png
|
||||
components/tdbcombobox.png
|
||||
components/tdblookupcombobox.png
|
||||
components/tdbedit.png
|
||||
components/tdbgrid.png
|
||||
components/tdbgroupbox.png
|
||||
components/tdbimage.png
|
||||
components/tdblistbox.png
|
||||
components/tdblookuplistbox.png
|
||||
components/tdbmemo.png
|
||||
components/tdbnavigator.png
|
||||
components/tdbradiogroup.png
|
||||
|
||||
260
lcl/dbctrls.pp
260
lcl/dbctrls.pp
@ -39,7 +39,7 @@ uses
|
||||
Classes, SysUtils, DB,
|
||||
LCLStrConsts, LCLProc, LMessages, LCLType, LResources, GraphType,
|
||||
Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, MaskEdit, ExtCtrls,
|
||||
Calendar, Chart;
|
||||
Calendar, Chart, Variants;
|
||||
|
||||
Type
|
||||
{ TFieldDataLink }
|
||||
@ -113,6 +113,56 @@ Type
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ TDBLookup }
|
||||
{
|
||||
TDBLookup component is typically owned by a Lookup control like
|
||||
TDBLookupListBox or TDBLookupComboBox.
|
||||
The ListSource is the other dataset TDataSource from which to retrieve the lookup data
|
||||
The KeyField is the lookup key in the ListSource which corresponds to the DataField value
|
||||
The ListField is the name of the field in the ListSource to list into the
|
||||
Items property of the lookup control.
|
||||
which data
|
||||
}
|
||||
|
||||
TDBLookup = class(TComponent)
|
||||
private
|
||||
FLinkBookMark: TBookMark;
|
||||
FControlLink: TFieldDataLink;
|
||||
FControlItems: TStrings;
|
||||
FHasLookUpField: Boolean;
|
||||
FListLink: TFieldDataLink;
|
||||
FListSource: TDataSource;
|
||||
FKeyFieldName: string;
|
||||
FKeyFieldValue: string;
|
||||
FListFieldName: string;
|
||||
FListFieldValue: string;
|
||||
FListFieldIndex: Integer;
|
||||
FKeyField: TField;
|
||||
FListField: TField;
|
||||
procedure ActiveChange(Sender: TObject);
|
||||
procedure EditingChange(Sender: TObject);
|
||||
procedure FetchLookupData;
|
||||
procedure LinkGetBookMark;
|
||||
procedure LinkGotoBookMark;
|
||||
function GetKeyFieldName: string;
|
||||
function GetListSource: TDataSource;
|
||||
procedure SetKeyFieldName(const Value: string);
|
||||
procedure SetListSource(Value: TDataSource);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Initialize(AControlDataLink: TFieldDataLink; AControlItems: TStrings);
|
||||
function KeyFieldValueOf(const AListFieldValue: string): string;
|
||||
function ListFieldValueOf(const AKeyFieldValue: string): string;
|
||||
// properties to be published by owner control
|
||||
// these are not used where data control Field is dbLookup
|
||||
property KeyField: string read GetKeyFieldName write SetKeyFieldName;
|
||||
property ListField: string read FListFieldName write FListFieldName;
|
||||
property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
|
||||
property ListSource: TDataSource read GetListSource write SetListSource;
|
||||
end;
|
||||
|
||||
{ TDBEdit }
|
||||
|
||||
TDBEdit = class(TCustomMaskEdit)
|
||||
@ -257,12 +307,9 @@ Type
|
||||
|
||||
{ TDBListBox }
|
||||
|
||||
TDBListBox = class(TCustomListBox)
|
||||
FDataLink: TFieldDataLink;
|
||||
TCustomDBListBox = class(TCustomListBox)
|
||||
|
||||
procedure DataChange(Sender: TObject);
|
||||
procedure EditingChange(Sender: TObject);
|
||||
procedure UpdateData(Sender: TObject);
|
||||
procedure FocusRequest(Sender: TObject);
|
||||
|
||||
function GetDataField: string;
|
||||
@ -278,11 +325,14 @@ Type
|
||||
procedure SetDataSource(Value: TDataSource);
|
||||
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||
protected
|
||||
FDataLink: TFieldDataLink;
|
||||
procedure DataChange(Sender: TObject); virtual;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
|
||||
procedure Loaded; override;
|
||||
procedure Notification(AComponent: TComponent;
|
||||
Operation: TOperation); override;
|
||||
procedure UpdateData(Sender: TObject); virtual;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -290,7 +340,6 @@ Type
|
||||
procedure EditingDone; override;
|
||||
|
||||
property Field: TField read GetField;
|
||||
published
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
|
||||
@ -301,15 +350,25 @@ Type
|
||||
|
||||
//same as dbedit need to match the datalink status
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
||||
end;
|
||||
|
||||
|
||||
TDBListBox = class(TCustomDBListBox)
|
||||
protected
|
||||
procedure DataChange(Sender: TObject); override;
|
||||
procedure UpdateData(Sender: TObject); override;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property BorderStyle;
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property ExtendedSelect;
|
||||
property ItemHeight;
|
||||
property Items;
|
||||
property MultiSelect;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
@ -329,6 +388,7 @@ Type
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentShowHint;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property Sorted;
|
||||
property Style;
|
||||
@ -339,6 +399,72 @@ Type
|
||||
end;
|
||||
|
||||
|
||||
{ TDBLookupListBox }
|
||||
|
||||
TDBLookupListBox = class(TCustomDBListBox)
|
||||
private
|
||||
FLookup: TDBLookup;
|
||||
procedure ActiveChange(Sender: TObject);
|
||||
function GetKeyField: string;
|
||||
function GetListField: string;
|
||||
function GetListFieldIndex: Integer;
|
||||
function GetListSource: TDataSource;
|
||||
procedure SetKeyField(const Value: string);
|
||||
procedure SetListField(const Value: string);
|
||||
procedure SetListFieldIndex(const Value: Integer);
|
||||
procedure SetListSource(const Value: TDataSource);
|
||||
protected
|
||||
procedure DataChange(Sender: TObject); override;
|
||||
procedure Loaded; override;
|
||||
procedure UpdateData(Sender: TObject); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property BorderStyle;
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
// property ExtendedSelect;
|
||||
// property ItemHeight;
|
||||
property KeyField: string read GetKeyField write SetKeyField;
|
||||
property ListField: string read GetListField write SetListField;
|
||||
property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
|
||||
property ListSource: TDataSource read GetListSource write SetListSource;
|
||||
// property MultiSelect;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
// property OnDrawItem;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyPress;
|
||||
property OnKeyDown;
|
||||
property OnKeyUp;
|
||||
property OnMouseMove;
|
||||
property OnMouseDown;
|
||||
property OnMouseUp;
|
||||
property OnResize;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property Sorted;
|
||||
// property Style;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property TopIndex;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
|
||||
{ TDBRadioGroup }
|
||||
|
||||
TDBRadioGroup = class(TCustomRadioGroup)
|
||||
@ -478,9 +604,9 @@ Type
|
||||
end;
|
||||
|
||||
|
||||
{ TDBComboBox }
|
||||
{ TCustomDBComboBox }
|
||||
|
||||
TDBComboBox = class(TCustomComboBox)
|
||||
TCustomDBComboBox = class(TCustomComboBox)
|
||||
private
|
||||
FDataLink: TFieldDataLink;
|
||||
function GetDataField: string;
|
||||
@ -501,7 +627,7 @@ Type
|
||||
procedure UpdateData(Sender: TObject); virtual;
|
||||
procedure FocusRequest(Sender: TObject); virtual;
|
||||
procedure Loaded; override;
|
||||
procedure UpdateText;
|
||||
procedure UpdateText; virtual;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -509,6 +635,18 @@ Type
|
||||
property Field: TField read GetField;
|
||||
property Text;
|
||||
property ItemIndex;
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
||||
end;
|
||||
|
||||
|
||||
{ TDBComboBox }
|
||||
|
||||
TDBComboBox = class(TCustomDBComboBox)
|
||||
protected
|
||||
procedure UpdateData(Sender: TObject); override;
|
||||
procedure UpdateText; override;
|
||||
published
|
||||
property Anchors;
|
||||
property ArrowKeysTraverseList;
|
||||
@ -517,8 +655,8 @@ Type
|
||||
property BorderSpacing;
|
||||
property Color;
|
||||
property Ctl3D;
|
||||
property DataField: string read GetDataField write SetDataField;
|
||||
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property DropDownCount;
|
||||
@ -554,7 +692,7 @@ Type
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property Sorted;
|
||||
property Style;
|
||||
@ -562,8 +700,87 @@ Type
|
||||
property TabStop;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{ TDBLookupComboBox }
|
||||
|
||||
TDBLookupComboBox = class(TCustomDBComboBox)
|
||||
private
|
||||
FLookup: TDBLookup;
|
||||
procedure ActiveChange(Sender: TObject);
|
||||
function GetKeyField: string;
|
||||
function GetListField: string;
|
||||
function GetListFieldIndex: Integer;
|
||||
function GetListSource: TDataSource;
|
||||
procedure SetKeyField(const Value: string);
|
||||
procedure SetListField(const Value: string);
|
||||
procedure SetListFieldIndex(const Value: Integer);
|
||||
procedure SetListSource(const Value: TDataSource);
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
procedure UpdateData(Sender: TObject); override;
|
||||
procedure UpdateText; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property ArrowKeysTraverseList;
|
||||
property AutoDropDown;
|
||||
property AutoSize;
|
||||
property BorderSpacing;
|
||||
property Color;
|
||||
property Ctl3D;
|
||||
property DataField;
|
||||
property DataSource;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property DropDownCount;
|
||||
property Enabled;
|
||||
property Font;
|
||||
// property ItemHeight;
|
||||
// property ItemWidth;
|
||||
property KeyField: string read GetKeyField write SetKeyField;
|
||||
property ListField: string read GetListField write SetListField;
|
||||
property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
|
||||
property ListSource: TDataSource read GetListSource write SetListSource;
|
||||
// property MaxLength default -1;
|
||||
property OnChange;
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
property OnCloseUp;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnDrawItem;
|
||||
property OnDropDown;
|
||||
property OnEditingDone;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnSelect;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentCtl3D;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property Sorted;
|
||||
property Style;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
{ TDBMemo }
|
||||
|
||||
TDBMemo = class(TCustomMemo)
|
||||
@ -1097,8 +1314,8 @@ end;
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Data Controls',[TDBNavigator,TDBText,TDBEdit,TDBMemo,
|
||||
TDBImage,TDBListBox,TDBComboBox,TDBCheckBox,TDBRadioGroup,TDBCalendar,
|
||||
TDBGroupBox]);
|
||||
TDBImage,TDBListBox,TDBLookupListBox,TDBComboBox,TDBLookupComboBox,
|
||||
TDBCheckBox, TDBRadioGroup, TDBCalendar,TDBGroupBox]);
|
||||
{$IFNDEF VER2_0}
|
||||
RegFields(DefaultFieldClasses);
|
||||
{$ENDIF}
|
||||
@ -1153,13 +1370,14 @@ procedure TFieldDataLink.SetFieldName(const Value: string);
|
||||
begin
|
||||
if FFieldName <> Value then
|
||||
begin
|
||||
FFieldName := Value;
|
||||
FFieldName := Value;
|
||||
If Assigned(FField) then begin
|
||||
FField := nil;
|
||||
EditingChanged;
|
||||
Reset;
|
||||
end;
|
||||
|
||||
if (Value = '') then
|
||||
Exit;
|
||||
If Assigned(DataSource) and Assigned(DataSource.DataSet) then
|
||||
FField := DataSource.DataSet.FieldByName(FFieldName);
|
||||
|
||||
@ -1439,18 +1657,24 @@ begin
|
||||
IsModified := False;
|
||||
end;
|
||||
|
||||
{$Include dblookup.inc}
|
||||
{$Include dbedit.inc}
|
||||
{$Include dbtext.inc}
|
||||
{$Include customdblistbox.inc}
|
||||
{$Include dblistbox.inc}
|
||||
{$Include dblookuplistbox.inc}
|
||||
{$Include dbradiogroup.inc}
|
||||
{$Include dbcheckbox.inc}
|
||||
{$Include customdbcombobox.inc}
|
||||
{$Include dbcombobox.inc}
|
||||
{$Include dblookupcombobox.inc}
|
||||
{$Include dbmemo.inc}
|
||||
{$Include dbgroupbox.inc}
|
||||
{$Include dbimage.inc}
|
||||
{$Include dbcalendar.inc}
|
||||
{$Include dbcustomnavigator.inc}
|
||||
|
||||
|
||||
initialization
|
||||
{$I lcl_dbnav_images.lrs}
|
||||
|
||||
|
||||
166
lcl/include/customdbcombobox.inc
Normal file
166
lcl/include/customdbcombobox.inc
Normal file
@ -0,0 +1,166 @@
|
||||
{%MainUnit ../dbctrls.pas}
|
||||
|
||||
{******************************************************************************
|
||||
TDBListBox
|
||||
data aware ListBox, base found in dbctrls.pp
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
// included by dbctrls.pas
|
||||
|
||||
{TCustomDBComboBox}
|
||||
|
||||
function TCustomDBComboBox.GetDataField: string;
|
||||
begin
|
||||
Result:=FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TCustomDBComboBox.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result:=FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TCustomDBComboBox.GetField: TField;
|
||||
begin
|
||||
Result:=FDataLink.Field;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.Change;
|
||||
begin
|
||||
//need to override this to make sure the datalink gets notified
|
||||
//its been modified, then when post etc, it will call
|
||||
//updatedata to update the field data with current value
|
||||
if FDatalink.Edit then
|
||||
begin
|
||||
FDataLink.Modified;
|
||||
inherited Change;
|
||||
end else
|
||||
UpdateText;
|
||||
end;
|
||||
|
||||
|
||||
function TCustomDBComboBox.GetReadOnly: Boolean;
|
||||
begin
|
||||
Result:=FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.SetDataField(const AValue: string);
|
||||
begin
|
||||
FDataLink.FieldName:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.SetDataSource(const AValue: TDataSource);
|
||||
begin
|
||||
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
|
||||
ChangeDataSource(Self,FDataLink,AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.SetReadOnly(const AValue: Boolean);
|
||||
begin
|
||||
FDataLink.ReadOnly:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.DataChange(Sender: TObject);
|
||||
begin
|
||||
if not (Style=csSimple) and DroppedDown then
|
||||
Exit;
|
||||
UpdateText;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.EditingChange(Sender: TObject);
|
||||
begin
|
||||
// ToDo
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.Notification(AComponent: TComponent; Operation: TOperation
|
||||
);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if (Operation=opRemove) then begin
|
||||
if (FDataLink<>nil) and (AComponent=DataSource) then
|
||||
DataSource:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.UpdateData(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
//the FieldLink has requested the control
|
||||
//receive focus for some reason..
|
||||
//perhaps an error occured?
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.EditingDone;
|
||||
begin
|
||||
FDataLink.UpdateRecord;
|
||||
inherited EditingDone;
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.UpdateText;
|
||||
begin
|
||||
if csDesigning in ComponentState then
|
||||
Text := Name
|
||||
else
|
||||
Text := '';
|
||||
end;
|
||||
|
||||
procedure TCustomDBComboBox.ActiveChange(Sender: TObject);
|
||||
|
||||
begin
|
||||
if FDatalink.Active then DataChange(Sender)
|
||||
else
|
||||
begin
|
||||
Text := '';
|
||||
FDataLink.Reset;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCustomDBComboBox.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
ControlStyle:=ControlStyle+[csReplicatable];
|
||||
FDataLink:=TFieldDataLink.Create;
|
||||
FDataLink.Control:=Self;
|
||||
FDataLink.OnDataChange:=@DataChange;
|
||||
FDataLink.OnUpdateData:=@UpdateData;
|
||||
FDataLInk.OnActiveChange := @ActiveChange;
|
||||
FDataLink.OnEditingChange:=@EditingChange;
|
||||
end;
|
||||
|
||||
destructor TCustomDBComboBox.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink:=nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
186
lcl/include/customdblistbox.inc
Normal file
186
lcl/include/customdblistbox.inc
Normal file
@ -0,0 +1,186 @@
|
||||
{%MainUnit ../dbctrls.pas}
|
||||
|
||||
{******************************************************************************
|
||||
TDBListBox
|
||||
data aware ListBox, base found in dbctrls.pp
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
// included by dbctrls.pp
|
||||
|
||||
{ Private Methods }
|
||||
|
||||
//update the Selected item on next record etc...
|
||||
procedure TCustomDBListBox.DataChange(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.EditingChange(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.UpdateData(Sender: TObject);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
//the FieldLink has requested the control
|
||||
//recieve focus for some reason..
|
||||
//perhaps an error occured?
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
function TCustomDBListBox.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TCustomDBListBox.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TCustomDBListBox.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.SetItems(Values : TStrings);
|
||||
begin
|
||||
Items.Assign(Values);
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
//we want to override the readonly state so we can
|
||||
//reflect the state of the Datalink/Field
|
||||
function TCustomDBListBox.GetReadOnly: Boolean;
|
||||
begin
|
||||
//we want to override the readonly state so we can
|
||||
//reflect the state of the Datalink/Field
|
||||
Result := FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.SetReadOnly(Value: Boolean);
|
||||
begin
|
||||
//we want to override the readonly state so we can
|
||||
//reflect the state of the Datalink/Field, so changing
|
||||
//readonly changes the DataLink to ReadOnly, and when Editing
|
||||
//changes the 'real' Readonly state will be updated to match
|
||||
//according to the editing flag, which will always be false if
|
||||
//this is true anyway. so I think all should be happy...
|
||||
FDataLink.ReadOnly := Value;
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.SetDataField(const Value: string);
|
||||
begin
|
||||
FDataLink.FieldName := Value;
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.SetDataSource(Value: TDataSource);
|
||||
begin
|
||||
ChangeDataSource(Self,FDataLink,Value);
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
{ Protected Methods}
|
||||
procedure TCustomDBListBox.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key,Shift);
|
||||
if Key=VK_ESCAPE then begin
|
||||
//cancel out of editing by reset on esc
|
||||
FDataLink.Reset;
|
||||
Key := VK_UNKNOWN;
|
||||
end else if (Key<>VK_UNKNOWN) then begin
|
||||
//make sure we call edit to ensure the datset is in edit,
|
||||
//this is for where the datasource is in autoedit, so we aren't
|
||||
//read only even though the dataset isn't really in edit
|
||||
//if this validates false make sure the entry doesn't change
|
||||
//since listbox doesn't have its own read only yet we gots to fake it
|
||||
//here
|
||||
if FDataLink.Edit then
|
||||
exit;
|
||||
Key := VK_UNKNOWN;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
//need to make sure the state is updated on first load
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
// if the datasource is being removed then we need to make sure
|
||||
// we are updated or we can get AV/Seg's *cough* as I foolishly
|
||||
// discovered firsthand....
|
||||
if (Operation=opRemove) then begin
|
||||
if (FDataLink<>nil) and (AComponent=DataSource) then
|
||||
DataSource:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.Click;
|
||||
begin
|
||||
//make sure we are in modify mode if can edit
|
||||
//so if a user changed the selection it can be
|
||||
//updated, and if not canel out ala ReadOnly
|
||||
if not FDataLink.Edit then
|
||||
begin
|
||||
// restore value
|
||||
DataChange(self);
|
||||
Exit;
|
||||
end;
|
||||
inherited Click;
|
||||
FDataLink.Modified;
|
||||
end;
|
||||
|
||||
procedure TCustomDBListBox.EditingDone;
|
||||
begin
|
||||
FDataLink.UpdateRecord;
|
||||
inherited EditingDone;
|
||||
end;
|
||||
|
||||
{ Public Methods }
|
||||
constructor TCustomDBListBox.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
FDataLink.Control := Self;
|
||||
FDataLink.OnDataChange := @DataChange;
|
||||
FDataLink.OnEditingChange := @EditingChange;
|
||||
FDataLink.OnUpdateData := @UpdateData;
|
||||
end;
|
||||
|
||||
destructor TCustomDBListBox.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -14,153 +14,27 @@
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
// included by dbctrls.pas
|
||||
|
||||
{ TDBComboBox }
|
||||
|
||||
function TDBComboBox.GetDataField: string;
|
||||
begin
|
||||
Result:=FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TDBComboBox.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result:=FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TDBComboBox.GetField: TField;
|
||||
begin
|
||||
Result:=FDataLink.Field;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.Change;
|
||||
begin
|
||||
//need to override this to make sure the datalink gets notified
|
||||
//its been modified, then when post etc, it will call
|
||||
//updatedata to update the field data with current value
|
||||
if FDatalink.Edit then
|
||||
{
|
||||
procedure TDBComboBox.DataChange(Sender: TObject);
|
||||
begin
|
||||
FDataLink.Modified;
|
||||
inherited change;
|
||||
end else
|
||||
UpdateText;
|
||||
end;
|
||||
|
||||
|
||||
function TDBComboBox.GetReadOnly: Boolean;
|
||||
begin
|
||||
Result:=FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.SetDataField(const AValue: string);
|
||||
begin
|
||||
FDataLink.FieldName:=AValue;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.SetDataSource(const AValue: TDataSource);
|
||||
begin
|
||||
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
|
||||
ChangeDataSource(Self,FDataLink,AValue);
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.SetReadOnly(const AValue: Boolean);
|
||||
begin
|
||||
FDataLink.ReadOnly:=AValue;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.DataChange(Sender: TObject);
|
||||
begin
|
||||
if not (Style=csSimple) and DroppedDown then
|
||||
Exit;
|
||||
UpdateText;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.EditingChange(Sender: TObject);
|
||||
begin
|
||||
// ToDo
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.Notification(AComponent: TComponent; Operation: TOperation
|
||||
);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if (Operation=opRemove) then begin
|
||||
if (FDataLink<>nil) and (AComponent=DataSource) then
|
||||
DataSource:=nil;
|
||||
inherited DataChange(Sender);
|
||||
end;
|
||||
end;
|
||||
}
|
||||
|
||||
procedure TDBComboBox.UpdateData(Sender: TObject);
|
||||
|
||||
begin
|
||||
FDataLink.Field.Text := text;
|
||||
FDataLink.Field.AsString := text;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
//the FieldLink has requested the control
|
||||
//receive focus for some reason..
|
||||
//perhaps an error occured?
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.EditingDone;
|
||||
begin
|
||||
FDataLink.UpdateRecord;
|
||||
inherited EditingDone;
|
||||
FDataLink.Field.Text := Text;
|
||||
FDataLink.Field.AsString := Text;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.UpdateText;
|
||||
begin
|
||||
if FDataLink.Field <> nil then
|
||||
// ToDo: use Field.Text
|
||||
Text := FDataLink.Field.DisplayText
|
||||
if Assigned(FDataLink.Field ) then
|
||||
Text := FDataLink.Field.AsString
|
||||
else
|
||||
if csDesigning in ComponentState then
|
||||
Text := Name
|
||||
else
|
||||
Text := '';
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDBComboBox.ActiveChange(Sender: TObject);
|
||||
|
||||
begin
|
||||
if FDatalink.Active then datachange(sender)
|
||||
else
|
||||
begin
|
||||
text := '';
|
||||
FDataLink.reset;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TDBComboBox.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
ControlStyle:=ControlStyle+[csReplicatable];
|
||||
FDataLink:=TFieldDataLink.Create;
|
||||
FDataLink.Control:=Self;
|
||||
FDataLink.OnDataChange:=@DataChange;
|
||||
FDataLink.OnUpdateData:=@UpdateData;
|
||||
FDataLInk.OnActiveChange := @ActiveChange;
|
||||
FDataLink.OnEditingChange:=@EditingChange;
|
||||
end;
|
||||
|
||||
destructor TDBComboBox.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink:=nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
// included by dbctrls.pas
|
||||
|
||||
@ -21,178 +21,23 @@
|
||||
|
||||
// included by dbctrls.pp
|
||||
|
||||
{ Private Methods }
|
||||
{ TDBListBox }
|
||||
|
||||
{ Protected Methods }
|
||||
|
||||
//update the Selected item on next record etc...
|
||||
procedure TDBListBox.DataChange(Sender: TObject);
|
||||
begin
|
||||
//if a valid selection then use that else just an empty string
|
||||
if (FDataLink.Field <> nil) then
|
||||
ItemIndex := Items.IndexOf(FDataLink.Field.DisplayText)//this is wrong, but Text seems Broken
|
||||
if Assigned(FDataLink.Field) then
|
||||
ItemIndex := Items.IndexOf(FDataLink.Field.AsString)
|
||||
else
|
||||
ItemIndex := -1;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.EditingChange(Sender: TObject);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TDBListBox.UpdateData(Sender: TObject);
|
||||
begin
|
||||
//if a valid selection then use that else just an empty string
|
||||
if (ItemIndex >= 0) then begin
|
||||
FDataLink.Field.Text := Items[ItemIndex];
|
||||
FDataLink.Field.AsString := Items[ItemIndex]// I shouldn't have to do this, but text seems broken
|
||||
end
|
||||
else begin
|
||||
FDataLink.Field.Text := '';
|
||||
FDataLink.Field.AsString := '';// I shouldn't have to do this, but text seems broken
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.FocusRequest(Sender: TObject);
|
||||
begin
|
||||
//the FieldLink has requested the control
|
||||
//recieve focus for some reason..
|
||||
//perhaps an error occured?
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
function TDBListBox.GetDataField: string;
|
||||
begin
|
||||
Result := FDataLink.FieldName;
|
||||
end;
|
||||
|
||||
function TDBListBox.GetDataSource: TDataSource;
|
||||
begin
|
||||
Result := FDataLink.DataSource;
|
||||
end;
|
||||
|
||||
function TDBListBox.GetField: TField;
|
||||
begin
|
||||
Result := FDataLink.Field;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.SetItems(Values : TStrings);
|
||||
begin
|
||||
Items.Assign(Values);
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
//we want to override the readonly state so we can
|
||||
//reflect the state of the Datalink/Field
|
||||
function TDBListBox.GetReadOnly: Boolean;
|
||||
begin
|
||||
//we want to override the readonly state so we can
|
||||
//reflect the state of the Datalink/Field
|
||||
Result := FDataLink.ReadOnly;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.SetReadOnly(Value: Boolean);
|
||||
begin
|
||||
//we want to override the readonly state so we can
|
||||
//reflect the state of the Datalink/Field, so changing
|
||||
//readonly changes the DataLink to ReadOnly, and when Editing
|
||||
//changes the 'real' Readonly state will be updated to match
|
||||
//according to the editing flag, which will always be false if
|
||||
//this is true anyway. so I think all should be happy...
|
||||
FDataLink.ReadOnly := Value;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.SetDataField(const Value: string);
|
||||
begin
|
||||
FDataLink.FieldName := Value;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.SetDataSource(Value: TDataSource);
|
||||
begin
|
||||
ChangeDataSource(Self,FDataLink,Value);
|
||||
end;
|
||||
|
||||
procedure TDBListBox.CMGetDataLink(var Message: TLMessage);
|
||||
begin
|
||||
Message.Result := PtrUInt(FDataLink);
|
||||
end;
|
||||
|
||||
{ Protected Methods}
|
||||
procedure TDBListBox.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key,Shift);
|
||||
if Key=VK_ESCAPE then begin
|
||||
//cancel out of editing by reset on esc
|
||||
FDataLink.Reset;
|
||||
Key := VK_UNKNOWN;
|
||||
end else if (Key<>VK_UNKNOWN) then begin
|
||||
//make sure we call edit to ensure the datset is in edit,
|
||||
//this is for where the datasource is in autoedit, so we aren't
|
||||
//read only even though the dataset isn't really in edit
|
||||
//if this validates false make sure the entry doesn't change
|
||||
//since listbox doesn't have its own read only yet we gots to fake it
|
||||
//here
|
||||
if FDataLink.Edit then
|
||||
exit;
|
||||
Key := VK_UNKNOWN;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
//need to make sure the state is updated on first load
|
||||
if (csDesigning in ComponentState) then
|
||||
DataChange(Self);
|
||||
end;
|
||||
|
||||
procedure TDBListBox.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
// if the datasource is being removed then we need to make sure
|
||||
// we are updated or we can get AV/Seg's *cough* as I foolishly
|
||||
// discovered firsthand....
|
||||
if (Operation=opRemove) then begin
|
||||
if (FDataLink<>nil) and (AComponent=DataSource) then
|
||||
DataSource:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.Click;
|
||||
begin
|
||||
//make sure we are in modify mode if can edit
|
||||
//so if a user changed the selection it can be
|
||||
//updated, and if not canel out ala ReadOnly
|
||||
if not FDataLink.Edit then
|
||||
begin
|
||||
// restore value
|
||||
DataChange(self);
|
||||
exit;
|
||||
end;
|
||||
|
||||
inherited Click;
|
||||
FDataLink.Modified;
|
||||
end;
|
||||
|
||||
procedure TDBListBox.EditingDone;
|
||||
begin
|
||||
FDataLink.UpdateRecord;
|
||||
inherited EditingDone;
|
||||
end;
|
||||
|
||||
{ Public Methods }
|
||||
constructor TDBListBox.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FDataLink := TFieldDataLink.Create;
|
||||
FDataLink.Control := Self;
|
||||
FDataLink.OnDataChange := @DataChange;
|
||||
FDataLink.OnEditingChange := @EditingChange;
|
||||
FDataLink.OnUpdateData := @UpdateData;
|
||||
end;
|
||||
|
||||
destructor TDBListBox.Destroy;
|
||||
begin
|
||||
FDataLink.Free;
|
||||
FDataLink := nil;
|
||||
inherited Destroy;
|
||||
if (ItemIndex >= 0) then
|
||||
FDataLink.Field.AsString := Items[ItemIndex]
|
||||
else
|
||||
FDataLink.Field.AsString := '';
|
||||
end;
|
||||
|
||||
|
||||
226
lcl/include/dblookup.inc
Normal file
226
lcl/include/dblookup.inc
Normal file
@ -0,0 +1,226 @@
|
||||
{%MainUnit ../dbctrls.pas}
|
||||
|
||||
{******************************************************************************
|
||||
TDBListBox
|
||||
data aware ListBox, base found in dbctrls.pp
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
// included by dbctrls.pp
|
||||
|
||||
|
||||
{ TDBLookup }
|
||||
|
||||
constructor TDBLookup.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FListLink:= TFieldDataLink.Create;
|
||||
FListLink.DataSource := TDataSource.Create(Self);
|
||||
FListLink.Control := Self;
|
||||
FListLink.OnActiveChange:= @ActiveChange;
|
||||
FListLink.OnEditingChange:=@EditingChange;
|
||||
FHasLookUpField:= False;
|
||||
end;
|
||||
|
||||
destructor TDBLookup.Destroy;
|
||||
begin
|
||||
FListLink.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDBLookup.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FListLink.Active then
|
||||
Initialize(FControlLink, FControlItems)
|
||||
else Initialize(nil,nil);
|
||||
end;
|
||||
|
||||
procedure TDBLookup.EditingChange(Sender: TObject);
|
||||
begin
|
||||
if not (FListLink.Editing) then
|
||||
FetchLookupData;
|
||||
end;
|
||||
|
||||
// do not show in property inspector if FHasLookUpField
|
||||
function TDBLookup.GetKeyFieldName: string;
|
||||
begin
|
||||
if FHasLookUpField then
|
||||
Result:= ''
|
||||
else
|
||||
Result := FKeyFieldName;
|
||||
end;
|
||||
|
||||
function TDBLookup.GetListSource: TDataSource;
|
||||
begin
|
||||
if FHasLookUpField then
|
||||
Result:= nil
|
||||
else
|
||||
Result:= FListSource;
|
||||
end;
|
||||
|
||||
procedure TDBLookup.SetKeyFieldName(const Value: string);
|
||||
begin
|
||||
FKeyFieldName:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookup.SetListSource(Value: TDataSource);
|
||||
begin
|
||||
FListSource:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookup.FetchLookupData;
|
||||
begin
|
||||
if not Assigned(FControlItems) then
|
||||
Exit;
|
||||
FControlItems.Clear;
|
||||
if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
|
||||
begin
|
||||
LinkGetBookMark;
|
||||
try
|
||||
FListLink.DataSet.First;
|
||||
while not FListLink.DataSet.EOF do
|
||||
begin
|
||||
FControlItems.Add(FListField.AsString);
|
||||
FListLink.DataSet.Next;
|
||||
end;
|
||||
finally
|
||||
LinkGotoBookMark;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBLookup.LinkGetBookMark;
|
||||
begin
|
||||
FLinkBookMark := FListLink.DataSet.GetBookmark;
|
||||
FListLink.DataSet.DisableControls;
|
||||
end;
|
||||
|
||||
procedure TDBLookup.LinkGotoBookMark;
|
||||
begin
|
||||
try
|
||||
FListLink.DataSet.GotoBookmark(FLinkBookMark);
|
||||
FListLink.DataSet.FreeBookmark(FLinkBookMark);
|
||||
finally
|
||||
FListLink.DataSet.EnableControls;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBLookup.Initialize(AControlDataLink: TFieldDataLink; AControlItems: TStrings);
|
||||
var
|
||||
DataField: TField;
|
||||
ListFields: TList;
|
||||
S: string;
|
||||
begin
|
||||
FKeyField := nil;
|
||||
FKeyFieldValue:= '';
|
||||
FListField := nil;
|
||||
FListFieldValue:= '';
|
||||
if not (Assigned(AControlDataLink) and Assigned(AControlItems)) then
|
||||
Exit; // Closing or our DataLink is Active but not the Control's DataLink
|
||||
FControlLink:= AControlDataLink;
|
||||
FControlItems:= AControlItems;
|
||||
if not Assigned(AControlDataLink.Field) then
|
||||
// should be but (sometimes) not (bug?)
|
||||
begin
|
||||
S:= AControlDataLink.FieldName;
|
||||
AControlDataLink.FieldName:= '';
|
||||
AControlDataLink.FieldName:= S;
|
||||
end;
|
||||
DataField := AControlDataLink.Field;
|
||||
if not Assigned(DataField) then
|
||||
Exit;
|
||||
// TDBLookupListBox(Owner).Items.Add('Assigned DataField');
|
||||
FHasLookUpField:= (DataField.FieldKind = fkLookup);
|
||||
if FHasLookUpField then
|
||||
begin
|
||||
FListLink.DataSource.DataSet:= DataField.LookupDataSet;
|
||||
FKeyFieldName:= DataField.LookupKeyFields;
|
||||
end
|
||||
else
|
||||
FListLink.DataSource.DataSet:= FListSource.DataSet;
|
||||
if FListLink.Active and (FKeyFieldName <> '') then
|
||||
begin
|
||||
ListFields := TList.Create;
|
||||
try
|
||||
FListLink.DataSet.GetFieldList(ListFields, FListFieldName);
|
||||
if FHasLookUpField then
|
||||
begin
|
||||
FKeyField := FListLink.DataSet.FindField(DataField.LookupResultField);
|
||||
if (Assigned(FKeyField) and (ListFields.IndexOf(FKeyField) < 0)) then
|
||||
ListFields.Insert(0, FKeyField);
|
||||
if (ListFields.Count > 0) then
|
||||
FListField := TField(ListFields[0]);
|
||||
end else
|
||||
begin
|
||||
FKeyField:= FListLink.DataSet.FindField(FKeyFieldName);
|
||||
if (Assigned(FKeyField) and (ListFields.Count = 0)) then
|
||||
ListFields.Add(FKeyField);
|
||||
if ((FListFieldIndex >= 0) and (FListFieldIndex < ListFields.Count)) then
|
||||
FListField := TField(ListFields[FListFieldIndex]) else
|
||||
FListField := TField(ListFields[0]);
|
||||
end;
|
||||
if Assigned(FListField) then
|
||||
FListLink.FieldName:= FListField.FieldName;
|
||||
finally
|
||||
ListFields.Free;
|
||||
end;
|
||||
FetchLookupData;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDBLookup.KeyFieldValueOf(const AListFieldValue: string): string;
|
||||
begin
|
||||
if (FListFieldValue <> AListFieldValue) then
|
||||
begin
|
||||
FListFieldValue:= AListFieldValue;
|
||||
if FHasLookUpField or (AListFieldValue = '') or not Assigned(FKeyField) then
|
||||
FKeyFieldValue := AListFieldValue
|
||||
else if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
|
||||
begin
|
||||
LinkGetBookMark;
|
||||
try
|
||||
if FListLink.DataSet.Locate(FListFieldName, VarArrayOf([AListFieldValue]), []) then
|
||||
FKeyFieldValue := FKeyField.AsString
|
||||
else FKeyFieldValue:= '';
|
||||
finally
|
||||
LinkGotoBookMark;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result := FKeyFieldValue;
|
||||
end;
|
||||
|
||||
function TDBLookup.ListFieldValueOf(const AKeyFieldValue: string): string;
|
||||
begin
|
||||
if (FKeyFieldValue <> AKeyFieldValue) then
|
||||
begin
|
||||
FKeyFieldValue:= AKeyFieldValue;
|
||||
if FHasLookUpField or (AKeyFieldValue = '') or not Assigned(FKeyField) then
|
||||
FListFieldValue := AKeyFieldValue
|
||||
else if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
|
||||
begin
|
||||
LinkGetBookMark;
|
||||
try
|
||||
if FListLink.DataSet.Locate(FKeyFieldName, VarArrayOf([AKeyFieldValue]), []) then
|
||||
FListFieldValue := FListField.AsString
|
||||
else FListFieldValue:= '';
|
||||
finally
|
||||
LinkGotoBookMark;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result := FListFieldValue;
|
||||
end;
|
||||
100
lcl/include/dblookupcombobox.inc
Normal file
100
lcl/include/dblookupcombobox.inc
Normal file
@ -0,0 +1,100 @@
|
||||
{%MainUnit ../dbctrls.pas}
|
||||
|
||||
{******************************************************************************
|
||||
TDBLookupComboBox
|
||||
data aware lookup Combo Box, base found in dbctrls.pp
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
// included by dbctrls.pp
|
||||
|
||||
{ TDBLookupComboBox }
|
||||
|
||||
constructor TDBLookupComboBox.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FLookup:= TDBLookup.Create(Self);
|
||||
FDataLink.OnActiveChange:= @ActiveChange;
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if FDataLink.Active then
|
||||
ActiveChange(Self);
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.UpdateData(Sender: TObject);
|
||||
begin
|
||||
FDataLink.Field.AsString:= FLookup.KeyFieldValueOf(Text);
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDataLink.Active then
|
||||
FLookup.Initialize(FDataLink, Items)
|
||||
else FLookup.Initialize(nil, nil);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.UpdateText;
|
||||
begin
|
||||
if Assigned(FDataLink.Field) then
|
||||
Text:= FLookup.ListFieldValueOf(FDataLink.Field.AsString)
|
||||
else
|
||||
inherited UpdateText;
|
||||
end;
|
||||
|
||||
function TDBLookupComboBox.GetKeyField: string;
|
||||
begin
|
||||
Result := FLookup.KeyField;
|
||||
end;
|
||||
|
||||
function TDBLookupComboBox.GetListField: string;
|
||||
begin
|
||||
Result := FLookup.ListField;
|
||||
end;
|
||||
|
||||
function TDBLookupComboBox.GetListFieldIndex: Integer;
|
||||
begin
|
||||
Result := FLookup.ListFieldIndex;
|
||||
end;
|
||||
|
||||
function TDBLookupComboBox.GetListSource: TDataSource;
|
||||
begin
|
||||
Result := FLookup.ListSource;
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.SetKeyField(const Value: string);
|
||||
begin
|
||||
FLookup.KeyField:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.SetListField(const Value: string);
|
||||
begin
|
||||
FLookup.ListField:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.SetListFieldIndex(const Value: Integer);
|
||||
begin
|
||||
FLookup.ListFieldIndex:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookupComboBox.SetListSource(const Value: TDataSource);
|
||||
begin
|
||||
FLookup.ListSource:= Value;
|
||||
end;
|
||||
|
||||
104
lcl/include/dblookuplistbox.inc
Normal file
104
lcl/include/dblookuplistbox.inc
Normal file
@ -0,0 +1,104 @@
|
||||
{%MainUnit ../dbctrls.pas}
|
||||
|
||||
{******************************************************************************
|
||||
TDBListBox
|
||||
data aware ListBox, base found in dbctrls.pp
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
// included by dbctrls.pp
|
||||
{ TDBLookupListBox }
|
||||
|
||||
constructor TDBLookupListBox.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FLookup:= TDBLookup.Create(Self);
|
||||
FDataLink.OnActiveChange:= @ActiveChange;
|
||||
end;
|
||||
|
||||
|
||||
procedure TDBLookupListBox.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
if FDataLink.Active then
|
||||
ActiveChange(Self);
|
||||
end;
|
||||
|
||||
procedure TDBLookupListBox.UpdateData(Sender: TObject);
|
||||
begin
|
||||
if (ItemIndex < 0) then
|
||||
Exit;
|
||||
FDataLink.Field.AsString:= FLookup.KeyFieldValueOf(Items[ItemIndex]);
|
||||
end;
|
||||
|
||||
procedure TDBLookupListBox.ActiveChange(Sender: TObject);
|
||||
begin
|
||||
if FDataLink.Active then
|
||||
begin
|
||||
FLookup.Initialize(FDataLink, Items);
|
||||
DataChange(Self);
|
||||
end
|
||||
else FLookup.Initialize(nil,nil);
|
||||
end;
|
||||
|
||||
procedure TDBLookupListBox.DataChange(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FDataLink.Field) then
|
||||
ItemIndex:= Items.IndexOf(FLookup.ListFieldValueOf(FDataLink.Field.AsString))
|
||||
else
|
||||
ItemIndex:= -1;
|
||||
end;
|
||||
|
||||
function TDBLookupListBox.GetKeyField: string;
|
||||
begin
|
||||
Result := FLookup.KeyField;
|
||||
end;
|
||||
|
||||
function TDBLookupListBox.GetListField: string;
|
||||
begin
|
||||
Result := FLookup.ListField;
|
||||
end;
|
||||
|
||||
function TDBLookupListBox.GetListFieldIndex: Integer;
|
||||
begin
|
||||
Result := FLookup.ListFieldIndex;
|
||||
end;
|
||||
|
||||
function TDBLookupListBox.GetListSource: TDataSource;
|
||||
begin
|
||||
Result := FLookup.ListSource;
|
||||
end;
|
||||
|
||||
procedure TDBLookupListBox.SetKeyField(const Value: string);
|
||||
begin
|
||||
FLookup.KeyField:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookupListBox.SetListField(const Value: string);
|
||||
begin
|
||||
FLookup.ListField:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookupListBox.SetListFieldIndex(const Value: Integer);
|
||||
begin
|
||||
FLookup.ListFieldIndex:= Value;
|
||||
end;
|
||||
|
||||
procedure TDBLookupListBox.SetListSource(const Value: TDataSource);
|
||||
begin
|
||||
FLookup.ListSource:= Value;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user