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 23 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 277 by tony, Mon Feb 4 13:45:30 2019 UTC

#	Line 30 | Line 30 | unit IBLookupComboEditBox;
30		interface
31
32		uses
33	<	Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34	<	ExtCtrls, IBSQLParser, DB, StdCtrls;
33	>	Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
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	+	{$if lcl_fullversion < 2000003}
58		procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
59	+	{$endif}
60		procedure RecordChanged(Field: TField); override;
61		procedure UpdateData; override;
62		public
63		constructor Create(AOwner: TIBLookupComboEditBox);
64		end;
65
66	+	{ TIBLookupControlLink }
67	+
68	+	TIBLookupControlLink = class(TIBControlLink)
69	+	private
70	+	FOwner: TIBLookupComboEditBox;
71	+	protected
72	+	procedure UpdateSQL(Sender: TObject); override;
73	+	public
74	+	constructor Create(AOwner: TIBLookupComboEditBox);
75	+	end;
76	+
77
78		{ TIBLookupComboEditBox }
79
80		TIBLookupComboEditBox = class(TDBLookupComboBox)
81		private
69	–	FCanAutoInsert: TCanAutoInsert;
82		{ Private declarations }
83		FDataLink: TIBLookupComboDataLink;
84	+	FIBLookupControlLink: TIBLookupControlLink;
85		FAutoComplete: boolean;
86		FAutoInsert: boolean;
87		FKeyPressInterval: integer;
#	Line 81 | Line 94 | type
94		FUpdating: boolean;
95		FInserting: boolean;
96		FExiting: boolean;
97	+	FForceAutoComplete: boolean;
98	+	FInCheckAndInsert: boolean;
99		FLastKeyValue: variant;
100	+	FCurText: string;
101	+	FModified: boolean;
102		procedure DoActiveChanged(Data: PtrInt);
103		function GetAutoCompleteText: TComboBoxAutoCompleteText;
104		function GetListSource: TDataSource;
105		function GetRelationNameQualifier: string;
106		procedure HandleTimer(Sender: TObject);
107	+	procedure IBControlLinkChanged;
108		procedure ResetParser;
109		procedure RecordChanged(Sender: TObject; aField: TField);
110		procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
#	Line 101 | Line 119 | type
119		procedure CheckAndInsert;
120		procedure DoEnter; override;
121		procedure DoExit; override;
122	+	{$if lcl_fullversion >= 2000002}
123	+	{Deferred update changes in Lazarus 2.0 stop the combo box working when
124	+	the datasource is nil. We thus have to reverse out the changes :(}
125	+	function DoEdit: boolean; override;
126	+	procedure Change; override;
127	+	procedure CloseUp; override;
128	+	procedure Select; override;
129	+	{$ifend}
130	+	{$if lcl_fullversion = 2000002}
131	+	procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
132	+	{$ifend}
133		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
134	+	procedure Loaded; override;
135	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
136		procedure SetItemIndex(const Val: integer); override;
137		procedure UpdateShowing; override;
138	+	procedure UpdateData(Sender: TObject); override;
139		public
140		{ Public declarations }
141		constructor Create(TheComponent: TComponent); override;
#	Line 118 | Line 150 | type
150		property ItemHeight;
151		property ItemWidth;
152		property ListSource: TDataSource read GetListSource write SetListSource;
153	<	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
153	>	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
154		property RelationName: string read FRelationName write FRelationName;
155		property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
156		property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
#	Line 127 | Line 159 | type
159
160		implementation
161
162	<	uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
162	>	uses Variants, LCLProc, LazUTF8, IBUtils;
163	>
164	>	{ TIBLookupControlLink }
165	>
166	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
167	>	begin
168	>	inherited Create;
169	>	FOwner := AOwner;
170	>	end;
171	>
172	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
173	>	begin
174	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
175	>	end;
176
177		{ TIBLookupComboDataLink }
178
#	Line 136 | Line 181 | begin
181		FOwner.ActiveChanged(self)
182		end;
183
184	+	{$if lcl_fullversion < 2000003}
185		procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
186		begin
187	<	{If we are not visible then avoid unnecessary work}
188	<	if not FOwner.Showing then Exit;
189	<
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);
187	>	inherited DataEvent(Event, Info);
188	>	if Event = deLayoutChange then
189	>	FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
190		end;
191	+	{$endif}
192
193		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
194		begin
#	Line 172 | Line 209 | end;
209		{ TIBLookupComboEditBox }
210
211		procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
175	–	var ActiveState: boolean;
212		begin
213		FTimer.Interval := 0;
214		FFiltered := Text <> '';
215		UpdateList
216		end;
217
218	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
219	+	begin
220	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
221	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
222	+	else
223	+	FIBLookupControlLink.IBDataSet := nil;
224	+	end;
225	+
226		function TIBLookupComboEditBox.GetListSource: TDataSource;
227		begin
228		Result := inherited ListSource;
#	Line 196 | Line 240 | procedure TIBLookupComboEditBox.ActiveCh
240		begin
241		if not FInserting and not FUpdating then
242		Application.QueueAsyncCall(@DoActiveChanged,0);
243	+	IBControlLinkChanged;
244		end;
245
246		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 282 | begin
282		end;
283
284		procedure TIBLookupComboEditBox.ResetParser;
285	+	var curKeyValue: variant;
286		begin
287		if FFiltered then
288		begin
289		FFiltered := false;
290	+	curKeyValue := KeyValue;
291	+	Text := ''; {Ensure full list}
292		UpdateList;
293	+	KeyValue := curKeyValue;
294		UpdateData(self); {Force Scroll}
295		end;
296		end;
#	Line 276 | Line 325 | begin
325		begin
326		FDataLink.DataSource := AValue;
327		inherited ListSource := AValue;
328	+	IBControlLinkChanged;
329		end;
330		end;
331
#	Line 287 | Line 337 | procedure TIBLookupComboEditBox.UpdateLi
337		var
338		iSelStart: Integer; // char position
339		sCompleteText, sPrefixText, sResultText: string;
290	–	curText: string;
340		begin
341		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
342		and ListSource.DataSet.Active then
343		begin
344	+	FCurText := Text;
345		FUpdating := true;
346		try
347		iSelStart := SelStart;//Capture original cursor position
348		if ((iSelStart < UTF8Length(Text)) and
349		(cbactEndOfLineComplete in AutoCompleteText)) then
350		Exit;
301	–	curText := Text;
351		sPrefixText := UTF8Copy(Text, 1, iSelStart);
352		ListSource.DataSet.Active := false;
353		ListSource.DataSet.Active :=  true;
354	<	Text := curText;
355	<	if not FExiting and Focused and (Text <> '')then
354	>	Text := FCurText;
355	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
356		begin
357		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
358		begin
359		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
360	<	if (sCompleteText <> Text) then
360	>	if (sCompleteText <> FCurText) then
361		begin
362	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
363		sResultText := sCompleteText;
364		if ((cbactEndOfLineComplete in AutoCompleteText) and
365		(cbactRetainPrefixCase in AutoCompleteText)) then
#	Line 319 | Line 369 | begin
369		end;
370		Text := sResultText;
371		SelStart := iSelStart;
372	<	SelLength := UTF8Length(Text);
372	>	SelLength := UTF8Length(Text) - iSelStart;
373		end;
374	+	end
375	+	else
376	+	begin
377	+	SelStart := iSelStart;
378	+	SelLength := 0;
379		end;
380		end;
381		finally
382		FUpdating := false
383		end;
384	+	FModified := true;
385		end;
386		end;
387
388		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
389		Parser: TSelectSQLParser);
390		var FieldPosition: integer;
391	+	FilterText: string;
392		begin
393		if FFiltered then
394		begin
395	+	if FUpdating then
396	+	FilterText := FCurText
397	+	else
398	+	FilterText := Text;
399		if cbactSearchCaseSensitive in AutoCompleteText then
400	<	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
400	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
401	>	SQLSafeString(FilterText) + '%''')
402		else
403	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
403	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
404	>	SQLSafeString(FilterText) + '%'')');
405
406	<	end;
407	<	if cbactSearchAscending in AutoCompleteText then
408	<	begin
409	<	FieldPosition := Parser.GetFieldPosition(ListField);
347	<	if FieldPosition = 0 then Exit;
406	>	if cbactSearchAscending in AutoCompleteText then
407	>	begin
408	>	FieldPosition := Parser.GetFieldPosition(ListField);
409	>	if FieldPosition = 0 then Exit;
410
411	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
411	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
412	>	end;
413		end;
414		end;
415
416		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
417		begin
418	<	SelectAll
418	>	if AppDestroying in Application.Flags then Exit;
419	>	SelectAll
420		end;
421
422		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | Line 429 | procedure TIBLookupComboEditBox.CheckAnd
429		var Accept: boolean;
430		NewKeyValue: variant;
431		begin
432	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
433	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
432	>	if FInCheckAndInsert then Exit;
433	>	FInCheckAndInsert := true;
434		try
435	<	{Is it OK to insert a new list member?}
436	<	Accept := true;
437	<	if assigned(FOnCanAutoInsert) then
438	<	OnCanAutoInsert(self,Text,Accept);
439	<	if not Accept then
440	<	begin
441	<	ResetParser;
442	<	Text := FOriginalTextValue;
443	<	SelectAll;
444	<	Exit;
445	<	end;
435	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
436	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
437	>	try
438	>	{Is it OK to insert a new list member?}
439	>	Accept := true;
440	>	if assigned(FOnCanAutoInsert) then
441	>	OnCanAutoInsert(self,Text,Accept);
442	>	if not Accept then
443	>	begin
444	>	ResetParser;
445	>	Text := FOriginalTextValue;
446	>	SelectAll;
447	>	Exit;
448	>	end;
449
450	<	FInserting := true;
451	<	try
452	<	{New Value}
453	<	FFiltered := false;
454	<	if assigned(FOnAutoInsert) then
455	<	begin
456	<	{In an OnAutoInsert handler, the client is expected to insert the new
457	<	row into the List DataSet and to set the KeyValue property to the
458	<	value of the primary key of the new row.}
459	<	OnAutoInsert(self,Text,NewKeyValue);
460	<	end
461	<	else
462	<	begin
463	<	ListSource.DataSet.Append;
464	<	{The new KeyValue should be determined by an external generator or
465	<	in the "OnInsert" handler. If it is the same as the ListField, then
466	<	it will be set from the UpdateLinkData method}
467	<	try
468	<	ListSource.DataSet.Post;
469	<	except
470	<	ListSource.DataSet.Cancel;
471	<	raise;
472	<	end;
473	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
474	<	end;
475	<	Text := ''; {Ensure full list}
476	<	UpdateList;
477	<	KeyValue := NewKeyValue;
478	<	UpdateData(nil); {Force sync with DataField}
479	<	finally
480	<	FInserting := false
481	<	end;
482	<	except
483	<	Text := FOriginalTextValue;
484	<	ResetParser;
485	<	raise;
450	>	FInserting := true;
451	>	try
452	>	{New Value}
453	>	FFiltered := false;
454	>	if assigned(FOnAutoInsert) then
455	>	begin
456	>	{In an OnAutoInsert handler, the client is expected to insert the new
457	>	row into the List DataSet and to set the KeyValue property to the
458	>	value of the primary key of the new row.}
459	>	OnAutoInsert(self,Text,NewKeyValue);
460	>	end
461	>	else
462	>	begin
463	>	ListSource.DataSet.Append;
464	>	{The new KeyValue should be determined by an external generator or
465	>	in the "OnInsert" handler. If it is the same as the ListField, then
466	>	it will be set from the UpdateLinkData method}
467	>	try
468	>	ListSource.DataSet.Post;
469	>	except
470	>	ListSource.DataSet.Cancel;
471	>	raise;
472	>	end;
473	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
474	>	end;
475	>	Text := ''; {Ensure full list}
476	>	UpdateList;
477	>	KeyValue := NewKeyValue;
478	>	UpdateData(nil); {Force sync with DataField}
479	>	finally
480	>	FInserting := false
481	>	end;
482	>	except
483	>	Text := FOriginalTextValue;
484	>	ResetParser;
485	>	raise;
486	>	end;
487	>	finally
488	>	FInCheckAndInsert := false
489		end;
490		end;
491
#	Line 429 | Line 499 | end;
499
500		procedure TIBLookupComboEditBox.DoExit;
501		begin
502	+	if FTimer.Interval <> 0 then
503	+	HandleTimer(nil);
504		FExiting := true;
505		try
506		CheckAndInsert;
#	Line 443 | Line 515 | end;
515		procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
516		begin
517		inherited KeyUp(Key, Shift);
446	–	if Key = VK_RETURN then
447	–	EditingDone
448	–	else
518		if Key = VK_ESCAPE then
519		begin
520		SelStart := UTF8Length(Text);      {Ensure end of line selection}
#	Line 454 | Line 523 | begin
523		SelectAll;
524		end
525		else
526	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
527	<	and AutoComplete and (Style <> csDropDownList) and
528	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
529	<	FTimer.Interval := FKeyPressInterval
530	<	else
531	<	FTimer.Interval := 0
526	>	if AutoComplete and (Style <> csDropDownList) then
527	>	begin
528	>	if (Key = VK_BACK) or (Key = VK_DELETE) then
529	>	begin
530	>	if SelStart = 0 then
531	>	begin
532	>	SelStart := UTF8Length(Text);
533	>	SelLength := 0;
534	>	end;
535	>	FTimer.Interval := 0;
536	>	end
537	>	else
538	>	if IsEditableTextKey(Key) and
539	>	(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
540	>	begin
541	>	FTimer.Interval := 0;
542	>	FTimer.Interval := FKeyPressInterval;
543	>	end;
544	>	end;
545	>	end;
546	>
547	>	procedure TIBLookupComboEditBox.Loaded;
548	>	begin
549	>	inherited Loaded;
550	>	IBControlLinkChanged;
551	>	end;
552	>
553	>	procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
554	>	Operation: TOperation);
555	>	begin
556	>	inherited Notification(AComponent, Operation);
557	>	if (Operation = opRemove) and (AComponent = DataSource) then
558	>	ListSource := nil;
559		end;
560
561		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
562		begin
563	+	if Val > 0 then
564	+	FCurText := '';
565		inherited SetItemIndex(Val);
566		FLastKeyValue := KeyValue;
567		end;
#	Line 475 | 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	+
585	+	{Workarounds due to bugs in various Lazarus 2.0 release candidates}
586	+	{$if lcl_fullversion >= 2000002}
587	+	type
588	+
589	+	{ THackedCustomComboBox }
590	+
591	+	THackedCustomComboBox = class(TCustomComboBox)
592	+	private
593	+	procedure CallChange;
594	+	procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
595	+	end;
596	+
597	+	{ THackedCustomComboBox }
598	+
599	+	procedure THackedCustomComboBox.CallChange;
600	+	begin
601	+	inherited Change;
602	+	end;
603	+
604	+	procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
605	+	begin
606	+	inherited UTF8KeyPress(UTF8Key);
607	+	end;
608	+
609	+	procedure TIBLookupComboEditBox.Change;
610	+	begin
611	+	if DataSource = nil then
612	+	THackedCustomComboBox(self).CallChange
613	+	else
614	+	inherited Change;
615	+	end;
616	+
617	+	procedure TIBLookupComboEditBox.CloseUp;
618	+	begin
619	+	inherited DoEdit;
620	+	inherited CloseUp;
621	+	EditingDone;
622	+	end;
623	+
624	+	procedure TIBLookupComboEditBox.Select;
625	+	begin
626	+	inherited Select;
627	+	if DataSource = nil then
628	+	inherited DoEdit;
629	+	end;
630	+
631	+	function TIBLookupComboEditBox.DoEdit: boolean;
632	+	begin
633	+	{DoEdit will swallow characters if no editable Field. Hence, to enabled
634	+	writing we must avoid calling the inherited method.}
635	+	if DataSource = nil then
636	+	Result := true
637	+	else
638	+	Result := inherited DoEdit;
639	+	end;
640	+	{$ifend}
641	+
642	+	{$if lcl_fullversion = 2000002}
643	+	procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
644	+	begin
645	+	if DataSource = nil then
646	+	THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key)
647	+	else
648	+	inherited;
649	+	end;
650	+	{$ifend}
651	+
652	+
653		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
654		begin
655		inherited Create(TheComponent);
656		FDataLink := TIBLookupComboDataLink.Create(self);
657	<	FKeyPressInterval := 500;
657	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
658	>	FKeyPressInterval := 200;
659		FAutoComplete := true;
660		FTimer := TTimer.Create(nil);
661		FTimer.Interval := 0;
#	Line 490 | Line 666 | end;
666		destructor TIBLookupComboEditBox.Destroy;
667		begin
668		if assigned(FDataLink) then FDataLink.Free;
669	+	if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
670		if assigned(FTimer) then FTimer.Free;
671	+	Application.RemoveAsyncCalls(self);
672		inherited Destroy;
673		end;
674
675		procedure TIBLookupComboEditBox.EditingDone;
676		begin
677	+	FForceAutoComplete := true;
678	+	try
679	+	if FTimer.Interval <> 0 then
680	+	HandleTimer(nil);
681	+	finally
682	+	FForceAutoComplete := false;
683	+	end;
684		CheckAndInsert;
685	+	FCurText := '';
686	+	if FModified then
687	+	Change; {ensure Update}
688		inherited EditingDone;
689		end;
690

Diff Legend

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