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 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 225 by tony, Tue Apr 3 09:09:05 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;
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
78		TIBLookupComboEditBox = class(TDBLookupComboBox)
79		private
69	–	FCanAutoInsert: TCanAutoInsert;
80		{ Private declarations }
81		FDataLink: TIBLookupComboDataLink;
82	+	FIBLookupControlLink: TIBLookupControlLink;
83		FAutoComplete: boolean;
84		FAutoInsert: boolean;
85		FKeyPressInterval: integer;
#	Line 81 | 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;
103		function GetRelationNameQualifier: string;
104		procedure HandleTimer(Sender: TObject);
105	+	procedure IBControlLinkChanged;
106		procedure ResetParser;
107		procedure RecordChanged(Sender: TObject; aField: TField);
108		procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
#	Line 102 | 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	+	procedure UpdateData(Sender: TObject); override;
127		public
128		{ Public declarations }
129		constructor Create(TheComponent: TComponent); override;
#	Line 118 | Line 138 | type
138		property ItemHeight;
139		property ItemWidth;
140		property ListSource: TDataSource read GetListSource write SetListSource;
141	<	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
141	>	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
142		property RelationName: string read FRelationName write FRelationName;
143		property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
144		property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
#	Line 127 | Line 147 | type
147
148		implementation
149
150	<	uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
150	>	uses LCLType, Variants, LCLProc, LazUTF8;
151	>
152	>	{ TIBLookupControlLink }
153	>
154	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
155	>	begin
156	>	inherited Create;
157	>	FOwner := AOwner;
158	>	end;
159	>
160	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
161	>	begin
162	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
163	>	end;
164
165		{ TIBLookupComboDataLink }
166
#	Line 138 | Line 171 | end;
171
172		procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
173		begin
174	<	{If we are not visible then avoid unnecessary work}
175	<	if not FOwner.Showing then Exit;
176	<
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);
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);
#	Line 172 | Line 195 | end;
195		{ TIBLookupComboEditBox }
196
197		procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
175	–	var ActiveState: boolean;
198		begin
199		FTimer.Interval := 0;
200		FFiltered := Text <> '';
201		UpdateList
202		end;
203
204	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
205	+	begin
206	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
207	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
208	+	else
209	+	FIBLookupControlLink.IBDataSet := nil;
210	+	end;
211	+
212		function TIBLookupComboEditBox.GetListSource: TDataSource;
213		begin
214		Result := inherited ListSource;
#	Line 196 | Line 226 | procedure TIBLookupComboEditBox.ActiveCh
226		begin
227		if not FInserting and not FUpdating then
228		Application.QueueAsyncCall(@DoActiveChanged,0);
229	+	IBControlLinkChanged;
230		end;
231
232		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 268 | begin
268		end;
269
270		procedure TIBLookupComboEditBox.ResetParser;
271	+	var curKeyValue: variant;
272		begin
273		if FFiltered then
274		begin
275		FFiltered := false;
276	+	curKeyValue := KeyValue;
277	+	Text := ''; {Ensure full list}
278		UpdateList;
279	+	KeyValue := curKeyValue;
280		UpdateData(self); {Force Scroll}
281		end;
282		end;
#	Line 276 | Line 311 | begin
311		begin
312		FDataLink.DataSource := AValue;
313		inherited ListSource := AValue;
314	+	IBControlLinkChanged;
315		end;
316		end;
317
#	Line 287 | Line 323 | procedure TIBLookupComboEditBox.UpdateLi
323		var
324		iSelStart: Integer; // char position
325		sCompleteText, sPrefixText, sResultText: string;
290	–	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;
301	–	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 319 | 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 ''' + Text + '%''')
386	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
387	>	SQLSafe(FilterText) + '%''')
388		else
389	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + 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);
347	<	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	<	SelectAll
404	>	if AppDestroying in Application.Flags then Exit;
405	>	SelectAll
406		end;
407
408		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | 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	<	UpdateList;
462	<	KeyValue := NewKeyValue;
463	<	UpdateData(nil); {Force sync with DataField}
464	<	finally
465	<	FInserting := false
466	<	end;
467	<	except
468	<	Text := FOriginalTextValue;
469	<	ResetParser;
470	<	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 428 | 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 453 | 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;
543	>	Operation: TOperation);
544	>	begin
545	>	inherited Notification(AComponent, Operation);
546	>	if (Operation = opRemove) and (AComponent = DataSource) then
547	>	ListSource := nil;
548		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;
557
558	+	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
559	+	var I: integer;
560	+	begin
561	+	Result := '';
562	+	for I := 1 to length(aText) do
563	+	if aText[I] = '''' then
564	+	Result := Result + ''''''
565	+	else
566	+	Result := Result + aText[I];
567	+	end;
568	+
569		procedure TIBLookupComboEditBox.UpdateShowing;
570		begin
571		inherited UpdateShowing;
#	Line 474 | 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);
587		FDataLink := TIBLookupComboDataLink.Create(self);
588	<	FKeyPressInterval := 500;
588	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
589	>	FKeyPressInterval := 200;
590		FAutoComplete := true;
591		FTimer := TTimer.Create(nil);
592		FTimer.Interval := 0;
#	Line 489 | Line 597 | end;
597		destructor TIBLookupComboEditBox.Destroy;
598		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