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 209 by tony, Wed Mar 14 12:48:51 2018 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 61 | Line 61 | type
61		constructor Create(AOwner: TIBLookupComboEditBox);
62		end;
63
64	+	{ TIBLookupControlLink }
65	+
66	+	TIBLookupControlLink = class(TIBControlLink)
67	+	private
68	+	FOwner: TIBLookupComboEditBox;
69	+	protected
70	+	procedure UpdateSQL(Sender: TObject); override;
71	+	public
72	+	constructor Create(AOwner: TIBLookupComboEditBox);
73	+	end;
74	+
75
76		{ TIBLookupComboEditBox }
77
#	Line 69 | Line 80 | type
80		FCanAutoInsert: TCanAutoInsert;
81		{ Private declarations }
82		FDataLink: TIBLookupComboDataLink;
83	+	FIBLookupControlLink: TIBLookupControlLink;
84		FAutoComplete: boolean;
85		FAutoInsert: boolean;
86		FKeyPressInterval: integer;
#	Line 81 | Line 93 | type
93		FUpdating: boolean;
94		FInserting: boolean;
95		FExiting: boolean;
96	+	FForceAutoComplete: boolean;
97	+	FInCheckAndInsert: boolean;
98		FLastKeyValue: variant;
99	+	FCurText: string;
100	+	FModified: boolean;
101		procedure DoActiveChanged(Data: PtrInt);
102		function GetAutoCompleteText: TComboBoxAutoCompleteText;
103		function GetListSource: TDataSource;
104		function GetRelationNameQualifier: string;
105		procedure HandleTimer(Sender: TObject);
106	+	procedure IBControlLinkChanged;
107		procedure ResetParser;
108		procedure RecordChanged(Sender: TObject; aField: TField);
109		procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
#	Line 102 | Line 119 | type
119		procedure DoEnter; override;
120		procedure DoExit; override;
121		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
122	+	procedure Loaded; override;
123	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
124		procedure SetItemIndex(const Val: integer); override;
125	+	function SQLSafe(aText: string): string;
126		procedure UpdateShowing; override;
127	+	procedure UpdateData(Sender: TObject); override;
128		public
129		{ Public declarations }
130		constructor Create(TheComponent: TComponent); override;
#	Line 118 | Line 139 | type
139		property ItemHeight;
140		property ItemWidth;
141		property ListSource: TDataSource read GetListSource write SetListSource;
142	<	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
142	>	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
143		property RelationName: string read FRelationName write FRelationName;
144		property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
145		property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
#	Line 127 | Line 148 | type
148
149		implementation
150
151	<	uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
151	>	uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
152	>
153	>	{ TIBLookupControlLink }
154	>
155	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
156	>	begin
157	>	inherited Create;
158	>	FOwner := AOwner;
159	>	end;
160	>
161	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
162	>	begin
163	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
164	>	end;
165
166		{ TIBLookupComboDataLink }
167
#	Line 138 | Line 172 | end;
172
173		procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
174		begin
175	<	{If we are not visible then avoid unnecessary work}
176	<	if not FOwner.Showing then Exit;
177	<
144	<	if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
145	<	begin
146	<	if (DataSet is TIBDataSet) then
147	<	FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
148	<	else
149	<	if (DataSet is TIBQuery) then
150	<	FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
151	<	end
152	<	else
153	<	inherited DataEvent(Event, Info);
175	>	inherited DataEvent(Event, Info);
176	>	if Event = deLayoutChange then
177	>	FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
178		end;
179
180		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
#	Line 179 | Line 203 | begin
203		UpdateList
204		end;
205
206	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
207	+	begin
208	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
209	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
210	+	else
211	+	FIBLookupControlLink.IBDataSet := nil;
212	+	end;
213	+
214		function TIBLookupComboEditBox.GetListSource: TDataSource;
215		begin
216		Result := inherited ListSource;
#	Line 196 | Line 228 | procedure TIBLookupComboEditBox.ActiveCh
228		begin
229		if not FInserting and not FUpdating then
230		Application.QueueAsyncCall(@DoActiveChanged,0);
231	+	IBControlLinkChanged;
232		end;
233
234		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 270 | begin
270		end;
271
272		procedure TIBLookupComboEditBox.ResetParser;
273	+	var curKeyValue: variant;
274		begin
275		if FFiltered then
276		begin
277		FFiltered := false;
278	+	curKeyValue := KeyValue;
279	+	Text := ''; {Ensure full list}
280		UpdateList;
281	+	KeyValue := curKeyValue;
282		UpdateData(self); {Force Scroll}
283		end;
284		end;
#	Line 276 | Line 313 | begin
313		begin
314		FDataLink.DataSource := AValue;
315		inherited ListSource := AValue;
316	+	IBControlLinkChanged;
317		end;
318		end;
319
#	Line 287 | Line 325 | procedure TIBLookupComboEditBox.UpdateLi
325		var
326		iSelStart: Integer; // char position
327		sCompleteText, sPrefixText, sResultText: string;
290	–	curText: string;
328		begin
329		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
330		and ListSource.DataSet.Active then
331		begin
332	+	FCurText := Text;
333		FUpdating := true;
334		try
335		iSelStart := SelStart;//Capture original cursor position
336		if ((iSelStart < UTF8Length(Text)) and
337		(cbactEndOfLineComplete in AutoCompleteText)) then
338		Exit;
301	–	curText := Text;
339		sPrefixText := UTF8Copy(Text, 1, iSelStart);
340		ListSource.DataSet.Active := false;
341		ListSource.DataSet.Active :=  true;
342	<	Text := curText;
343	<	if not FExiting and Focused and (Text <> '')then
342	>	Text := FCurText;
343	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
344		begin
345		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
346		begin
347		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
348	<	if (sCompleteText <> Text) then
348	>	if (sCompleteText <> FCurText) then
349		begin
350		sResultText := sCompleteText;
351		if ((cbactEndOfLineComplete in AutoCompleteText) and
#	Line 321 | Line 358 | begin
358		SelStart := iSelStart;
359		SelLength := UTF8Length(Text);
360		end;
361	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
362	+	end
363	+	else
364	+	begin
365	+	SelStart := iSelStart;
366	+	SelLength := 0;
367		end;
368		end;
369		finally
370		FUpdating := false
371		end;
372	+	FModified := true;
373		end;
374		end;
375
376		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
377		Parser: TSelectSQLParser);
378		var FieldPosition: integer;
379	+	FilterText: string;
380		begin
381		if FFiltered then
382		begin
383	+	if FUpdating then
384	+	FilterText := FCurText
385	+	else
386	+	FilterText := Text;
387		if cbactSearchCaseSensitive in AutoCompleteText then
388	<	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
388	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
389	>	SQLSafe(FilterText) + '%''')
390		else
391	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
391	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
392	>	SQLSafe(FilterText) + '%'')');
393
394	<	end;
395	<	if cbactSearchAscending in AutoCompleteText then
396	<	begin
397	<	FieldPosition := Parser.GetFieldPosition(ListField);
347	<	if FieldPosition = 0 then Exit;
394	>	if cbactSearchAscending in AutoCompleteText then
395	>	begin
396	>	FieldPosition := Parser.GetFieldPosition(ListField);
397	>	if FieldPosition = 0 then Exit;
398
399	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
399	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
400	>	end;
401		end;
402		end;
403
404		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
405		begin
406	<	SelectAll
406	>	if AppDestroying in Application.Flags then Exit;
407	>	SelectAll
408		end;
409
410		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | Line 417 | procedure TIBLookupComboEditBox.CheckAnd
417		var Accept: boolean;
418		NewKeyValue: variant;
419		begin
420	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
421	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
420	>	if FInCheckAndInsert then Exit;
421	>	FInCheckAndInsert := true;
422		try
423	<	{Is it OK to insert a new list member?}
424	<	Accept := true;
425	<	if assigned(FOnCanAutoInsert) then
426	<	OnCanAutoInsert(self,Text,Accept);
427	<	if not Accept then
428	<	begin
429	<	ResetParser;
430	<	Text := FOriginalTextValue;
431	<	SelectAll;
432	<	Exit;
433	<	end;
423	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
424	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
425	>	try
426	>	{Is it OK to insert a new list member?}
427	>	Accept := true;
428	>	if assigned(FOnCanAutoInsert) then
429	>	OnCanAutoInsert(self,Text,Accept);
430	>	if not Accept then
431	>	begin
432	>	ResetParser;
433	>	Text := FOriginalTextValue;
434	>	SelectAll;
435	>	Exit;
436	>	end;
437
438	<	FInserting := true;
439	<	try
440	<	{New Value}
441	<	FFiltered := false;
442	<	if assigned(FOnAutoInsert) then
443	<	begin
444	<	{In an OnAutoInsert handler, the client is expected to insert the new
445	<	row into the List DataSet and to set the KeyValue property to the
446	<	value of the primary key of the new row.}
447	<	OnAutoInsert(self,Text,NewKeyValue);
448	<	end
449	<	else
450	<	begin
451	<	ListSource.DataSet.Append;
452	<	{The new KeyValue should be determined by an external generator or
453	<	in the "OnInsert" handler. If it is the same as the ListField, then
454	<	it will be set from the UpdateLinkData method}
455	<	try
456	<	ListSource.DataSet.Post;
457	<	except
458	<	ListSource.DataSet.Cancel;
459	<	raise;
460	<	end;
461	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
462	<	end;
463	<	UpdateList;
464	<	KeyValue := NewKeyValue;
465	<	UpdateData(nil); {Force sync with DataField}
466	<	finally
467	<	FInserting := false
468	<	end;
469	<	except
470	<	Text := FOriginalTextValue;
471	<	ResetParser;
472	<	raise;
438	>	FInserting := true;
439	>	try
440	>	{New Value}
441	>	FFiltered := false;
442	>	if assigned(FOnAutoInsert) then
443	>	begin
444	>	{In an OnAutoInsert handler, the client is expected to insert the new
445	>	row into the List DataSet and to set the KeyValue property to the
446	>	value of the primary key of the new row.}
447	>	OnAutoInsert(self,Text,NewKeyValue);
448	>	end
449	>	else
450	>	begin
451	>	ListSource.DataSet.Append;
452	>	{The new KeyValue should be determined by an external generator or
453	>	in the "OnInsert" handler. If it is the same as the ListField, then
454	>	it will be set from the UpdateLinkData method}
455	>	try
456	>	ListSource.DataSet.Post;
457	>	except
458	>	ListSource.DataSet.Cancel;
459	>	raise;
460	>	end;
461	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
462	>	end;
463	>	Text := ''; {Ensure full list}
464	>	UpdateList;
465	>	KeyValue := NewKeyValue;
466	>	UpdateData(nil); {Force sync with DataField}
467	>	finally
468	>	FInserting := false
469	>	end;
470	>	except
471	>	Text := FOriginalTextValue;
472	>	ResetParser;
473	>	raise;
474	>	end;
475	>	finally
476	>	FInCheckAndInsert := false
477		end;
478		end;
479
#	Line 428 | Line 487 | end;
487
488		procedure TIBLookupComboEditBox.DoExit;
489		begin
490	+	if FTimer.Interval <> 0 then
491	+	HandleTimer(nil);
492		FExiting := true;
493		try
494		CheckAndInsert;
#	Line 453 | Line 514 | begin
514		SelectAll;
515		end
516		else
517	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
518	<	and AutoComplete and (Style <> csDropDownList) and
519	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
520	<	FTimer.Interval := FKeyPressInterval
521	<	else
522	<	FTimer.Interval := 0
517	>	begin
518	>	FTimer.Interval := 0;
519	>	if (IsEditableTextKey(Key) or (Key = VK_BACK))
520	>	and AutoComplete and (Style <> csDropDownList) and
521	>	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
522	>	FTimer.Interval := FKeyPressInterval;
523	>	end;
524	>	end;
525	>
526	>	procedure TIBLookupComboEditBox.Loaded;
527	>	begin
528	>	inherited Loaded;
529	>	IBControlLinkChanged;
530	>	end;
531	>
532	>	procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
533	>	Operation: TOperation);
534	>	begin
535	>	inherited Notification(AComponent, Operation);
536	>	if (Operation = opRemove) and (AComponent = DataSource) then
537	>	ListSource := nil;
538		end;
539
540		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
#	Line 467 | Line 543 | begin
543		FLastKeyValue := KeyValue;
544		end;
545
546	+	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
547	+	var I: integer;
548	+	begin
549	+	Result := '';
550	+	for I := 1 to length(aText) do
551	+	if aText[I] = '''' then
552	+	Result := Result + ''''''
553	+	else
554	+	Result := Result + aText[I];
555	+	end;
556	+
557		procedure TIBLookupComboEditBox.UpdateShowing;
558		begin
559		inherited UpdateShowing;
#	Line 474 | Line 561 | begin
561		ActiveChanged(nil);
562		end;
563
564	+	procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
565	+	begin
566	+	inherited UpdateData(Sender);
567	+	FModified := false;
568	+	end;
569	+
570		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
571		begin
572		inherited Create(TheComponent);
573		FDataLink := TIBLookupComboDataLink.Create(self);
574	<	FKeyPressInterval := 500;
574	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
575	>	FKeyPressInterval := 200;
576		FAutoComplete := true;
577		FTimer := TTimer.Create(nil);
578		FTimer.Interval := 0;
#	Line 489 | Line 583 | end;
583		destructor TIBLookupComboEditBox.Destroy;
584		begin
585		if assigned(FDataLink) then FDataLink.Free;
586	+	if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
587		if assigned(FTimer) then FTimer.Free;
588	+	Application.RemoveAsyncCalls(self);
589		inherited Destroy;
590		end;
591
592		procedure TIBLookupComboEditBox.EditingDone;
593		begin
594	+	FForceAutoComplete := true;
595	+	try
596	+	if FTimer.Interval <> 0 then
597	+	HandleTimer(nil);
598	+	finally
599	+	FForceAutoComplete := false;
600	+	end;
601		CheckAndInsert;
602	+	if FModified then
603	+	Change; {ensure Update}
604		inherited EditingDone;
605		end;
606

Diff Legend

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