ViewVC Help

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

root/public/ibx/branches/journaling/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 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 31 | Line 31 | interface
31
32		uses
33		Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34	<	ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet;
34	>	ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet, LCLVersion;
35
36		type
37
#	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 IBQuery, LCLType, Variants, LCLProc, LazUTF8;
151
152		{ TIBLookupControlLink }
153
#	Line 312 | Line 317 | procedure TIBLookupComboEditBox.UpdateLi
317		var
318		iSelStart: Integer; // char position
319		sCompleteText, sPrefixText, sResultText: string;
315	–	curText: string;
320		begin
321		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
322		and ListSource.DataSet.Active then
323		begin
324	+	FCurText := Text;
325		FUpdating := true;
326		try
327		iSelStart := SelStart;//Capture original cursor position
328		if ((iSelStart < UTF8Length(Text)) and
329		(cbactEndOfLineComplete in AutoCompleteText)) then
330		Exit;
326	–	curText := Text;
331		sPrefixText := UTF8Copy(Text, 1, iSelStart);
332		ListSource.DataSet.Active := false;
333		ListSource.DataSet.Active :=  true;
334	<	Text := curText;
335	<	if not FExiting and Focused and (Text <> '')then
334	>	Text := FCurText;
335	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
336		begin
337		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
338		begin
339		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
340	<	if (sCompleteText <> Text) then
340	>	if (sCompleteText <> FCurText) then
341		begin
342		sResultText := sCompleteText;
343		if ((cbactEndOfLineComplete in AutoCompleteText) and
#	Line 346 | Line 350 | begin
350		SelStart := iSelStart;
351		SelLength := UTF8Length(Text);
352		end;
353	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
354	+	end
355	+	else
356	+	begin
357	+	SelStart := iSelStart;
358	+	SelLength := 0;
359		end;
360		end;
361		finally
362		FUpdating := false
363		end;
364	+	FModified := true;
365		end;
366		end;
367
368		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
369		Parser: TSelectSQLParser);
370		var FieldPosition: integer;
371	+	FilterText: string;
372		begin
373		if FFiltered then
374		begin
375	+	if FUpdating then
376	+	FilterText := FCurText
377	+	else
378	+	FilterText := Text;
379		if cbactSearchCaseSensitive in AutoCompleteText then
380		Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
381	<	SQLSafe(Text) + '%''')
381	>	SQLSafe(FilterText) + '%''')
382		else
383	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' +
384	<	SQLSafe(Text) + '%'')');
383	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
384	>	SQLSafe(FilterText) + '%'')');
385
386	<	end;
387	<	if cbactSearchAscending in AutoCompleteText then
388	<	begin
389	<	FieldPosition := Parser.GetFieldPosition(ListField);
374	<	if FieldPosition = 0 then Exit;
386	>	if cbactSearchAscending in AutoCompleteText then
387	>	begin
388	>	FieldPosition := Parser.GetFieldPosition(ListField);
389	>	if FieldPosition = 0 then Exit;
390
391	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
391	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
392	>	end;
393		end;
394		end;
395
396		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
397		begin
398	+	if AppDestroying in Application.Flags then Exit;
399		SelectAll
400		end;
401
#	Line 392 | Line 409 | procedure TIBLookupComboEditBox.CheckAnd
409		var Accept: boolean;
410		NewKeyValue: variant;
411		begin
412	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
413	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
412	>	if FInCheckAndInsert then Exit;
413	>	FInCheckAndInsert := true;
414		try
415	<	{Is it OK to insert a new list member?}
416	<	Accept := true;
417	<	if assigned(FOnCanAutoInsert) then
418	<	OnCanAutoInsert(self,Text,Accept);
419	<	if not Accept then
420	<	begin
421	<	ResetParser;
422	<	Text := FOriginalTextValue;
423	<	SelectAll;
424	<	Exit;
425	<	end;
415	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
416	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
417	>	try
418	>	{Is it OK to insert a new list member?}
419	>	Accept := true;
420	>	if assigned(FOnCanAutoInsert) then
421	>	OnCanAutoInsert(self,Text,Accept);
422	>	if not Accept then
423	>	begin
424	>	ResetParser;
425	>	Text := FOriginalTextValue;
426	>	SelectAll;
427	>	Exit;
428	>	end;
429
430	<	FInserting := true;
431	<	try
432	<	{New Value}
433	<	FFiltered := false;
434	<	if assigned(FOnAutoInsert) then
435	<	begin
436	<	{In an OnAutoInsert handler, the client is expected to insert the new
437	<	row into the List DataSet and to set the KeyValue property to the
438	<	value of the primary key of the new row.}
439	<	OnAutoInsert(self,Text,NewKeyValue);
440	<	end
441	<	else
442	<	begin
443	<	ListSource.DataSet.Append;
444	<	{The new KeyValue should be determined by an external generator or
445	<	in the "OnInsert" handler. If it is the same as the ListField, then
446	<	it will be set from the UpdateLinkData method}
447	<	try
448	<	ListSource.DataSet.Post;
449	<	except
450	<	ListSource.DataSet.Cancel;
451	<	raise;
452	<	end;
453	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
454	<	end;
455	<	Text := ''; {Ensure full list}
456	<	UpdateList;
457	<	KeyValue := NewKeyValue;
458	<	UpdateData(nil); {Force sync with DataField}
459	<	finally
460	<	FInserting := false
461	<	end;
462	<	except
463	<	Text := FOriginalTextValue;
464	<	ResetParser;
465	<	raise;
430	>	FInserting := true;
431	>	try
432	>	{New Value}
433	>	FFiltered := false;
434	>	if assigned(FOnAutoInsert) then
435	>	begin
436	>	{In an OnAutoInsert handler, the client is expected to insert the new
437	>	row into the List DataSet and to set the KeyValue property to the
438	>	value of the primary key of the new row.}
439	>	OnAutoInsert(self,Text,NewKeyValue);
440	>	end
441	>	else
442	>	begin
443	>	ListSource.DataSet.Append;
444	>	{The new KeyValue should be determined by an external generator or
445	>	in the "OnInsert" handler. If it is the same as the ListField, then
446	>	it will be set from the UpdateLinkData method}
447	>	try
448	>	ListSource.DataSet.Post;
449	>	except
450	>	ListSource.DataSet.Cancel;
451	>	raise;
452	>	end;
453	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
454	>	end;
455	>	Text := ''; {Ensure full list}
456	>	UpdateList;
457	>	KeyValue := NewKeyValue;
458	>	UpdateData(nil); {Force sync with DataField}
459	>	finally
460	>	FInserting := false
461	>	end;
462	>	except
463	>	Text := FOriginalTextValue;
464	>	ResetParser;
465	>	raise;
466	>	end;
467	>	finally
468	>	FInCheckAndInsert := false
469		end;
470		end;
471
#	Line 456 | Line 479 | end;
479
480		procedure TIBLookupComboEditBox.DoExit;
481		begin
482	+	if FTimer.Interval <> 0 then
483	+	HandleTimer(nil);
484		FExiting := true;
485		try
486		CheckAndInsert;
#	Line 481 | Line 506 | begin
506		SelectAll;
507		end
508		else
509	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
510	<	and AutoComplete and (Style <> csDropDownList) and
511	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
512	<	FTimer.Interval := FKeyPressInterval
513	<	else
514	<	FTimer.Interval := 0
509	>	begin
510	>	FTimer.Interval := 0;
511	>	if (IsEditableTextKey(Key) or (Key = VK_BACK))
512	>	and AutoComplete and (Style <> csDropDownList) and
513	>	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
514	>	FTimer.Interval := FKeyPressInterval;
515	>	end;
516	>	end;
517	>
518	>	procedure TIBLookupComboEditBox.Loaded;
519	>	begin
520	>	inherited Loaded;
521	>	IBControlLinkChanged;
522		end;
523
524		procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
#	Line 521 | Line 553 | begin
553		ActiveChanged(nil);
554		end;
555
556	+	procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
557	+	begin
558	+	inherited UpdateData(Sender);
559	+	FModified := false;
560	+	end;
561	+
562		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
563		begin
564		inherited Create(TheComponent);
#	Line 539 | Line 577 | begin
577		if assigned(FDataLink) then FDataLink.Free;
578		if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
579		if assigned(FTimer) then FTimer.Free;
580	+	Application.RemoveAsyncCalls(self);
581		inherited Destroy;
582		end;
583
584		procedure TIBLookupComboEditBox.EditingDone;
585		begin
586	+	FForceAutoComplete := true;
587	+	try
588	+	if FTimer.Interval <> 0 then
589	+	HandleTimer(nil);
590	+	finally
591	+	FForceAutoComplete := false;
592	+	end;
593		CheckAndInsert;
594	+	if FModified then
595	+	Change; {ensure Update}
596		inherited EditingDone;
597		end;
598

Diff Legend

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