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 275 by tony, Mon Feb 4 13:41:10 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		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
131	+	procedure Loaded; override;
132	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
133		procedure SetItemIndex(const Val: integer); override;
134		procedure UpdateShowing; override;
135	+	procedure UpdateData(Sender: TObject); override;
136		public
137		{ Public declarations }
138		constructor Create(TheComponent: TComponent); override;
#	Line 118 | Line 147 | type
147		property ItemHeight;
148		property ItemWidth;
149		property ListSource: TDataSource read GetListSource write SetListSource;
150	<	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
150	>	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
151		property RelationName: string read FRelationName write FRelationName;
152		property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
153		property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
#	Line 127 | Line 156 | type
156
157		implementation
158
159	<	uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
159	>	uses Variants, LCLProc, LazUTF8, IBUtils;
160	>
161	>	{ TIBLookupControlLink }
162	>
163	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
164	>	begin
165	>	inherited Create;
166	>	FOwner := AOwner;
167	>	end;
168	>
169	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
170	>	begin
171	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
172	>	end;
173
174		{ TIBLookupComboDataLink }
175
#	Line 136 | Line 178 | begin
178		FOwner.ActiveChanged(self)
179		end;
180
181	+	{$if lcl_fullversion < 2000003}
182		procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
183		begin
184	<	{If we are not visible then avoid unnecessary work}
185	<	if not FOwner.Showing then Exit;
186	<
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);
184	>	inherited DataEvent(Event, Info);
185	>	if Event = deLayoutChange then
186	>	FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
187		end;
188	+	{$endif}
189
190		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
191		begin
#	Line 172 | Line 206 | end;
206		{ TIBLookupComboEditBox }
207
208		procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
175	–	var ActiveState: boolean;
209		begin
210		FTimer.Interval := 0;
211		FFiltered := Text <> '';
212		UpdateList
213		end;
214
215	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
216	+	begin
217	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
218	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
219	+	else
220	+	FIBLookupControlLink.IBDataSet := nil;
221	+	end;
222	+
223		function TIBLookupComboEditBox.GetListSource: TDataSource;
224		begin
225		Result := inherited ListSource;
#	Line 196 | Line 237 | procedure TIBLookupComboEditBox.ActiveCh
237		begin
238		if not FInserting and not FUpdating then
239		Application.QueueAsyncCall(@DoActiveChanged,0);
240	+	IBControlLinkChanged;
241		end;
242
243		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 279 | begin
279		end;
280
281		procedure TIBLookupComboEditBox.ResetParser;
282	+	var curKeyValue: variant;
283		begin
284		if FFiltered then
285		begin
286		FFiltered := false;
287	+	curKeyValue := KeyValue;
288	+	Text := ''; {Ensure full list}
289		UpdateList;
290	+	KeyValue := curKeyValue;
291		UpdateData(self); {Force Scroll}
292		end;
293		end;
#	Line 276 | Line 322 | begin
322		begin
323		FDataLink.DataSource := AValue;
324		inherited ListSource := AValue;
325	+	IBControlLinkChanged;
326		end;
327		end;
328
#	Line 287 | Line 334 | procedure TIBLookupComboEditBox.UpdateLi
334		var
335		iSelStart: Integer; // char position
336		sCompleteText, sPrefixText, sResultText: string;
290	–	curText: string;
337		begin
338		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
339		and ListSource.DataSet.Active then
340		begin
341	+	FCurText := Text;
342		FUpdating := true;
343		try
344		iSelStart := SelStart;//Capture original cursor position
345		if ((iSelStart < UTF8Length(Text)) and
346		(cbactEndOfLineComplete in AutoCompleteText)) then
347		Exit;
301	–	curText := Text;
348		sPrefixText := UTF8Copy(Text, 1, iSelStart);
349		ListSource.DataSet.Active := false;
350		ListSource.DataSet.Active :=  true;
351	<	Text := curText;
352	<	if not FExiting and Focused and (Text <> '')then
351	>	Text := FCurText;
352	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
353		begin
354		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
355		begin
356		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
357	<	if (sCompleteText <> Text) then
357	>	if (sCompleteText <> FCurText) then
358		begin
359	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
360		sResultText := sCompleteText;
361		if ((cbactEndOfLineComplete in AutoCompleteText) and
362		(cbactRetainPrefixCase in AutoCompleteText)) then
#	Line 319 | Line 366 | begin
366		end;
367		Text := sResultText;
368		SelStart := iSelStart;
369	<	SelLength := UTF8Length(Text);
369	>	SelLength := UTF8Length(Text) - iSelStart;
370		end;
371	+	end
372	+	else
373	+	begin
374	+	SelStart := iSelStart;
375	+	SelLength := 0;
376		end;
377		end;
378		finally
379		FUpdating := false
380		end;
381	+	FModified := true;
382		end;
383		end;
384
385		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
386		Parser: TSelectSQLParser);
387		var FieldPosition: integer;
388	+	FilterText: string;
389		begin
390		if FFiltered then
391		begin
392	+	if FUpdating then
393	+	FilterText := FCurText
394	+	else
395	+	FilterText := Text;
396		if cbactSearchCaseSensitive in AutoCompleteText then
397	<	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
397	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
398	>	SQLSafeString(FilterText) + '%''')
399		else
400	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
400	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
401	>	SQLSafeString(FilterText) + '%'')');
402
403	<	end;
404	<	if cbactSearchAscending in AutoCompleteText then
405	<	begin
406	<	FieldPosition := Parser.GetFieldPosition(ListField);
347	<	if FieldPosition = 0 then Exit;
403	>	if cbactSearchAscending in AutoCompleteText then
404	>	begin
405	>	FieldPosition := Parser.GetFieldPosition(ListField);
406	>	if FieldPosition = 0 then Exit;
407
408	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
408	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
409	>	end;
410		end;
411		end;
412
413		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
414		begin
415	<	SelectAll
415	>	if AppDestroying in Application.Flags then Exit;
416	>	SelectAll
417		end;
418
419		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | Line 426 | procedure TIBLookupComboEditBox.CheckAnd
426		var Accept: boolean;
427		NewKeyValue: variant;
428		begin
429	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
430	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
429	>	if FInCheckAndInsert then Exit;
430	>	FInCheckAndInsert := true;
431		try
432	<	{Is it OK to insert a new list member?}
433	<	Accept := true;
434	<	if assigned(FOnCanAutoInsert) then
435	<	OnCanAutoInsert(self,Text,Accept);
436	<	if not Accept then
437	<	begin
438	<	ResetParser;
439	<	Text := FOriginalTextValue;
440	<	SelectAll;
441	<	Exit;
442	<	end;
432	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
433	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
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;
446
447	<	FInserting := true;
448	<	try
449	<	{New Value}
450	<	FFiltered := false;
451	<	if assigned(FOnAutoInsert) then
452	<	begin
453	<	{In an OnAutoInsert handler, the client is expected to insert the new
454	<	row into the List DataSet and to set the KeyValue property to the
455	<	value of the primary key of the new row.}
456	<	OnAutoInsert(self,Text,NewKeyValue);
457	<	end
458	<	else
459	<	begin
460	<	ListSource.DataSet.Append;
461	<	{The new KeyValue should be determined by an external generator or
462	<	in the "OnInsert" handler. If it is the same as the ListField, then
463	<	it will be set from the UpdateLinkData method}
464	<	try
465	<	ListSource.DataSet.Post;
466	<	except
467	<	ListSource.DataSet.Cancel;
468	<	raise;
469	<	end;
470	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
471	<	end;
472	<	Text := ''; {Ensure full list}
473	<	UpdateList;
474	<	KeyValue := NewKeyValue;
475	<	UpdateData(nil); {Force sync with DataField}
476	<	finally
477	<	FInserting := false
478	<	end;
479	<	except
480	<	Text := FOriginalTextValue;
481	<	ResetParser;
482	<	raise;
447	>	FInserting := true;
448	>	try
449	>	{New Value}
450	>	FFiltered := false;
451	>	if assigned(FOnAutoInsert) then
452	>	begin
453	>	{In an OnAutoInsert handler, the client is expected to insert the new
454	>	row into the List DataSet and to set the KeyValue property to the
455	>	value of the primary key of the new row.}
456	>	OnAutoInsert(self,Text,NewKeyValue);
457	>	end
458	>	else
459	>	begin
460	>	ListSource.DataSet.Append;
461	>	{The new KeyValue should be determined by an external generator or
462	>	in the "OnInsert" handler. If it is the same as the ListField, then
463	>	it will be set from the UpdateLinkData method}
464	>	try
465	>	ListSource.DataSet.Post;
466	>	except
467	>	ListSource.DataSet.Cancel;
468	>	raise;
469	>	end;
470	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
471	>	end;
472	>	Text := ''; {Ensure full list}
473	>	UpdateList;
474	>	KeyValue := NewKeyValue;
475	>	UpdateData(nil); {Force sync with DataField}
476	>	finally
477	>	FInserting := false
478	>	end;
479	>	except
480	>	Text := FOriginalTextValue;
481	>	ResetParser;
482	>	raise;
483	>	end;
484	>	finally
485	>	FInCheckAndInsert := false
486		end;
487		end;
488
#	Line 429 | Line 496 | end;
496
497		procedure TIBLookupComboEditBox.DoExit;
498		begin
499	+	if FTimer.Interval <> 0 then
500	+	HandleTimer(nil);
501		FExiting := true;
502		try
503		CheckAndInsert;
#	Line 443 | Line 512 | end;
512		procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
513		begin
514		inherited KeyUp(Key, Shift);
446	–	if Key = VK_RETURN then
447	–	EditingDone
448	–	else
515		if Key = VK_ESCAPE then
516		begin
517		SelStart := UTF8Length(Text);      {Ensure end of line selection}
#	Line 454 | Line 520 | begin
520		SelectAll;
521		end
522		else
523	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
524	<	and AutoComplete and (Style <> csDropDownList) and
525	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
526	<	FTimer.Interval := FKeyPressInterval
527	<	else
528	<	FTimer.Interval := 0
523	>	if AutoComplete and (Style <> csDropDownList) then
524	>	begin
525	>	if (Key = VK_BACK) or (Key = VK_DELETE) then
526	>	begin
527	>	if SelStart = 0 then
528	>	begin
529	>	SelStart := UTF8Length(Text);
530	>	SelLength := 0;
531	>	end;
532	>	FTimer.Interval := 0;
533	>	end
534	>	else
535	>	if IsEditableTextKey(Key) and
536	>	(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
537	>	begin
538	>	FTimer.Interval := 0;
539	>	FTimer.Interval := FKeyPressInterval;
540	>	end;
541	>	end;
542	>	end;
543	>
544	>	procedure TIBLookupComboEditBox.Loaded;
545	>	begin
546	>	inherited Loaded;
547	>	IBControlLinkChanged;
548	>	end;
549	>
550	>	procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
551	>	Operation: TOperation);
552	>	begin
553	>	inherited Notification(AComponent, Operation);
554	>	if (Operation = opRemove) and (AComponent = DataSource) then
555	>	ListSource := nil;
556		end;
557
558		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
559		begin
560	+	if Val > 0 then
561	+	FCurText := '';
562		inherited SetItemIndex(Val);
563		FLastKeyValue := KeyValue;
564		end;
#	Line 475 | Line 570 | begin
570		ActiveChanged(nil);
571		end;
572
573	+	procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
574	+	begin
575	+	inherited UpdateData(Sender);
576	+	if FCurText <> '' then
577	+	Text := FCurText + Text;
578	+	FModified := false;
579	+	end;
580	+
581	+	{$if lcl_fullversion >= 2000002}
582	+	type
583	+
584	+	{ THackedCustomComboBox }
585	+
586	+	THackedCustomComboBox = class(TCustomComboBox)
587	+	private
588	+	procedure CallChange;
589	+	end;
590	+
591	+	{ THackedCustomComboBox }
592	+
593	+	procedure THackedCustomComboBox.CallChange;
594	+	begin
595	+	inherited Change;
596	+	end;
597	+
598	+	procedure TIBLookupComboEditBox.Change;
599	+	begin
600	+	if DataSource = nil then
601	+	THackedCustomComboBox(self).CallChange
602	+	else
603	+	inherited Change;
604	+	end;
605	+
606	+	procedure TIBLookupComboEditBox.CloseUp;
607	+	begin
608	+	inherited DoEdit;
609	+	inherited CloseUp;
610	+	EditingDone;
611	+	end;
612	+
613	+	procedure TIBLookupComboEditBox.Select;
614	+	begin
615	+	inherited Select;
616	+	if DataSource = nil then
617	+	inherited DoEdit;
618	+	end;
619	+
620	+	function TIBLookupComboEditBox.DoEdit: boolean;
621	+	begin
622	+	{DoEdit will swallow characters if no editable Field. Hence, to enabled
623	+	writing we must avoid calling the inherited method.}
624	+	if DataSource = nil then
625	+	Result := true
626	+	else
627	+	Result := inherited DoEdit;
628	+	end;
629	+	{$ifend}
630	+
631		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
632		begin
633		inherited Create(TheComponent);
634		FDataLink := TIBLookupComboDataLink.Create(self);
635	<	FKeyPressInterval := 500;
635	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
636	>	FKeyPressInterval := 200;
637		FAutoComplete := true;
638		FTimer := TTimer.Create(nil);
639		FTimer.Interval := 0;
#	Line 490 | Line 644 | end;
644		destructor TIBLookupComboEditBox.Destroy;
645		begin
646		if assigned(FDataLink) then FDataLink.Free;
647	+	if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
648		if assigned(FTimer) then FTimer.Free;
649	+	Application.RemoveAsyncCalls(self);
650		inherited Destroy;
651		end;
652
653		procedure TIBLookupComboEditBox.EditingDone;
654		begin
655	+	FForceAutoComplete := true;
656	+	try
657	+	if FTimer.Interval <> 0 then
658	+	HandleTimer(nil);
659	+	finally
660	+	FForceAutoComplete := false;
661	+	end;
662		CheckAndInsert;
663	+	FCurText := '';
664	+	if FModified then
665	+	Change; {ensure Update}
666		inherited EditingDone;
667		end;
668

Diff Legend

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