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 27 by tony, Tue Apr 14 13:10:23 2015 UTC vs.
Revision 225 by tony, Tue Apr 3 09:09:05 2018 UTC

#	Line 54 | Line 54 | type
54		FOwner: TIBLookupComboEditBox;
55		protected
56		procedure ActiveChanged; override;
57	+	procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
58		procedure RecordChanged(Field: TField); override;
59		procedure UpdateData; override;
60		public
#	Line 76 | Line 77 | type
77
78		TIBLookupComboEditBox = class(TDBLookupComboBox)
79		private
79	–	FCanAutoInsert: TCanAutoInsert;
80		{ Private declarations }
81		FDataLink: TIBLookupComboDataLink;
82		FIBLookupControlLink: TIBLookupControlLink;
#	Line 92 | 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	+	FModified: boolean;
100		procedure DoActiveChanged(Data: PtrInt);
101		function GetAutoCompleteText: TComboBoxAutoCompleteText;
102		function GetListSource: TDataSource;
#	Line 114 | Line 118 | type
118		procedure DoEnter; override;
119		procedure DoExit; override;
120		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
121	+	procedure Loaded; override;
122		procedure Notification(AComponent: TComponent; Operation: TOperation); override;
123		procedure SetItemIndex(const Val: integer); override;
124		function SQLSafe(aText: string): string;
125		procedure UpdateShowing; override;
126	<
126	>	procedure UpdateData(Sender: TObject); override;
127		public
128		{ Public declarations }
129		constructor Create(TheComponent: TComponent); override;
#	Line 142 | Line 147 | type
147
148		implementation
149
150	<	uses IBQuery, LCLType, Variants, LCLProc;
150	>	uses LCLType, Variants, LCLProc, LazUTF8;
151
152		{ TIBLookupControlLink }
153
#	Line 164 | Line 169 | begin
169		FOwner.ActiveChanged(self)
170		end;
171
172	+	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	+
179		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
180		begin
181		FOwner.RecordChanged(self,Field);
#	Line 183 | Line 195 | end;
195		{ TIBLookupComboEditBox }
196
197		procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
186	–	var ActiveState: boolean;
198		begin
199		FTimer.Interval := 0;
200		FFiltered := Text <> '';
#	Line 312 | Line 323 | procedure TIBLookupComboEditBox.UpdateLi
323		var
324		iSelStart: Integer; // char position
325		sCompleteText, sPrefixText, sResultText: string;
315	–	curText: string;
326		begin
327		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
328		and ListSource.DataSet.Active then
329		begin
330	+	FCurText := Text;
331		FUpdating := true;
332		try
333		iSelStart := SelStart;//Capture original cursor position
334		if ((iSelStart < UTF8Length(Text)) and
335		(cbactEndOfLineComplete in AutoCompleteText)) then
336		Exit;
326	–	curText := Text;
337		sPrefixText := UTF8Copy(Text, 1, iSelStart);
338		ListSource.DataSet.Active := false;
339		ListSource.DataSet.Active :=  true;
340	<	Text := curText;
341	<	if not FExiting and Focused and (Text <> '')then
340	>	Text := FCurText;
341	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
342		begin
343		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
344		begin
345		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
346	<	if (sCompleteText <> Text) then
346	>	if (sCompleteText <> FCurText) then
347		begin
348	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
349		sResultText := sCompleteText;
350		if ((cbactEndOfLineComplete in AutoCompleteText) and
351		(cbactRetainPrefixCase in AutoCompleteText)) then
#	Line 344 | Line 355 | begin
355		end;
356		Text := sResultText;
357		SelStart := iSelStart;
358	<	SelLength := UTF8Length(Text);
358	>	SelLength := UTF8Length(Text) - iSelStart;
359		end;
360	+	end
361	+	else
362	+	begin
363	+	SelStart := iSelStart;
364	+	SelLength := 0;
365		end;
366		end;
367		finally
368		FUpdating := false
369		end;
370	+	FModified := true;
371		end;
372		end;
373
374		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
375		Parser: TSelectSQLParser);
376		var FieldPosition: integer;
377	+	FilterText: string;
378		begin
379		if FFiltered then
380		begin
381	+	if FUpdating then
382	+	FilterText := FCurText
383	+	else
384	+	FilterText := Text;
385		if cbactSearchCaseSensitive in AutoCompleteText then
386		Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
387	<	SQLSafe(Text) + '%''')
387	>	SQLSafe(FilterText) + '%''')
388		else
389	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' +
390	<	SQLSafe(Text) + '%'')');
389	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
390	>	SQLSafe(FilterText) + '%'')');
391
392	<	end;
393	<	if cbactSearchAscending in AutoCompleteText then
394	<	begin
395	<	FieldPosition := Parser.GetFieldPosition(ListField);
374	<	if FieldPosition = 0 then Exit;
392	>	if cbactSearchAscending in AutoCompleteText then
393	>	begin
394	>	FieldPosition := Parser.GetFieldPosition(ListField);
395	>	if FieldPosition = 0 then Exit;
396
397	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
397	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
398	>	end;
399		end;
400		end;
401
402		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
403		begin
404	+	if AppDestroying in Application.Flags then Exit;
405		SelectAll
406		end;
407
#	Line 392 | Line 415 | procedure TIBLookupComboEditBox.CheckAnd
415		var Accept: boolean;
416		NewKeyValue: variant;
417		begin
418	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
419	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
418	>	if FInCheckAndInsert then Exit;
419	>	FInCheckAndInsert := true;
420		try
421	<	{Is it OK to insert a new list member?}
422	<	Accept := true;
423	<	if assigned(FOnCanAutoInsert) then
424	<	OnCanAutoInsert(self,Text,Accept);
425	<	if not Accept then
426	<	begin
427	<	ResetParser;
428	<	Text := FOriginalTextValue;
429	<	SelectAll;
430	<	Exit;
431	<	end;
421	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
422	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
423	>	try
424	>	{Is it OK to insert a new list member?}
425	>	Accept := true;
426	>	if assigned(FOnCanAutoInsert) then
427	>	OnCanAutoInsert(self,Text,Accept);
428	>	if not Accept then
429	>	begin
430	>	ResetParser;
431	>	Text := FOriginalTextValue;
432	>	SelectAll;
433	>	Exit;
434	>	end;
435
436	<	FInserting := true;
437	<	try
438	<	{New Value}
439	<	FFiltered := false;
440	<	if assigned(FOnAutoInsert) then
441	<	begin
442	<	{In an OnAutoInsert handler, the client is expected to insert the new
443	<	row into the List DataSet and to set the KeyValue property to the
444	<	value of the primary key of the new row.}
445	<	OnAutoInsert(self,Text,NewKeyValue);
446	<	end
447	<	else
448	<	begin
449	<	ListSource.DataSet.Append;
450	<	{The new KeyValue should be determined by an external generator or
451	<	in the "OnInsert" handler. If it is the same as the ListField, then
452	<	it will be set from the UpdateLinkData method}
453	<	try
454	<	ListSource.DataSet.Post;
455	<	except
456	<	ListSource.DataSet.Cancel;
457	<	raise;
458	<	end;
459	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
460	<	end;
461	<	Text := ''; {Ensure full list}
462	<	UpdateList;
463	<	KeyValue := NewKeyValue;
464	<	UpdateData(nil); {Force sync with DataField}
465	<	finally
466	<	FInserting := false
467	<	end;
468	<	except
469	<	Text := FOriginalTextValue;
470	<	ResetParser;
471	<	raise;
436	>	FInserting := true;
437	>	try
438	>	{New Value}
439	>	FFiltered := false;
440	>	if assigned(FOnAutoInsert) then
441	>	begin
442	>	{In an OnAutoInsert handler, the client is expected to insert the new
443	>	row into the List DataSet and to set the KeyValue property to the
444	>	value of the primary key of the new row.}
445	>	OnAutoInsert(self,Text,NewKeyValue);
446	>	end
447	>	else
448	>	begin
449	>	ListSource.DataSet.Append;
450	>	{The new KeyValue should be determined by an external generator or
451	>	in the "OnInsert" handler. If it is the same as the ListField, then
452	>	it will be set from the UpdateLinkData method}
453	>	try
454	>	ListSource.DataSet.Post;
455	>	except
456	>	ListSource.DataSet.Cancel;
457	>	raise;
458	>	end;
459	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
460	>	end;
461	>	Text := ''; {Ensure full list}
462	>	UpdateList;
463	>	KeyValue := NewKeyValue;
464	>	UpdateData(nil); {Force sync with DataField}
465	>	finally
466	>	FInserting := false
467	>	end;
468	>	except
469	>	Text := FOriginalTextValue;
470	>	ResetParser;
471	>	raise;
472	>	end;
473	>	finally
474	>	FInCheckAndInsert := false
475		end;
476		end;
477
#	Line 456 | Line 485 | end;
485
486		procedure TIBLookupComboEditBox.DoExit;
487		begin
488	+	if FTimer.Interval <> 0 then
489	+	HandleTimer(nil);
490		FExiting := true;
491		try
492		CheckAndInsert;
#	Line 481 | Line 512 | begin
512		SelectAll;
513		end
514		else
515	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
516	<	and AutoComplete and (Style <> csDropDownList) and
517	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
518	<	FTimer.Interval := FKeyPressInterval
519	<	else
520	<	FTimer.Interval := 0
515	>	if AutoComplete and (Style <> csDropDownList) then
516	>	begin
517	>	if (Key = VK_BACK) or (Key = VK_DELETE) then
518	>	begin
519	>	if SelStart = 0 then
520	>	begin
521	>	SelStart := UTF8Length(Text);
522	>	SelLength := 0;
523	>	end;
524	>	FTimer.Interval := 0;
525	>	end
526	>	else
527	>	if IsEditableTextKey(Key) and
528	>	(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
529	>	begin
530	>	FTimer.Interval := 0;
531	>	FTimer.Interval := FKeyPressInterval;
532	>	end;
533	>	end;
534	>	end;
535	>
536	>	procedure TIBLookupComboEditBox.Loaded;
537	>	begin
538	>	inherited Loaded;
539	>	IBControlLinkChanged;
540		end;
541
542		procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
#	Line 499 | Line 549 | end;
549
550		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
551		begin
552	+	if Val > 0 then
553	+	FCurText := '';
554		inherited SetItemIndex(Val);
555		FLastKeyValue := KeyValue;
556		end;
#	Line 521 | Line 573 | begin
573		ActiveChanged(nil);
574		end;
575
576	+	procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
577	+	begin
578	+	inherited UpdateData(Sender);
579	+	if FCurText <> '' then
580	+	Text := FCurText + Text;
581	+	FModified := false;
582	+	end;
583	+
584		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
585		begin
586		inherited Create(TheComponent);
#	Line 539 | Line 599 | begin
599		if assigned(FDataLink) then FDataLink.Free;
600		if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
601		if assigned(FTimer) then FTimer.Free;
602	+	Application.RemoveAsyncCalls(self);
603		inherited Destroy;
604		end;
605
606		procedure TIBLookupComboEditBox.EditingDone;
607		begin
608	+	FForceAutoComplete := true;
609	+	try
610	+	if FTimer.Interval <> 0 then
611	+	HandleTimer(nil);
612	+	finally
613	+	FForceAutoComplete := false;
614	+	end;
615		CheckAndInsert;
616	+	FCurText := '';
617	+	if FModified then
618	+	Change; {ensure Update}
619		inherited EditingDone;
620		end;
621

Diff Legend

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