1 |
tony |
21 |
(* |
2 |
|
|
* IBX For Lazarus (Firebird Express) |
3 |
|
|
* |
4 |
|
|
* The contents of this file are subject to the Initial Developer's |
5 |
|
|
* Public License Version 1.0 (the "License"); you may not use this |
6 |
|
|
* file except in compliance with the License. You may obtain a copy |
7 |
|
|
* of the License here: |
8 |
|
|
* |
9 |
|
|
* http://www.firebirdsql.org/index.php?op=doc&id=idpl |
10 |
|
|
* |
11 |
|
|
* Software distributed under the License is distributed on an "AS |
12 |
|
|
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or |
13 |
|
|
* implied. See the License for the specific language governing rights |
14 |
|
|
* and limitations under the License. |
15 |
|
|
* |
16 |
|
|
* The Initial Developer of the Original Code is Tony Whyman. |
17 |
|
|
* |
18 |
tony |
23 |
* The Original Code is (C) 2015 Tony Whyman, MWA Software |
19 |
tony |
21 |
* (http://www.mwasoftware.co.uk). |
20 |
|
|
* |
21 |
|
|
* All Rights Reserved. |
22 |
|
|
* |
23 |
|
|
* Contributor(s): ______________________________________. |
24 |
|
|
* |
25 |
|
|
*) |
26 |
|
|
unit IBLookupComboEditBox; |
27 |
|
|
|
28 |
|
|
{$mode objfpc}{$H+} |
29 |
|
|
|
30 |
|
|
interface |
31 |
|
|
|
32 |
|
|
uses |
33 |
tony |
263 |
Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls, |
34 |
tony |
435 |
ExtCtrls, DB, StdCtrls, LCLVersion, IBDynamicInterfaces; |
35 |
tony |
21 |
|
36 |
|
|
type |
37 |
|
|
|
38 |
|
|
{TIBLookupComboEditBox is a TDBLookupComboBox descendent that implements "autocomplete" |
39 |
|
|
of typed in text and "autoinsert" of new entries. Autocomplete uses SQL manipulation |
40 |
|
|
to revise the available list and restrict it to items that are prefixed by the |
41 |
|
|
typed text (either case sensitive or case insenstive). Autoinsert allows a |
42 |
|
|
newly typed entry to be added to the list dataset and included in the available |
43 |
|
|
list items. } |
44 |
|
|
|
45 |
|
|
TAutoInsert = procedure(Sender: TObject; aText: string; var NewKeyValue: variant) of object; |
46 |
|
|
TCanAutoInsert = procedure (Sender: TObject; aText: string; var Accept: boolean) of object; |
47 |
|
|
|
48 |
|
|
TIBLookupComboEditBox = class; |
49 |
|
|
|
50 |
|
|
{ TIBLookupComboDataLink } |
51 |
|
|
|
52 |
|
|
TIBLookupComboDataLink = class(TDataLink) |
53 |
|
|
private |
54 |
|
|
FOwner: TIBLookupComboEditBox; |
55 |
|
|
protected |
56 |
|
|
procedure ActiveChanged; override; |
57 |
tony |
278 |
{$if lcl_fullversion < 2000000} |
58 |
tony |
209 |
procedure DataEvent(Event: TDataEvent; Info: Ptrint); override; |
59 |
tony |
272 |
{$endif} |
60 |
tony |
21 |
procedure RecordChanged(Field: TField); override; |
61 |
|
|
procedure UpdateData; override; |
62 |
|
|
public |
63 |
|
|
constructor Create(AOwner: TIBLookupComboEditBox); |
64 |
|
|
end; |
65 |
|
|
|
66 |
|
|
{ TIBLookupComboEditBox } |
67 |
|
|
|
68 |
tony |
435 |
TIBLookupComboEditBox = class(TDBLookupComboBox,IDynamicSQLComponent) |
69 |
tony |
21 |
private |
70 |
|
|
{ Private declarations } |
71 |
|
|
FDataLink: TIBLookupComboDataLink; |
72 |
|
|
FAutoComplete: boolean; |
73 |
|
|
FAutoInsert: boolean; |
74 |
|
|
FKeyPressInterval: integer; |
75 |
|
|
FOnCanAutoInsert: TCanAutoInsert; |
76 |
tony |
435 |
FOnSetParams : TOnSetParams; |
77 |
|
|
FOnUpdateSQL : TOnUpdateSQL; |
78 |
tony |
21 |
FRelationName: string; |
79 |
|
|
FTimer: TTimer; |
80 |
|
|
FFiltered: boolean; |
81 |
|
|
FOnAutoInsert: TAutoInsert; |
82 |
|
|
FOriginalTextValue: string; |
83 |
|
|
FUpdating: boolean; |
84 |
|
|
FInserting: boolean; |
85 |
|
|
FExiting: boolean; |
86 |
tony |
35 |
FForceAutoComplete: boolean; |
87 |
|
|
FInCheckAndInsert: boolean; |
88 |
tony |
21 |
FLastKeyValue: variant; |
89 |
tony |
64 |
FCurText: string; |
90 |
tony |
143 |
FModified: boolean; |
91 |
tony |
435 |
FCurListDataset: TDataset; |
92 |
tony |
21 |
procedure DoActiveChanged(Data: PtrInt); |
93 |
|
|
function GetAutoCompleteText: TComboBoxAutoCompleteText; |
94 |
tony |
435 |
function GetListDatset : TDataset; |
95 |
tony |
21 |
function GetListSource: TDataSource; |
96 |
|
|
function GetRelationNameQualifier: string; |
97 |
|
|
procedure HandleTimer(Sender: TObject); |
98 |
tony |
435 |
procedure ListDatasetChanged; |
99 |
tony |
21 |
procedure ResetParser; |
100 |
|
|
procedure RecordChanged(Sender: TObject; aField: TField); |
101 |
|
|
procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText); |
102 |
|
|
procedure SetListSource(AValue: TDataSource); |
103 |
|
|
procedure UpdateList; |
104 |
|
|
procedure HandleEnter(Data: PtrInt); |
105 |
|
|
procedure UpdateLinkData(Sender: TObject); |
106 |
tony |
291 |
procedure ValidateListField; |
107 |
tony |
21 |
protected |
108 |
|
|
{ Protected declarations } |
109 |
|
|
procedure ActiveChanged(Sender: TObject); |
110 |
|
|
procedure CheckAndInsert; |
111 |
|
|
procedure DoEnter; override; |
112 |
|
|
procedure DoExit; override; |
113 |
tony |
275 |
{$if lcl_fullversion >= 2000002} |
114 |
tony |
263 |
{Deferred update changes in Lazarus 2.0 stop the combo box working when |
115 |
|
|
the datasource is nil. We thus have to reverse out the changes :(} |
116 |
|
|
function DoEdit: boolean; override; |
117 |
|
|
procedure Change; override; |
118 |
|
|
procedure CloseUp; override; |
119 |
|
|
procedure Select; override; |
120 |
|
|
{$ifend} |
121 |
tony |
276 |
{$if lcl_fullversion = 2000002} |
122 |
|
|
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override; |
123 |
|
|
{$ifend} |
124 |
tony |
21 |
procedure KeyUp(var Key: Word; Shift: TShiftState); override; |
125 |
tony |
27 |
procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
126 |
tony |
21 |
procedure SetItemIndex(const Val: integer); override; |
127 |
|
|
procedure UpdateShowing; override; |
128 |
tony |
143 |
procedure UpdateData(Sender: TObject); override; |
129 |
tony |
435 |
{IDynamicSQLComponent} |
130 |
|
|
procedure UpdateSQL(SQLEditor: IDynamicSQLEditor); |
131 |
|
|
procedure SetParams(SQLParamProvider: IDynamicSQLParam); |
132 |
tony |
21 |
public |
133 |
|
|
{ Public declarations } |
134 |
|
|
constructor Create(TheComponent: TComponent); override; |
135 |
|
|
destructor Destroy; override; |
136 |
|
|
procedure EditingDone; override; |
137 |
tony |
435 |
property ListDataSet: TDataset read GetListDatset; |
138 |
tony |
21 |
published |
139 |
|
|
{ Published declarations } |
140 |
|
|
property AutoInsert: boolean read FAutoInsert write FAutoInsert; |
141 |
|
|
property AutoComplete: boolean read FAutoComplete write FAutoComplete default true; |
142 |
|
|
property AutoCompleteText: TComboBoxAutoCompleteText read GetAutoCompleteText |
143 |
|
|
write SetAutoCompleteText; |
144 |
|
|
property ItemHeight; |
145 |
|
|
property ItemWidth; |
146 |
|
|
property ListSource: TDataSource read GetListSource write SetListSource; |
147 |
tony |
27 |
property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200; |
148 |
tony |
21 |
property RelationName: string read FRelationName write FRelationName; |
149 |
|
|
property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert; |
150 |
|
|
property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert; |
151 |
tony |
435 |
property OnUpdateSQL: TOnUpdateSQL read FOnUpdateSQL write FOnUpdateSQL; |
152 |
|
|
property OnSetParams: TOnSetParams read FOnSetParams write FOnSetParams; |
153 |
tony |
21 |
end; |
154 |
|
|
|
155 |
|
|
|
156 |
|
|
implementation |
157 |
|
|
|
158 |
tony |
435 |
uses Variants, LCLProc, LazUTF8; |
159 |
tony |
21 |
|
160 |
tony |
435 |
resourcestring |
161 |
|
|
ibxeListFieldNotFound = 'ListField Name is not a valid dataset column name (%s)'; |
162 |
tony |
21 |
|
163 |
|
|
|
164 |
tony |
27 |
{ TIBLookupComboDataLink } |
165 |
|
|
|
166 |
|
|
procedure TIBLookupComboDataLink.ActiveChanged; |
167 |
|
|
begin |
168 |
|
|
FOwner.ActiveChanged(self) |
169 |
tony |
21 |
end; |
170 |
|
|
|
171 |
tony |
278 |
{$if lcl_fullversion < 2000000} |
172 |
tony |
209 |
procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint); |
173 |
|
|
begin |
174 |
|
|
inherited DataEvent(Event, Info); |
175 |
|
|
if Event = deLayoutChange then |
176 |
|
|
FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup} |
177 |
|
|
end; |
178 |
tony |
272 |
{$endif} |
179 |
tony |
209 |
|
180 |
tony |
21 |
procedure TIBLookupComboDataLink.RecordChanged(Field: TField); |
181 |
|
|
begin |
182 |
|
|
FOwner.RecordChanged(self,Field); |
183 |
|
|
end; |
184 |
|
|
|
185 |
|
|
procedure TIBLookupComboDataLink.UpdateData; |
186 |
|
|
begin |
187 |
|
|
FOwner.UpdateLinkData(self) |
188 |
|
|
end; |
189 |
|
|
|
190 |
|
|
constructor TIBLookupComboDataLink.Create(AOwner: TIBLookupComboEditBox); |
191 |
|
|
begin |
192 |
|
|
inherited Create; |
193 |
|
|
FOwner := AOwner |
194 |
|
|
end; |
195 |
|
|
|
196 |
|
|
{ TIBLookupComboEditBox } |
197 |
|
|
|
198 |
|
|
procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject); |
199 |
|
|
begin |
200 |
|
|
FTimer.Interval := 0; |
201 |
|
|
FFiltered := Text <> ''; |
202 |
|
|
UpdateList |
203 |
|
|
end; |
204 |
|
|
|
205 |
tony |
435 |
procedure TIBLookupComboEditBox.ListDatasetChanged; |
206 |
tony |
27 |
begin |
207 |
tony |
435 |
if FCurListDataset <> ListDataSet then |
208 |
|
|
begin |
209 |
|
|
if (FCurListDataset <> nil) and (FCurListDataset is IDynamicSQLDataset) then |
210 |
|
|
(FCurListDataset as IDynamicSQLDataset).UnRegisterDynamicComponent(self); |
211 |
|
|
if (ListDataSet <> nil) and (ListDataSet is IDynamicSQLDataset) then |
212 |
|
|
with ListDataSet as IDynamicSQLDataset do |
213 |
|
|
if [dcUpdateWhereClause,dcChangeDatasetOrder] <= GetCapabilities then |
214 |
|
|
RegisterDynamicComponent(self); |
215 |
|
|
FCurListDataset := ListDataSet; |
216 |
|
|
end; |
217 |
tony |
27 |
end; |
218 |
|
|
|
219 |
tony |
21 |
function TIBLookupComboEditBox.GetListSource: TDataSource; |
220 |
|
|
begin |
221 |
|
|
Result := inherited ListSource; |
222 |
|
|
end; |
223 |
|
|
|
224 |
|
|
function TIBLookupComboEditBox.GetRelationNameQualifier: string; |
225 |
|
|
begin |
226 |
|
|
if FRelationName <> '' then |
227 |
|
|
Result := FRelationName + '.' |
228 |
|
|
else |
229 |
|
|
Result := '' |
230 |
|
|
end; |
231 |
|
|
|
232 |
|
|
procedure TIBLookupComboEditBox.ActiveChanged(Sender: TObject); |
233 |
|
|
begin |
234 |
|
|
if not FInserting and not FUpdating then |
235 |
|
|
Application.QueueAsyncCall(@DoActiveChanged,0); |
236 |
tony |
435 |
ListDatasetChanged; |
237 |
tony |
21 |
end; |
238 |
|
|
|
239 |
|
|
procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt); |
240 |
|
|
begin |
241 |
|
|
if AppDestroying in Application.Flags then Exit; |
242 |
|
|
|
243 |
|
|
if (DataSource = nil) and assigned(ListSource) and assigned(ListSource.DataSet) |
244 |
|
|
and ListSource.DataSet.Active then |
245 |
|
|
begin |
246 |
|
|
begin |
247 |
tony |
291 |
ValidateListField; |
248 |
tony |
21 |
if varIsNull(FLastKeyValue) and (ItemIndex = -1) then |
249 |
|
|
KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant |
250 |
|
|
else |
251 |
|
|
begin |
252 |
|
|
KeyValue := FLastKeyValue; |
253 |
|
|
UpdateData(self); {Force auto scroll} |
254 |
|
|
if varIsNull(KeyValue) then {Value not present} |
255 |
|
|
Text := ListSource.DataSet.FieldByName(ListField).AsString |
256 |
|
|
end; |
257 |
|
|
end; |
258 |
|
|
end |
259 |
|
|
else |
260 |
|
|
if (DataSource <> nil) and assigned(DataSource.DataSet) and |
261 |
|
|
(DataSource.DataSet.Active) and (DataField <> '') then |
262 |
|
|
begin |
263 |
|
|
ResetParser; |
264 |
|
|
KeyValue := Field.AsVariant; |
265 |
|
|
end |
266 |
|
|
else |
267 |
|
|
Text := ''; |
268 |
|
|
FOriginalTextValue := Text; |
269 |
|
|
end; |
270 |
|
|
|
271 |
|
|
function TIBLookupComboEditBox.GetAutoCompleteText: TComboBoxAutoCompleteText; |
272 |
|
|
begin |
273 |
|
|
Result := inherited AutoCompleteText; |
274 |
|
|
if AutoComplete then |
275 |
|
|
Result := Result + [cbactEnabled] |
276 |
|
|
end; |
277 |
|
|
|
278 |
tony |
435 |
function TIBLookupComboEditBox.GetListDatset : TDataset; |
279 |
|
|
begin |
280 |
|
|
if ListSource = nil then |
281 |
|
|
Result := nil |
282 |
|
|
else |
283 |
|
|
Result := ListSource.Dataset; |
284 |
|
|
end; |
285 |
|
|
|
286 |
tony |
21 |
procedure TIBLookupComboEditBox.ResetParser; |
287 |
tony |
27 |
var curKeyValue: variant; |
288 |
tony |
21 |
begin |
289 |
|
|
if FFiltered then |
290 |
|
|
begin |
291 |
|
|
FFiltered := false; |
292 |
tony |
27 |
curKeyValue := KeyValue; |
293 |
|
|
Text := ''; {Ensure full list} |
294 |
tony |
21 |
UpdateList; |
295 |
tony |
27 |
KeyValue := curKeyValue; |
296 |
tony |
21 |
UpdateData(self); {Force Scroll} |
297 |
|
|
end; |
298 |
|
|
end; |
299 |
|
|
|
300 |
|
|
procedure TIBLookupComboEditBox.RecordChanged(Sender: TObject; aField: TField); |
301 |
|
|
begin |
302 |
|
|
{Make sure that we are in sync with other data controls} |
303 |
|
|
if DataSource = nil then |
304 |
|
|
begin |
305 |
|
|
KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
306 |
|
|
if VarIsNull(KeyValue) then {Probable deletion} |
307 |
|
|
begin |
308 |
|
|
UpdateList; |
309 |
|
|
KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
310 |
|
|
end; |
311 |
|
|
end; |
312 |
|
|
end; |
313 |
|
|
|
314 |
|
|
procedure TIBLookupComboEditBox.SetAutoCompleteText( |
315 |
|
|
AValue: TComboBoxAutoCompleteText); |
316 |
|
|
begin |
317 |
|
|
if AValue <> AutoCompleteText then |
318 |
|
|
begin |
319 |
|
|
FAutoComplete := cbactEnabled in AValue; |
320 |
|
|
inherited AutoCompleteText := AValue - [cbactEnabled] |
321 |
|
|
end; |
322 |
|
|
end; |
323 |
|
|
|
324 |
|
|
procedure TIBLookupComboEditBox.SetListSource(AValue: TDataSource); |
325 |
|
|
begin |
326 |
|
|
if AValue <> inherited ListSource then |
327 |
|
|
begin |
328 |
|
|
FDataLink.DataSource := AValue; |
329 |
|
|
inherited ListSource := AValue; |
330 |
tony |
435 |
ListDatasetChanged; |
331 |
tony |
21 |
end; |
332 |
|
|
end; |
333 |
|
|
|
334 |
|
|
procedure TIBLookupComboEditBox.UpdateList; |
335 |
|
|
{ Note: Algorithm taken from TCustomComboBox.KeyUp but modified to use the |
336 |
|
|
ListSource DataSet as the source for the autocomplete text. It also runs |
337 |
|
|
after a delay rather than immediately on keyup |
338 |
|
|
} |
339 |
|
|
var |
340 |
|
|
iSelStart: Integer; // char position |
341 |
|
|
sCompleteText, sPrefixText, sResultText: string; |
342 |
|
|
begin |
343 |
tony |
435 |
if assigned(ListSource) and assigned(ListSource.DataSet) |
344 |
tony |
21 |
and ListSource.DataSet.Active then |
345 |
|
|
begin |
346 |
tony |
64 |
FCurText := Text; |
347 |
tony |
21 |
FUpdating := true; |
348 |
|
|
try |
349 |
|
|
iSelStart := SelStart;//Capture original cursor position |
350 |
|
|
if ((iSelStart < UTF8Length(Text)) and |
351 |
|
|
(cbactEndOfLineComplete in AutoCompleteText)) then |
352 |
|
|
Exit; |
353 |
|
|
sPrefixText := UTF8Copy(Text, 1, iSelStart); |
354 |
|
|
ListSource.DataSet.Active := false; |
355 |
|
|
ListSource.DataSet.Active := true; |
356 |
tony |
64 |
Text := FCurText; |
357 |
|
|
if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then |
358 |
tony |
21 |
begin |
359 |
|
|
if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then |
360 |
|
|
begin |
361 |
|
|
sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString; |
362 |
tony |
64 |
if (sCompleteText <> FCurText) then |
363 |
tony |
21 |
begin |
364 |
tony |
225 |
KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
365 |
tony |
21 |
sResultText := sCompleteText; |
366 |
|
|
if ((cbactEndOfLineComplete in AutoCompleteText) and |
367 |
|
|
(cbactRetainPrefixCase in AutoCompleteText)) then |
368 |
|
|
begin//Retain Prefix Character cases |
369 |
|
|
UTF8Delete(sResultText, 1, iSelStart); |
370 |
|
|
UTF8Insert(sPrefixText, sResultText, 1); |
371 |
|
|
end; |
372 |
|
|
Text := sResultText; |
373 |
|
|
end; |
374 |
tony |
311 |
SelStart := iSelStart; |
375 |
|
|
SelLength := UTF8Length(Text) - iSelStart; |
376 |
tony |
65 |
end |
377 |
|
|
else |
378 |
|
|
begin |
379 |
|
|
SelStart := iSelStart; |
380 |
|
|
SelLength := 0; |
381 |
tony |
21 |
end; |
382 |
|
|
end; |
383 |
|
|
finally |
384 |
|
|
FUpdating := false |
385 |
|
|
end; |
386 |
tony |
143 |
FModified := true; |
387 |
tony |
21 |
end; |
388 |
|
|
end; |
389 |
|
|
|
390 |
|
|
procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt); |
391 |
|
|
begin |
392 |
tony |
31 |
if AppDestroying in Application.Flags then Exit; |
393 |
tony |
27 |
SelectAll |
394 |
tony |
21 |
end; |
395 |
|
|
|
396 |
|
|
procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject); |
397 |
|
|
begin |
398 |
|
|
if FInserting then |
399 |
|
|
ListSource.DataSet.FieldByName(ListField).AsString := Text |
400 |
|
|
end; |
401 |
|
|
|
402 |
tony |
291 |
{Check to ensure that ListField exists and convert to upper case if necessary} |
403 |
|
|
|
404 |
|
|
procedure TIBLookupComboEditBox.ValidateListField; |
405 |
tony |
435 |
var FieldNames: TStringList; |
406 |
tony |
291 |
begin |
407 |
tony |
435 |
if (ListSource = nil) or (ListSource.DataSet = nil) then Exit; |
408 |
tony |
291 |
FieldNames := TStringList.Create; |
409 |
|
|
try |
410 |
|
|
FieldNames.CaseSensitive := true; |
411 |
|
|
FieldNames.Sorted := true; |
412 |
|
|
FieldNames.Duplicates := dupError; |
413 |
|
|
ListSource.DataSet.GetFieldNames(FieldNames); |
414 |
|
|
if FieldNames.IndexOf(ListField) = -1 then {not found} |
415 |
|
|
begin |
416 |
tony |
435 |
if FieldNames.IndexOf(AnsiUpperCase(ListField)) <> - 1 then {normalise to upper case} |
417 |
tony |
291 |
ListField := AnsiUpperCase(ListField) |
418 |
|
|
else |
419 |
tony |
435 |
raise Exception.CreateFmt(ibxeListFieldNotFound,[ListField]) |
420 |
tony |
291 |
end; |
421 |
|
|
finally |
422 |
|
|
FieldNames.Free; |
423 |
|
|
end; |
424 |
|
|
end; |
425 |
|
|
|
426 |
tony |
21 |
procedure TIBLookupComboEditBox.CheckAndInsert; |
427 |
|
|
var Accept: boolean; |
428 |
|
|
NewKeyValue: variant; |
429 |
|
|
begin |
430 |
tony |
35 |
if FInCheckAndInsert then Exit; |
431 |
|
|
FInCheckAndInsert := true; |
432 |
tony |
21 |
try |
433 |
tony |
35 |
if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet) |
434 |
|
|
and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then |
435 |
|
|
try |
436 |
|
|
{Is it OK to insert a new list member?} |
437 |
|
|
Accept := true; |
438 |
|
|
if assigned(FOnCanAutoInsert) then |
439 |
|
|
OnCanAutoInsert(self,Text,Accept); |
440 |
|
|
if not Accept then |
441 |
|
|
begin |
442 |
|
|
ResetParser; |
443 |
|
|
Text := FOriginalTextValue; |
444 |
|
|
SelectAll; |
445 |
|
|
Exit; |
446 |
|
|
end; |
447 |
tony |
21 |
|
448 |
tony |
35 |
FInserting := true; |
449 |
|
|
try |
450 |
|
|
{New Value} |
451 |
|
|
FFiltered := false; |
452 |
|
|
if assigned(FOnAutoInsert) then |
453 |
|
|
begin |
454 |
|
|
{In an OnAutoInsert handler, the client is expected to insert the new |
455 |
|
|
row into the List DataSet and to set the KeyValue property to the |
456 |
|
|
value of the primary key of the new row.} |
457 |
|
|
OnAutoInsert(self,Text,NewKeyValue); |
458 |
|
|
end |
459 |
|
|
else |
460 |
|
|
begin |
461 |
|
|
ListSource.DataSet.Append; |
462 |
|
|
{The new KeyValue should be determined by an external generator or |
463 |
|
|
in the "OnInsert" handler. If it is the same as the ListField, then |
464 |
|
|
it will be set from the UpdateLinkData method} |
465 |
|
|
try |
466 |
|
|
ListSource.DataSet.Post; |
467 |
|
|
except |
468 |
|
|
ListSource.DataSet.Cancel; |
469 |
|
|
raise; |
470 |
|
|
end; |
471 |
|
|
NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant; |
472 |
|
|
end; |
473 |
|
|
Text := ''; {Ensure full list} |
474 |
|
|
UpdateList; |
475 |
|
|
KeyValue := NewKeyValue; |
476 |
|
|
UpdateData(nil); {Force sync with DataField} |
477 |
|
|
finally |
478 |
|
|
FInserting := false |
479 |
|
|
end; |
480 |
|
|
except |
481 |
|
|
Text := FOriginalTextValue; |
482 |
|
|
ResetParser; |
483 |
|
|
raise; |
484 |
|
|
end; |
485 |
|
|
finally |
486 |
|
|
FInCheckAndInsert := false |
487 |
tony |
21 |
end; |
488 |
|
|
end; |
489 |
|
|
|
490 |
|
|
procedure TIBLookupComboEditBox.DoEnter; |
491 |
|
|
begin |
492 |
|
|
inherited DoEnter; |
493 |
|
|
FOriginalTextValue:= Text; |
494 |
|
|
ResetParser; |
495 |
|
|
Application.QueueAsyncCall(@HandleEnter,0); |
496 |
|
|
end; |
497 |
|
|
|
498 |
|
|
procedure TIBLookupComboEditBox.DoExit; |
499 |
|
|
begin |
500 |
tony |
31 |
if FTimer.Interval <> 0 then |
501 |
|
|
HandleTimer(nil); |
502 |
tony |
21 |
FExiting := true; |
503 |
|
|
try |
504 |
|
|
CheckAndInsert; |
505 |
|
|
ResetParser; |
506 |
|
|
FTimer.Interval := 0; |
507 |
|
|
finally |
508 |
|
|
FExiting := false; |
509 |
|
|
end; |
510 |
|
|
inherited DoExit; |
511 |
|
|
end; |
512 |
|
|
|
513 |
|
|
procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState); |
514 |
|
|
begin |
515 |
|
|
inherited KeyUp(Key, Shift); |
516 |
|
|
if Key = VK_ESCAPE then |
517 |
|
|
begin |
518 |
|
|
SelStart := UTF8Length(Text); {Ensure end of line selection} |
519 |
|
|
ResetParser; |
520 |
|
|
Text := FOriginalTextValue; |
521 |
|
|
SelectAll; |
522 |
|
|
end |
523 |
|
|
else |
524 |
tony |
225 |
if AutoComplete and (Style <> csDropDownList) then |
525 |
tony |
35 |
begin |
526 |
tony |
225 |
if (Key = VK_BACK) or (Key = VK_DELETE) then |
527 |
|
|
begin |
528 |
|
|
if SelStart = 0 then |
529 |
|
|
begin |
530 |
|
|
SelStart := UTF8Length(Text); |
531 |
|
|
SelLength := 0; |
532 |
|
|
end; |
533 |
|
|
FTimer.Interval := 0; |
534 |
|
|
end |
535 |
|
|
else |
536 |
|
|
if IsEditableTextKey(Key) and |
537 |
|
|
(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then |
538 |
|
|
begin |
539 |
|
|
FTimer.Interval := 0; |
540 |
tony |
35 |
FTimer.Interval := FKeyPressInterval; |
541 |
tony |
225 |
end; |
542 |
tony |
35 |
end; |
543 |
tony |
21 |
end; |
544 |
|
|
|
545 |
tony |
27 |
procedure TIBLookupComboEditBox.Notification(AComponent: TComponent; |
546 |
|
|
Operation: TOperation); |
547 |
|
|
begin |
548 |
|
|
inherited Notification(AComponent, Operation); |
549 |
|
|
if (Operation = opRemove) and (AComponent = DataSource) then |
550 |
|
|
ListSource := nil; |
551 |
|
|
end; |
552 |
|
|
|
553 |
tony |
21 |
procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer); |
554 |
|
|
begin |
555 |
tony |
225 |
if Val > 0 then |
556 |
|
|
FCurText := ''; |
557 |
tony |
21 |
inherited SetItemIndex(Val); |
558 |
|
|
FLastKeyValue := KeyValue; |
559 |
|
|
end; |
560 |
|
|
|
561 |
|
|
procedure TIBLookupComboEditBox.UpdateShowing; |
562 |
|
|
begin |
563 |
|
|
inherited UpdateShowing; |
564 |
|
|
if Showing then {Ensure up-to-date as we were ignoring any changes} |
565 |
|
|
ActiveChanged(nil); |
566 |
|
|
end; |
567 |
|
|
|
568 |
tony |
143 |
procedure TIBLookupComboEditBox.UpdateData(Sender: TObject); |
569 |
|
|
begin |
570 |
|
|
inherited UpdateData(Sender); |
571 |
tony |
225 |
if FCurText <> '' then |
572 |
|
|
Text := FCurText + Text; |
573 |
tony |
143 |
FModified := false; |
574 |
|
|
end; |
575 |
|
|
|
576 |
tony |
435 |
procedure TIBLookupComboEditBox.UpdateSQL(SQLEditor : IDynamicSQLEditor); |
577 |
|
|
var FilterText: string; |
578 |
|
|
begin |
579 |
|
|
if FFiltered then |
580 |
|
|
begin |
581 |
|
|
if FUpdating then |
582 |
|
|
FilterText := FCurText |
583 |
|
|
else |
584 |
|
|
FilterText := Text; |
585 |
tony |
276 |
|
586 |
tony |
435 |
with SQLEditor do |
587 |
|
|
begin |
588 |
|
|
if cbactSearchCaseSensitive in AutoCompleteText then |
589 |
|
|
Add2WhereClause(GetRelationNameQualifier + QuoteIdentifierIfNeeded(ListField) + ' Like ''' + |
590 |
|
|
SQLSafeString(FilterText) + '%''') |
591 |
|
|
else |
592 |
|
|
Add2WhereClause('Upper(' + GetRelationNameQualifier + QuoteIdentifierIfNeeded(ListField) + ') Like Upper(''' + |
593 |
|
|
SQLSafeString(FilterText) + '%'')'); |
594 |
|
|
|
595 |
|
|
if cbactSearchAscending in AutoCompleteText then |
596 |
|
|
Orderby(ListField,true); |
597 |
|
|
end; |
598 |
|
|
end; |
599 |
|
|
if assigned(FOnUpdateSQL) then |
600 |
|
|
OnUpdateSQL(self,SQLEditor); |
601 |
|
|
end; |
602 |
|
|
|
603 |
|
|
procedure TIBLookupComboEditBox.SetParams(SQLParamProvider : IDynamicSQLParam); |
604 |
|
|
begin |
605 |
|
|
if assigned(FOnSetParams) then |
606 |
|
|
OnSetParams(self, SQLParamProvider); |
607 |
|
|
end; |
608 |
|
|
|
609 |
|
|
|
610 |
tony |
276 |
{Workarounds due to bugs in various Lazarus 2.0 release candidates} |
611 |
tony |
275 |
{$if lcl_fullversion >= 2000002} |
612 |
tony |
263 |
type |
613 |
|
|
|
614 |
|
|
{ THackedCustomComboBox } |
615 |
|
|
|
616 |
|
|
THackedCustomComboBox = class(TCustomComboBox) |
617 |
|
|
private |
618 |
|
|
procedure CallChange; |
619 |
tony |
276 |
procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
620 |
tony |
263 |
end; |
621 |
|
|
|
622 |
|
|
{ THackedCustomComboBox } |
623 |
|
|
|
624 |
|
|
procedure THackedCustomComboBox.CallChange; |
625 |
|
|
begin |
626 |
|
|
inherited Change; |
627 |
|
|
end; |
628 |
|
|
|
629 |
tony |
276 |
procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char); |
630 |
|
|
begin |
631 |
|
|
inherited UTF8KeyPress(UTF8Key); |
632 |
|
|
end; |
633 |
|
|
|
634 |
tony |
263 |
procedure TIBLookupComboEditBox.Change; |
635 |
|
|
begin |
636 |
tony |
275 |
if DataSource = nil then |
637 |
tony |
272 |
THackedCustomComboBox(self).CallChange |
638 |
|
|
else |
639 |
|
|
inherited Change; |
640 |
tony |
263 |
end; |
641 |
|
|
|
642 |
|
|
procedure TIBLookupComboEditBox.CloseUp; |
643 |
|
|
begin |
644 |
tony |
272 |
inherited DoEdit; |
645 |
tony |
263 |
inherited CloseUp; |
646 |
tony |
272 |
EditingDone; |
647 |
tony |
263 |
end; |
648 |
|
|
|
649 |
|
|
procedure TIBLookupComboEditBox.Select; |
650 |
|
|
begin |
651 |
|
|
inherited Select; |
652 |
tony |
275 |
if DataSource = nil then |
653 |
tony |
272 |
inherited DoEdit; |
654 |
tony |
263 |
end; |
655 |
|
|
|
656 |
|
|
function TIBLookupComboEditBox.DoEdit: boolean; |
657 |
|
|
begin |
658 |
|
|
{DoEdit will swallow characters if no editable Field. Hence, to enabled |
659 |
|
|
writing we must avoid calling the inherited method.} |
660 |
tony |
275 |
if DataSource = nil then |
661 |
tony |
263 |
Result := true |
662 |
|
|
else |
663 |
|
|
Result := inherited DoEdit; |
664 |
|
|
end; |
665 |
|
|
{$ifend} |
666 |
|
|
|
667 |
tony |
276 |
{$if lcl_fullversion = 2000002} |
668 |
tony |
277 |
procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char); |
669 |
tony |
276 |
begin |
670 |
|
|
if DataSource = nil then |
671 |
tony |
277 |
THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key) |
672 |
tony |
276 |
else |
673 |
|
|
inherited; |
674 |
|
|
end; |
675 |
|
|
{$ifend} |
676 |
|
|
|
677 |
|
|
|
678 |
tony |
21 |
constructor TIBLookupComboEditBox.Create(TheComponent: TComponent); |
679 |
|
|
begin |
680 |
|
|
inherited Create(TheComponent); |
681 |
|
|
FDataLink := TIBLookupComboDataLink.Create(self); |
682 |
tony |
27 |
FKeyPressInterval := 200; |
683 |
tony |
21 |
FAutoComplete := true; |
684 |
|
|
FTimer := TTimer.Create(nil); |
685 |
|
|
FTimer.Interval := 0; |
686 |
|
|
FTimer.OnTimer := @HandleTimer; |
687 |
|
|
FLastKeyValue := NULL; |
688 |
|
|
end; |
689 |
|
|
|
690 |
|
|
destructor TIBLookupComboEditBox.Destroy; |
691 |
|
|
begin |
692 |
tony |
435 |
if ListDataset <> nil then |
693 |
|
|
(ListDataset as IDynamicSQLDataset).UnRegisterDynamicComponent(self); |
694 |
tony |
21 |
if assigned(FDataLink) then FDataLink.Free; |
695 |
|
|
if assigned(FTimer) then FTimer.Free; |
696 |
tony |
80 |
Application.RemoveAsyncCalls(self); |
697 |
tony |
21 |
inherited Destroy; |
698 |
|
|
end; |
699 |
|
|
|
700 |
|
|
procedure TIBLookupComboEditBox.EditingDone; |
701 |
|
|
begin |
702 |
tony |
35 |
FForceAutoComplete := true; |
703 |
|
|
try |
704 |
|
|
if FTimer.Interval <> 0 then |
705 |
|
|
HandleTimer(nil); |
706 |
|
|
finally |
707 |
|
|
FForceAutoComplete := false; |
708 |
|
|
end; |
709 |
tony |
21 |
CheckAndInsert; |
710 |
tony |
225 |
FCurText := ''; |
711 |
tony |
143 |
if FModified then |
712 |
|
|
Change; {ensure Update} |
713 |
tony |
21 |
inherited EditingDone; |
714 |
|
|
end; |
715 |
|
|
|
716 |
|
|
end. |