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 Notification(AComponent: TComponent; Operation: TOperation); override; |
118 |
|
procedure SetItemIndex(const Val: integer); override; |
119 |
+ |
function SQLSafe(aText: string): string; |
120 |
|
procedure UpdateShowing; override; |
121 |
+ |
|
122 |
|
public |
123 |
|
{ Public declarations } |
124 |
|
constructor Create(TheComponent: TComponent); override; |
133 |
|
property ItemHeight; |
134 |
|
property ItemWidth; |
135 |
|
property ListSource: TDataSource read GetListSource write SetListSource; |
136 |
< |
property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500; |
136 |
> |
property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200; |
137 |
|
property RelationName: string read FRelationName write FRelationName; |
138 |
|
property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert; |
139 |
|
property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert; |
142 |
|
|
143 |
|
implementation |
144 |
|
|
145 |
< |
uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc; |
145 |
> |
uses IBQuery, LCLType, Variants, LCLProc; |
146 |
|
|
147 |
< |
{ TIBLookupComboDataLink } |
147 |
> |
{ TIBLookupControlLink } |
148 |
|
|
149 |
< |
procedure TIBLookupComboDataLink.ActiveChanged; |
149 |
> |
constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox); |
150 |
|
begin |
151 |
< |
FOwner.ActiveChanged(self) |
151 |
> |
inherited Create; |
152 |
> |
FOwner := AOwner; |
153 |
|
end; |
154 |
|
|
155 |
< |
procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint); |
155 |
> |
procedure TIBLookupControlLink.UpdateSQL(Sender: TObject); |
156 |
|
begin |
157 |
< |
{If we are not visible then avoid unnecessary work} |
158 |
< |
if not FOwner.Showing then Exit; |
157 |
> |
FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser) |
158 |
> |
end; |
159 |
|
|
160 |
< |
if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then |
161 |
< |
begin |
162 |
< |
if (DataSet is TIBDataSet) then |
163 |
< |
FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser) |
164 |
< |
else |
149 |
< |
if (DataSet is TIBQuery) then |
150 |
< |
FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser) |
151 |
< |
end |
152 |
< |
else |
153 |
< |
inherited DataEvent(Event, Info); |
160 |
> |
{ TIBLookupComboDataLink } |
161 |
> |
|
162 |
> |
procedure TIBLookupComboDataLink.ActiveChanged; |
163 |
> |
begin |
164 |
> |
FOwner.ActiveChanged(self) |
165 |
|
end; |
166 |
|
|
167 |
|
procedure TIBLookupComboDataLink.RecordChanged(Field: TField); |
190 |
|
UpdateList |
191 |
|
end; |
192 |
|
|
193 |
+ |
procedure TIBLookupComboEditBox.IBControlLinkChanged; |
194 |
+ |
begin |
195 |
+ |
if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then |
196 |
+ |
FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet) |
197 |
+ |
else |
198 |
+ |
FIBLookupControlLink.IBDataSet := nil; |
199 |
+ |
end; |
200 |
+ |
|
201 |
|
function TIBLookupComboEditBox.GetListSource: TDataSource; |
202 |
|
begin |
203 |
|
Result := inherited ListSource; |
215 |
|
begin |
216 |
|
if not FInserting and not FUpdating then |
217 |
|
Application.QueueAsyncCall(@DoActiveChanged,0); |
218 |
+ |
IBControlLinkChanged; |
219 |
|
end; |
220 |
|
|
221 |
|
procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt); |
257 |
|
end; |
258 |
|
|
259 |
|
procedure TIBLookupComboEditBox.ResetParser; |
260 |
+ |
var curKeyValue: variant; |
261 |
|
begin |
262 |
|
if FFiltered then |
263 |
|
begin |
264 |
|
FFiltered := false; |
265 |
+ |
curKeyValue := KeyValue; |
266 |
+ |
Text := ''; {Ensure full list} |
267 |
|
UpdateList; |
268 |
+ |
KeyValue := curKeyValue; |
269 |
|
UpdateData(self); {Force Scroll} |
270 |
|
end; |
271 |
|
end; |
300 |
|
begin |
301 |
|
FDataLink.DataSource := AValue; |
302 |
|
inherited ListSource := AValue; |
303 |
+ |
IBControlLinkChanged; |
304 |
|
end; |
305 |
|
end; |
306 |
|
|
361 |
|
if FFiltered then |
362 |
|
begin |
363 |
|
if cbactSearchCaseSensitive in AutoCompleteText then |
364 |
< |
Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''') |
364 |
> |
Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + |
365 |
> |
SQLSafe(Text) + '%''') |
366 |
|
else |
367 |
< |
Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')'); |
367 |
> |
Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + |
368 |
> |
SQLSafe(Text) + '%'')'); |
369 |
|
|
370 |
|
end; |
371 |
|
if cbactSearchAscending in AutoCompleteText then |
379 |
|
|
380 |
|
procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt); |
381 |
|
begin |
382 |
< |
SelectAll |
382 |
> |
SelectAll |
383 |
|
end; |
384 |
|
|
385 |
|
procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject); |
432 |
|
end; |
433 |
|
NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
434 |
|
end; |
435 |
+ |
Text := ''; {Ensure full list} |
436 |
|
UpdateList; |
437 |
|
KeyValue := NewKeyValue; |
438 |
|
UpdateData(nil); {Force sync with DataField} |
489 |
|
FTimer.Interval := 0 |
490 |
|
end; |
491 |
|
|
492 |
+ |
procedure TIBLookupComboEditBox.Notification(AComponent: TComponent; |
493 |
+ |
Operation: TOperation); |
494 |
+ |
begin |
495 |
+ |
inherited Notification(AComponent, Operation); |
496 |
+ |
if (Operation = opRemove) and (AComponent = DataSource) then |
497 |
+ |
ListSource := nil; |
498 |
+ |
end; |
499 |
+ |
|
500 |
|
procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer); |
501 |
|
begin |
502 |
|
inherited SetItemIndex(Val); |
503 |
|
FLastKeyValue := KeyValue; |
504 |
|
end; |
505 |
|
|
506 |
+ |
function TIBLookupComboEditBox.SQLSafe(aText: string): string; |
507 |
+ |
var I: integer; |
508 |
+ |
begin |
509 |
+ |
Result := ''; |
510 |
+ |
for I := 1 to length(aText) do |
511 |
+ |
if aText[I] = '''' then |
512 |
+ |
Result := Result + '''''' |
513 |
+ |
else |
514 |
+ |
Result := Result + aText[I]; |
515 |
+ |
end; |
516 |
+ |
|
517 |
|
procedure TIBLookupComboEditBox.UpdateShowing; |
518 |
|
begin |
519 |
|
inherited UpdateShowing; |
525 |
|
begin |
526 |
|
inherited Create(TheComponent); |
527 |
|
FDataLink := TIBLookupComboDataLink.Create(self); |
528 |
< |
FKeyPressInterval := 500; |
528 |
> |
FIBLookupControlLink := TIBLookupControlLink.Create(self); |
529 |
> |
FKeyPressInterval := 200; |
530 |
|
FAutoComplete := true; |
531 |
|
FTimer := TTimer.Create(nil); |
532 |
|
FTimer.Interval := 0; |
537 |
|
destructor TIBLookupComboEditBox.Destroy; |
538 |
|
begin |
539 |
|
if assigned(FDataLink) then FDataLink.Free; |
540 |
+ |
if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free; |
541 |
|
if assigned(FTimer) then FTimer.Free; |
542 |
|
inherited Destroy; |
543 |
|
end; |