ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/ibcontrols/IBLookupComboEditBox.pas

Comparing ibx/trunk/ibcontrols/IBLookupComboEditBox.pas (file contents):
Revision 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 64 by tony, Thu Jun 29 11:11:22 2017 UTC

#	Line 15 | Line 15
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.
#	Line 31 | Line 31 | interface
31
32		uses
33		Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34	<	ExtCtrls, IBSQLParser, DB, StdCtrls;
34	>	ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet, LCLVersion;
35
36		type
37
#	Line 54 | Line 54 | type
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
#	Line 69 | Line 79 | type
79		FCanAutoInsert: TCanAutoInsert;
80		{ Private declarations }
81		FDataLink: TIBLookupComboDataLink;
82	+	FIBLookupControlLink: TIBLookupControlLink;
83		FAutoComplete: boolean;
84		FAutoInsert: boolean;
85		FKeyPressInterval: integer;
#	Line 81 | Line 92 | type
92		FUpdating: boolean;
93		FInserting: boolean;
94		FExiting: boolean;
95	+	FForceAutoComplete: boolean;
96	+	FInCheckAndInsert: boolean;
97		FLastKeyValue: variant;
98	+	FCurText: string;
99		procedure DoActiveChanged(Data: PtrInt);
100		function GetAutoCompleteText: TComboBoxAutoCompleteText;
101		function GetListSource: TDataSource;
102		function GetRelationNameQualifier: string;
103		procedure HandleTimer(Sender: TObject);
104	+	procedure IBControlLinkChanged;
105		procedure ResetParser;
106		procedure RecordChanged(Sender: TObject; aField: TField);
107		procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
#	Line 102 | Line 117 | type
117		procedure DoEnter; override;
118		procedure DoExit; override;
119		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
120	+	procedure Loaded; override;
121	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
122		procedure SetItemIndex(const Val: integer); override;
123	+	function SQLSafe(aText: string): string;
124		procedure UpdateShowing; override;
125	+
126		public
127		{ Public declarations }
128		constructor Create(TheComponent: TComponent); override;
#	Line 118 | Line 137 | type
137		property ItemHeight;
138		property ItemWidth;
139		property ListSource: TDataSource read GetListSource write SetListSource;
140	<	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
140	>	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
141		property RelationName: string read FRelationName write FRelationName;
142		property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
143		property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
#	Line 127 | Line 146 | type
146
147		implementation
148
149	<	uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
149	>	uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
150
151	<	{ TIBLookupComboDataLink }
151	>	{ TIBLookupControlLink }
152
153	<	procedure TIBLookupComboDataLink.ActiveChanged;
153	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
154		begin
155	<	FOwner.ActiveChanged(self)
155	>	inherited Create;
156	>	FOwner := AOwner;
157		end;
158
159	<	procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
159	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
160		begin
161	<	{If we are not visible then avoid unnecessary work}
162	<	if not FOwner.Showing then Exit;
161	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
162	>	end;
163
164	<	if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
165	<	begin
166	<	if (DataSet is TIBDataSet) then
167	<	FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
168	<	else
149	<	if (DataSet is TIBQuery) then
150	<	FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
151	<	end
152	<	else
153	<	inherited DataEvent(Event, Info);
164	>	{ TIBLookupComboDataLink }
165	>
166	>	procedure TIBLookupComboDataLink.ActiveChanged;
167	>	begin
168	>	FOwner.ActiveChanged(self)
169		end;
170
171		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
#	Line 179 | Line 194 | begin
194		UpdateList
195		end;
196
197	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
198	+	begin
199	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
200	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
201	+	else
202	+	FIBLookupControlLink.IBDataSet := nil;
203	+	end;
204	+
205		function TIBLookupComboEditBox.GetListSource: TDataSource;
206		begin
207		Result := inherited ListSource;
#	Line 196 | Line 219 | procedure TIBLookupComboEditBox.ActiveCh
219		begin
220		if not FInserting and not FUpdating then
221		Application.QueueAsyncCall(@DoActiveChanged,0);
222	+	IBControlLinkChanged;
223		end;
224
225		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 261 | begin
261		end;
262
263		procedure TIBLookupComboEditBox.ResetParser;
264	+	var curKeyValue: variant;
265		begin
266		if FFiltered then
267		begin
268		FFiltered := false;
269	+	curKeyValue := KeyValue;
270	+	Text := ''; {Ensure full list}
271		UpdateList;
272	+	KeyValue := curKeyValue;
273		UpdateData(self); {Force Scroll}
274		end;
275		end;
#	Line 276 | Line 304 | begin
304		begin
305		FDataLink.DataSource := AValue;
306		inherited ListSource := AValue;
307	+	IBControlLinkChanged;
308		end;
309		end;
310
#	Line 287 | Line 316 | procedure TIBLookupComboEditBox.UpdateLi
316		var
317		iSelStart: Integer; // char position
318		sCompleteText, sPrefixText, sResultText: string;
290	–	curText: string;
319		begin
320		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
321		and ListSource.DataSet.Active then
322		begin
323	+	FCurText := Text;
324		FUpdating := true;
325		try
326		iSelStart := SelStart;//Capture original cursor position
327		if ((iSelStart < UTF8Length(Text)) and
328		(cbactEndOfLineComplete in AutoCompleteText)) then
329		Exit;
301	–	curText := Text;
330		sPrefixText := UTF8Copy(Text, 1, iSelStart);
331		ListSource.DataSet.Active := false;
332		ListSource.DataSet.Active :=  true;
333	<	Text := curText;
334	<	if not FExiting and Focused and (Text <> '')then
333	>	Text := FCurText;
334	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
335		begin
336		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
337		begin
338		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
339	<	if (sCompleteText <> Text) then
339	>	if (sCompleteText <> FCurText) then
340		begin
341		sResultText := sCompleteText;
342		if ((cbactEndOfLineComplete in AutoCompleteText) and
#	Line 321 | Line 349 | begin
349		SelStart := iSelStart;
350		SelLength := UTF8Length(Text);
351		end;
352	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
353		end;
354		end;
355		finally
#	Line 332 | Line 361 | end;
361		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
362		Parser: TSelectSQLParser);
363		var FieldPosition: integer;
364	+	FilterText: string;
365		begin
366		if FFiltered then
367		begin
368	+	if FUpdating then
369	+	FilterText := FCurText
370	+	else
371	+	FilterText := Text;
372		if cbactSearchCaseSensitive in AutoCompleteText then
373	<	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
373	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
374	>	SQLSafe(FilterText) + '%''')
375		else
376	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
376	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
377	>	SQLSafe(FilterText) + '%'')');
378
379	<	end;
380	<	if cbactSearchAscending in AutoCompleteText then
381	<	begin
382	<	FieldPosition := Parser.GetFieldPosition(ListField);
347	<	if FieldPosition = 0 then Exit;
379	>	if cbactSearchAscending in AutoCompleteText then
380	>	begin
381	>	FieldPosition := Parser.GetFieldPosition(ListField);
382	>	if FieldPosition = 0 then Exit;
383
384	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
384	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
385	>	end;
386		end;
387		end;
388
389		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
390		begin
391	<	SelectAll
391	>	if AppDestroying in Application.Flags then Exit;
392	>	SelectAll
393		end;
394
395		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | Line 402 | procedure TIBLookupComboEditBox.CheckAnd
402		var Accept: boolean;
403		NewKeyValue: variant;
404		begin
405	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
406	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
405	>	if FInCheckAndInsert then Exit;
406	>	FInCheckAndInsert := true;
407		try
408	<	{Is it OK to insert a new list member?}
409	<	Accept := true;
410	<	if assigned(FOnCanAutoInsert) then
411	<	OnCanAutoInsert(self,Text,Accept);
412	<	if not Accept then
413	<	begin
414	<	ResetParser;
415	<	Text := FOriginalTextValue;
416	<	SelectAll;
417	<	Exit;
418	<	end;
408	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
409	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
410	>	try
411	>	{Is it OK to insert a new list member?}
412	>	Accept := true;
413	>	if assigned(FOnCanAutoInsert) then
414	>	OnCanAutoInsert(self,Text,Accept);
415	>	if not Accept then
416	>	begin
417	>	ResetParser;
418	>	Text := FOriginalTextValue;
419	>	SelectAll;
420	>	Exit;
421	>	end;
422
423	<	FInserting := true;
424	<	try
425	<	{New Value}
426	<	FFiltered := false;
427	<	if assigned(FOnAutoInsert) then
428	<	begin
429	<	{In an OnAutoInsert handler, the client is expected to insert the new
430	<	row into the List DataSet and to set the KeyValue property to the
431	<	value of the primary key of the new row.}
432	<	OnAutoInsert(self,Text,NewKeyValue);
433	<	end
434	<	else
435	<	begin
436	<	ListSource.DataSet.Append;
437	<	{The new KeyValue should be determined by an external generator or
438	<	in the "OnInsert" handler. If it is the same as the ListField, then
439	<	it will be set from the UpdateLinkData method}
440	<	try
441	<	ListSource.DataSet.Post;
442	<	except
443	<	ListSource.DataSet.Cancel;
444	<	raise;
445	<	end;
446	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
447	<	end;
448	<	UpdateList;
449	<	KeyValue := NewKeyValue;
450	<	UpdateData(nil); {Force sync with DataField}
451	<	finally
452	<	FInserting := false
453	<	end;
454	<	except
455	<	Text := FOriginalTextValue;
456	<	ResetParser;
457	<	raise;
423	>	FInserting := true;
424	>	try
425	>	{New Value}
426	>	FFiltered := false;
427	>	if assigned(FOnAutoInsert) then
428	>	begin
429	>	{In an OnAutoInsert handler, the client is expected to insert the new
430	>	row into the List DataSet and to set the KeyValue property to the
431	>	value of the primary key of the new row.}
432	>	OnAutoInsert(self,Text,NewKeyValue);
433	>	end
434	>	else
435	>	begin
436	>	ListSource.DataSet.Append;
437	>	{The new KeyValue should be determined by an external generator or
438	>	in the "OnInsert" handler. If it is the same as the ListField, then
439	>	it will be set from the UpdateLinkData method}
440	>	try
441	>	ListSource.DataSet.Post;
442	>	except
443	>	ListSource.DataSet.Cancel;
444	>	raise;
445	>	end;
446	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
447	>	end;
448	>	Text := ''; {Ensure full list}
449	>	UpdateList;
450	>	KeyValue := NewKeyValue;
451	>	UpdateData(nil); {Force sync with DataField}
452	>	finally
453	>	FInserting := false
454	>	end;
455	>	except
456	>	Text := FOriginalTextValue;
457	>	ResetParser;
458	>	raise;
459	>	end;
460	>	finally
461	>	FInCheckAndInsert := false
462		end;
463		end;
464
#	Line 428 | Line 472 | end;
472
473		procedure TIBLookupComboEditBox.DoExit;
474		begin
475	+	if FTimer.Interval <> 0 then
476	+	HandleTimer(nil);
477		FExiting := true;
478		try
479		CheckAndInsert;
#	Line 453 | Line 499 | begin
499		SelectAll;
500		end
501		else
502	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
503	<	and AutoComplete and (Style <> csDropDownList) and
504	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
505	<	FTimer.Interval := FKeyPressInterval
506	<	else
507	<	FTimer.Interval := 0
502	>	begin
503	>	FTimer.Interval := 0;
504	>	if (IsEditableTextKey(Key) or (Key = VK_BACK))
505	>	and AutoComplete and (Style <> csDropDownList) and
506	>	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
507	>	FTimer.Interval := FKeyPressInterval;
508	>	end;
509	>	end;
510	>
511	>	procedure TIBLookupComboEditBox.Loaded;
512	>	begin
513	>	inherited Loaded;
514	>	IBControlLinkChanged;
515	>	end;
516	>
517	>	procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
518	>	Operation: TOperation);
519	>	begin
520	>	inherited Notification(AComponent, Operation);
521	>	if (Operation = opRemove) and (AComponent = DataSource) then
522	>	ListSource := nil;
523		end;
524
525		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
#	Line 467 | Line 528 | begin
528		FLastKeyValue := KeyValue;
529		end;
530
531	+	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
532	+	var I: integer;
533	+	begin
534	+	Result := '';
535	+	for I := 1 to length(aText) do
536	+	if aText[I] = '''' then
537	+	Result := Result + ''''''
538	+	else
539	+	Result := Result + aText[I];
540	+	end;
541	+
542		procedure TIBLookupComboEditBox.UpdateShowing;
543		begin
544		inherited UpdateShowing;
#	Line 478 | Line 550 | constructor TIBLookupComboEditBox.Create
550		begin
551		inherited Create(TheComponent);
552		FDataLink := TIBLookupComboDataLink.Create(self);
553	<	FKeyPressInterval := 500;
553	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
554	>	FKeyPressInterval := 200;
555		FAutoComplete := true;
556		FTimer := TTimer.Create(nil);
557		FTimer.Interval := 0;
#	Line 489 | Line 562 | end;
562		destructor TIBLookupComboEditBox.Destroy;
563		begin
564		if assigned(FDataLink) then FDataLink.Free;
565	+	if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
566		if assigned(FTimer) then FTimer.Free;
567		inherited Destroy;
568		end;
569
570		procedure TIBLookupComboEditBox.EditingDone;
571		begin
572	+	FForceAutoComplete := true;
573	+	try
574	+	if FTimer.Interval <> 0 then
575	+	HandleTimer(nil);
576	+	finally
577	+	FForceAutoComplete := false;
578	+	end;
579		CheckAndInsert;
580		inherited EditingDone;
581		end;

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines