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 65 by tony, Wed Jul 12 09:13:04 2017 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, LCLVersion;
35
36		type
37
#	Line 54 | Line 54 | type
54		FOwner: TIBLookupComboEditBox;
55		protected
56		procedure ActiveChanged; override;
57	–	procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
57		procedure RecordChanged(Field: TField); override;
58		procedure UpdateData; override;
59		public
60		constructor Create(AOwner: TIBLookupComboEditBox);
61		end;
62
63	+	{ TIBLookupControlLink }
64	+
65	+	TIBLookupControlLink = class(TIBControlLink)
66	+	private
67	+	FOwner: TIBLookupComboEditBox;
68	+	protected
69	+	procedure UpdateSQL(Sender: TObject); override;
70	+	public
71	+	constructor Create(AOwner: TIBLookupComboEditBox);
72	+	end;
73	+
74
75		{ TIBLookupComboEditBox }
76
#	Line 69 | Line 79 | type
79		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		procedure DoActiveChanged(Data: PtrInt);
100		function GetAutoCompleteText: TComboBoxAutoCompleteText;
101		function GetListSource: TDataSource;
102		function GetRelationNameQualifier: string;
103		procedure HandleTimer(Sender: TObject);
104	+	procedure IBControlLinkChanged;
105		procedure ResetParser;
106		procedure RecordChanged(Sender: TObject; aField: TField);
107		procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
#	Line 102 | Line 117 | type
117		procedure DoEnter; override;
118		procedure DoExit; override;
119		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
120	+	procedure Loaded; override;
121	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
122		procedure SetItemIndex(const Val: integer); override;
123	+	function SQLSafe(aText: string): string;
124		procedure UpdateShowing; override;
125	+
126		public
127		{ Public declarations }
128		constructor Create(TheComponent: TComponent); override;
#	Line 118 | Line 137 | type
137		property ItemHeight;
138		property ItemWidth;
139		property ListSource: TDataSource read GetListSource write SetListSource;
140	<	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
140	>	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
141		property RelationName: string read FRelationName write FRelationName;
142		property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
143		property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
#	Line 127 | Line 146 | type
146
147		implementation
148
149	<	uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
149	>	uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
150
151	<	{ TIBLookupComboDataLink }
151	>	{ TIBLookupControlLink }
152
153	<	procedure TIBLookupComboDataLink.ActiveChanged;
153	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
154		begin
155	<	FOwner.ActiveChanged(self)
155	>	inherited Create;
156	>	FOwner := AOwner;
157		end;
158
159	<	procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
159	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
160		begin
161	<	{If we are not visible then avoid unnecessary work}
162	<	if not FOwner.Showing then Exit;
161	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
162	>	end;
163
164	<	if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
165	<	begin
166	<	if (DataSet is TIBDataSet) then
167	<	FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
168	<	else
149	<	if (DataSet is TIBQuery) then
150	<	FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
151	<	end
152	<	else
153	<	inherited DataEvent(Event, Info);
164	>	{ TIBLookupComboDataLink }
165	>
166	>	procedure TIBLookupComboDataLink.ActiveChanged;
167	>	begin
168	>	FOwner.ActiveChanged(self)
169		end;
170
171		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
#	Line 179 | Line 194 | begin
194		UpdateList
195		end;
196
197	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
198	+	begin
199	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
200	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
201	+	else
202	+	FIBLookupControlLink.IBDataSet := nil;
203	+	end;
204	+
205		function TIBLookupComboEditBox.GetListSource: TDataSource;
206		begin
207		Result := inherited ListSource;
#	Line 196 | Line 219 | procedure TIBLookupComboEditBox.ActiveCh
219		begin
220		if not FInserting and not FUpdating then
221		Application.QueueAsyncCall(@DoActiveChanged,0);
222	+	IBControlLinkChanged;
223		end;
224
225		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 261 | begin
261		end;
262
263		procedure TIBLookupComboEditBox.ResetParser;
264	+	var curKeyValue: variant;
265		begin
266		if FFiltered then
267		begin
268		FFiltered := false;
269	+	curKeyValue := KeyValue;
270	+	Text := ''; {Ensure full list}
271		UpdateList;
272	+	KeyValue := curKeyValue;
273		UpdateData(self); {Force Scroll}
274		end;
275		end;
#	Line 276 | Line 304 | begin
304		begin
305		FDataLink.DataSource := AValue;
306		inherited ListSource := AValue;
307	+	IBControlLinkChanged;
308		end;
309		end;
310
#	Line 287 | Line 316 | procedure TIBLookupComboEditBox.UpdateLi
316		var
317		iSelStart: Integer; // char position
318		sCompleteText, sPrefixText, sResultText: string;
290	–	curText: string;
319		begin
320		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
321		and ListSource.DataSet.Active then
322		begin
323	+	FCurText := Text;
324		FUpdating := true;
325		try
326		iSelStart := SelStart;//Capture original cursor position
327		if ((iSelStart < UTF8Length(Text)) and
328		(cbactEndOfLineComplete in AutoCompleteText)) then
329		Exit;
301	–	curText := Text;
330		sPrefixText := UTF8Copy(Text, 1, iSelStart);
331		ListSource.DataSet.Active := false;
332		ListSource.DataSet.Active :=  true;
333	<	Text := curText;
334	<	if not FExiting and Focused and (Text <> '')then
333	>	Text := FCurText;
334	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
335		begin
336		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
337		begin
338		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
339	<	if (sCompleteText <> Text) then
339	>	if (sCompleteText <> FCurText) then
340		begin
341		sResultText := sCompleteText;
342		if ((cbactEndOfLineComplete in AutoCompleteText) and
#	Line 321 | Line 349 | begin
349		SelStart := iSelStart;
350		SelLength := UTF8Length(Text);
351		end;
352	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
353	+	end
354	+	else
355	+	begin
356	+	SelStart := iSelStart;
357	+	SelLength := 0;
358		end;
359		end;
360		finally
#	Line 332 | Line 366 | end;
366		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
367		Parser: TSelectSQLParser);
368		var FieldPosition: integer;
369	+	FilterText: string;
370		begin
371		if FFiltered then
372		begin
373	+	if FUpdating then
374	+	FilterText := FCurText
375	+	else
376	+	FilterText := Text;
377		if cbactSearchCaseSensitive in AutoCompleteText then
378	<	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
378	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
379	>	SQLSafe(FilterText) + '%''')
380		else
381	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
381	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
382	>	SQLSafe(FilterText) + '%'')');
383
384	<	end;
385	<	if cbactSearchAscending in AutoCompleteText then
386	<	begin
387	<	FieldPosition := Parser.GetFieldPosition(ListField);
347	<	if FieldPosition = 0 then Exit;
384	>	if cbactSearchAscending in AutoCompleteText then
385	>	begin
386	>	FieldPosition := Parser.GetFieldPosition(ListField);
387	>	if FieldPosition = 0 then Exit;
388
389	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
389	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
390	>	end;
391		end;
392		end;
393
394		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
395		begin
396	<	SelectAll
396	>	if AppDestroying in Application.Flags then Exit;
397	>	SelectAll
398		end;
399
400		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | Line 407 | procedure TIBLookupComboEditBox.CheckAnd
407		var Accept: boolean;
408		NewKeyValue: variant;
409		begin
410	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
411	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
410	>	if FInCheckAndInsert then Exit;
411	>	FInCheckAndInsert := true;
412		try
413	<	{Is it OK to insert a new list member?}
414	<	Accept := true;
415	<	if assigned(FOnCanAutoInsert) then
416	<	OnCanAutoInsert(self,Text,Accept);
417	<	if not Accept then
418	<	begin
419	<	ResetParser;
420	<	Text := FOriginalTextValue;
421	<	SelectAll;
422	<	Exit;
423	<	end;
413	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
414	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
415	>	try
416	>	{Is it OK to insert a new list member?}
417	>	Accept := true;
418	>	if assigned(FOnCanAutoInsert) then
419	>	OnCanAutoInsert(self,Text,Accept);
420	>	if not Accept then
421	>	begin
422	>	ResetParser;
423	>	Text := FOriginalTextValue;
424	>	SelectAll;
425	>	Exit;
426	>	end;
427
428	<	FInserting := true;
429	<	try
430	<	{New Value}
431	<	FFiltered := false;
432	<	if assigned(FOnAutoInsert) then
433	<	begin
434	<	{In an OnAutoInsert handler, the client is expected to insert the new
435	<	row into the List DataSet and to set the KeyValue property to the
436	<	value of the primary key of the new row.}
437	<	OnAutoInsert(self,Text,NewKeyValue);
438	<	end
439	<	else
440	<	begin
441	<	ListSource.DataSet.Append;
442	<	{The new KeyValue should be determined by an external generator or
443	<	in the "OnInsert" handler. If it is the same as the ListField, then
444	<	it will be set from the UpdateLinkData method}
445	<	try
446	<	ListSource.DataSet.Post;
447	<	except
448	<	ListSource.DataSet.Cancel;
449	<	raise;
450	<	end;
451	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
452	<	end;
453	<	UpdateList;
454	<	KeyValue := NewKeyValue;
455	<	UpdateData(nil); {Force sync with DataField}
456	<	finally
457	<	FInserting := false
458	<	end;
459	<	except
460	<	Text := FOriginalTextValue;
461	<	ResetParser;
462	<	raise;
428	>	FInserting := true;
429	>	try
430	>	{New Value}
431	>	FFiltered := false;
432	>	if assigned(FOnAutoInsert) then
433	>	begin
434	>	{In an OnAutoInsert handler, the client is expected to insert the new
435	>	row into the List DataSet and to set the KeyValue property to the
436	>	value of the primary key of the new row.}
437	>	OnAutoInsert(self,Text,NewKeyValue);
438	>	end
439	>	else
440	>	begin
441	>	ListSource.DataSet.Append;
442	>	{The new KeyValue should be determined by an external generator or
443	>	in the "OnInsert" handler. If it is the same as the ListField, then
444	>	it will be set from the UpdateLinkData method}
445	>	try
446	>	ListSource.DataSet.Post;
447	>	except
448	>	ListSource.DataSet.Cancel;
449	>	raise;
450	>	end;
451	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
452	>	end;
453	>	Text := ''; {Ensure full list}
454	>	UpdateList;
455	>	KeyValue := NewKeyValue;
456	>	UpdateData(nil); {Force sync with DataField}
457	>	finally
458	>	FInserting := false
459	>	end;
460	>	except
461	>	Text := FOriginalTextValue;
462	>	ResetParser;
463	>	raise;
464	>	end;
465	>	finally
466	>	FInCheckAndInsert := false
467		end;
468		end;
469
#	Line 428 | Line 477 | end;
477
478		procedure TIBLookupComboEditBox.DoExit;
479		begin
480	+	if FTimer.Interval <> 0 then
481	+	HandleTimer(nil);
482		FExiting := true;
483		try
484		CheckAndInsert;
#	Line 453 | Line 504 | begin
504		SelectAll;
505		end
506		else
507	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
508	<	and AutoComplete and (Style <> csDropDownList) and
509	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
510	<	FTimer.Interval := FKeyPressInterval
511	<	else
512	<	FTimer.Interval := 0
507	>	begin
508	>	FTimer.Interval := 0;
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	>	end;
514	>	end;
515	>
516	>	procedure TIBLookupComboEditBox.Loaded;
517	>	begin
518	>	inherited Loaded;
519	>	IBControlLinkChanged;
520	>	end;
521	>
522	>	procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
523	>	Operation: TOperation);
524	>	begin
525	>	inherited Notification(AComponent, Operation);
526	>	if (Operation = opRemove) and (AComponent = DataSource) then
527	>	ListSource := nil;
528		end;
529
530		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
#	Line 467 | Line 533 | begin
533		FLastKeyValue := KeyValue;
534		end;
535
536	+	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
537	+	var I: integer;
538	+	begin
539	+	Result := '';
540	+	for I := 1 to length(aText) do
541	+	if aText[I] = '''' then
542	+	Result := Result + ''''''
543	+	else
544	+	Result := Result + aText[I];
545	+	end;
546	+
547		procedure TIBLookupComboEditBox.UpdateShowing;
548		begin
549		inherited UpdateShowing;
#	Line 478 | Line 555 | constructor TIBLookupComboEditBox.Create
555		begin
556		inherited Create(TheComponent);
557		FDataLink := TIBLookupComboDataLink.Create(self);
558	<	FKeyPressInterval := 500;
558	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
559	>	FKeyPressInterval := 200;
560		FAutoComplete := true;
561		FTimer := TTimer.Create(nil);
562		FTimer.Interval := 0;
#	Line 489 | Line 567 | end;
567		destructor TIBLookupComboEditBox.Destroy;
568		begin
569		if assigned(FDataLink) then FDataLink.Free;
570	+	if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
571		if assigned(FTimer) then FTimer.Free;
572		inherited Destroy;
573		end;
574
575		procedure TIBLookupComboEditBox.EditingDone;
576		begin
577	+	FForceAutoComplete := true;
578	+	try
579	+	if FTimer.Interval <> 0 then
580	+	HandleTimer(nil);
581	+	finally
582	+	FForceAutoComplete := false;
583	+	end;
584		CheckAndInsert;
585		inherited EditingDone;
586		end;

Diff Legend

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