15 |
|
* |
16 |
|
* The Initial Developer of the Original Code is Tony Whyman. |
17 |
|
* |
18 |
< |
* The Original Code is (C) 2011 Tony Whyman, MWA Software |
18 |
> |
* The Original Code is (C) 2015 Tony Whyman, MWA Software |
19 |
|
* (http://www.mwasoftware.co.uk). |
20 |
|
* |
21 |
|
* All Rights Reserved. |
31 |
|
|
32 |
|
uses |
33 |
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls, |
34 |
< |
ExtCtrls, IBSQLParser, DB, StdCtrls; |
34 |
> |
ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet; |
35 |
|
|
36 |
|
type |
37 |
|
|
54 |
|
FOwner: TIBLookupComboEditBox; |
55 |
|
protected |
56 |
|
procedure ActiveChanged; override; |
57 |
– |
procedure DataEvent(Event: TDataEvent; Info: Ptrint); override; |
57 |
|
procedure RecordChanged(Field: TField); override; |
58 |
|
procedure UpdateData; override; |
59 |
|
public |
60 |
|
constructor Create(AOwner: TIBLookupComboEditBox); |
61 |
|
end; |
62 |
|
|
63 |
+ |
{ TIBLookupControlLink } |
64 |
+ |
|
65 |
+ |
TIBLookupControlLink = class(TIBControlLink) |
66 |
+ |
private |
67 |
+ |
FOwner: TIBLookupComboEditBox; |
68 |
+ |
protected |
69 |
+ |
procedure UpdateSQL(Sender: TObject); override; |
70 |
+ |
public |
71 |
+ |
constructor Create(AOwner: TIBLookupComboEditBox); |
72 |
+ |
end; |
73 |
+ |
|
74 |
|
|
75 |
|
{ TIBLookupComboEditBox } |
76 |
|
|
79 |
|
FCanAutoInsert: TCanAutoInsert; |
80 |
|
{ Private declarations } |
81 |
|
FDataLink: TIBLookupComboDataLink; |
82 |
+ |
FIBLookupControlLink: TIBLookupControlLink; |
83 |
|
FAutoComplete: boolean; |
84 |
|
FAutoInsert: boolean; |
85 |
|
FKeyPressInterval: integer; |
98 |
|
function GetListSource: TDataSource; |
99 |
|
function GetRelationNameQualifier: string; |
100 |
|
procedure HandleTimer(Sender: TObject); |
101 |
+ |
procedure IBControlLinkChanged; |
102 |
|
procedure ResetParser; |
103 |
|
procedure RecordChanged(Sender: TObject; aField: TField); |
104 |
|
procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText); |
114 |
|
procedure DoEnter; override; |
115 |
|
procedure DoExit; override; |
116 |
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override; |
117 |
+ |
procedure Loaded; override; |
118 |
+ |
procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
119 |
|
procedure SetItemIndex(const Val: integer); override; |
120 |
+ |
function SQLSafe(aText: string): string; |
121 |
|
procedure UpdateShowing; override; |
122 |
+ |
|
123 |
|
public |
124 |
|
{ Public declarations } |
125 |
|
constructor Create(TheComponent: TComponent); override; |
134 |
|
property ItemHeight; |
135 |
|
property ItemWidth; |
136 |
|
property ListSource: TDataSource read GetListSource write SetListSource; |
137 |
< |
property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500; |
137 |
> |
property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200; |
138 |
|
property RelationName: string read FRelationName write FRelationName; |
139 |
|
property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert; |
140 |
|
property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert; |
143 |
|
|
144 |
|
implementation |
145 |
|
|
146 |
< |
uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc; |
146 |
> |
uses IBQuery, LCLType, Variants, LCLProc; |
147 |
|
|
148 |
< |
{ TIBLookupComboDataLink } |
148 |
> |
{ TIBLookupControlLink } |
149 |
|
|
150 |
< |
procedure TIBLookupComboDataLink.ActiveChanged; |
150 |
> |
constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox); |
151 |
|
begin |
152 |
< |
FOwner.ActiveChanged(self) |
152 |
> |
inherited Create; |
153 |
> |
FOwner := AOwner; |
154 |
|
end; |
155 |
|
|
156 |
< |
procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint); |
156 |
> |
procedure TIBLookupControlLink.UpdateSQL(Sender: TObject); |
157 |
|
begin |
158 |
< |
{If we are not visible then avoid unnecessary work} |
159 |
< |
if not FOwner.Showing then Exit; |
158 |
> |
FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser) |
159 |
> |
end; |
160 |
|
|
161 |
< |
if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then |
162 |
< |
begin |
163 |
< |
if (DataSet is TIBDataSet) then |
164 |
< |
FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser) |
165 |
< |
else |
149 |
< |
if (DataSet is TIBQuery) then |
150 |
< |
FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser) |
151 |
< |
end |
152 |
< |
else |
153 |
< |
inherited DataEvent(Event, Info); |
161 |
> |
{ TIBLookupComboDataLink } |
162 |
> |
|
163 |
> |
procedure TIBLookupComboDataLink.ActiveChanged; |
164 |
> |
begin |
165 |
> |
FOwner.ActiveChanged(self) |
166 |
|
end; |
167 |
|
|
168 |
|
procedure TIBLookupComboDataLink.RecordChanged(Field: TField); |
191 |
|
UpdateList |
192 |
|
end; |
193 |
|
|
194 |
+ |
procedure TIBLookupComboEditBox.IBControlLinkChanged; |
195 |
+ |
begin |
196 |
+ |
if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then |
197 |
+ |
FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet) |
198 |
+ |
else |
199 |
+ |
FIBLookupControlLink.IBDataSet := nil; |
200 |
+ |
end; |
201 |
+ |
|
202 |
|
function TIBLookupComboEditBox.GetListSource: TDataSource; |
203 |
|
begin |
204 |
|
Result := inherited ListSource; |
216 |
|
begin |
217 |
|
if not FInserting and not FUpdating then |
218 |
|
Application.QueueAsyncCall(@DoActiveChanged,0); |
219 |
+ |
IBControlLinkChanged; |
220 |
|
end; |
221 |
|
|
222 |
|
procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt); |
258 |
|
end; |
259 |
|
|
260 |
|
procedure TIBLookupComboEditBox.ResetParser; |
261 |
+ |
var curKeyValue: variant; |
262 |
|
begin |
263 |
|
if FFiltered then |
264 |
|
begin |
265 |
|
FFiltered := false; |
266 |
+ |
curKeyValue := KeyValue; |
267 |
+ |
Text := ''; {Ensure full list} |
268 |
|
UpdateList; |
269 |
+ |
KeyValue := curKeyValue; |
270 |
|
UpdateData(self); {Force Scroll} |
271 |
|
end; |
272 |
|
end; |
301 |
|
begin |
302 |
|
FDataLink.DataSource := AValue; |
303 |
|
inherited ListSource := AValue; |
304 |
+ |
IBControlLinkChanged; |
305 |
|
end; |
306 |
|
end; |
307 |
|
|
362 |
|
if FFiltered then |
363 |
|
begin |
364 |
|
if cbactSearchCaseSensitive in AutoCompleteText then |
365 |
< |
Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''') |
365 |
> |
Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + |
366 |
> |
SQLSafe(Text) + '%''') |
367 |
|
else |
368 |
< |
Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')'); |
368 |
> |
Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + |
369 |
> |
SQLSafe(Text) + '%'')'); |
370 |
|
|
371 |
|
end; |
372 |
|
if cbactSearchAscending in AutoCompleteText then |
380 |
|
|
381 |
|
procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt); |
382 |
|
begin |
383 |
< |
SelectAll |
383 |
> |
SelectAll |
384 |
|
end; |
385 |
|
|
386 |
|
procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject); |
433 |
|
end; |
434 |
|
NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
435 |
|
end; |
436 |
+ |
Text := ''; {Ensure full list} |
437 |
|
UpdateList; |
438 |
|
KeyValue := NewKeyValue; |
439 |
|
UpdateData(nil); {Force sync with DataField} |
487 |
|
(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then |
488 |
|
FTimer.Interval := FKeyPressInterval |
489 |
|
else |
490 |
< |
FTimer.Interval := 0 |
490 |
> |
FTimer.Interval := 0; |
491 |
> |
end; |
492 |
> |
|
493 |
> |
procedure TIBLookupComboEditBox.Loaded; |
494 |
> |
begin |
495 |
> |
inherited Loaded; |
496 |
> |
IBControlLinkChanged; |
497 |
> |
end; |
498 |
> |
|
499 |
> |
procedure TIBLookupComboEditBox.Notification(AComponent: TComponent; |
500 |
> |
Operation: TOperation); |
501 |
> |
begin |
502 |
> |
inherited Notification(AComponent, Operation); |
503 |
> |
if (Operation = opRemove) and (AComponent = DataSource) then |
504 |
> |
ListSource := nil; |
505 |
|
end; |
506 |
|
|
507 |
|
procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer); |
510 |
|
FLastKeyValue := KeyValue; |
511 |
|
end; |
512 |
|
|
513 |
+ |
function TIBLookupComboEditBox.SQLSafe(aText: string): string; |
514 |
+ |
var I: integer; |
515 |
+ |
begin |
516 |
+ |
Result := ''; |
517 |
+ |
for I := 1 to length(aText) do |
518 |
+ |
if aText[I] = '''' then |
519 |
+ |
Result := Result + '''''' |
520 |
+ |
else |
521 |
+ |
Result := Result + aText[I]; |
522 |
+ |
end; |
523 |
+ |
|
524 |
|
procedure TIBLookupComboEditBox.UpdateShowing; |
525 |
|
begin |
526 |
|
inherited UpdateShowing; |
532 |
|
begin |
533 |
|
inherited Create(TheComponent); |
534 |
|
FDataLink := TIBLookupComboDataLink.Create(self); |
535 |
< |
FKeyPressInterval := 500; |
535 |
> |
FIBLookupControlLink := TIBLookupControlLink.Create(self); |
536 |
> |
FKeyPressInterval := 200; |
537 |
|
FAutoComplete := true; |
538 |
|
FTimer := TTimer.Create(nil); |
539 |
|
FTimer.Interval := 0; |
544 |
|
destructor TIBLookupComboEditBox.Destroy; |
545 |
|
begin |
546 |
|
if assigned(FDataLink) then FDataLink.Free; |
547 |
+ |
if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free; |
548 |
|
if assigned(FTimer) then FTimer.Free; |
549 |
|
inherited Destroy; |
550 |
|
end; |