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 143 by tony, Fri Feb 23 12:11:21 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, 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	+	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 IBQuery, LCLType, Variants, LCLProc, LazUTF8;
151
152	<	{ TIBLookupComboDataLink }
152	>	{ TIBLookupControlLink }
153
154	<	procedure TIBLookupComboDataLink.ActiveChanged;
154	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
155		begin
156	<	FOwner.ActiveChanged(self)
156	>	inherited Create;
157	>	FOwner := AOwner;
158		end;
159
160	<	procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
160	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
161		begin
162	<	{If we are not visible then avoid unnecessary work}
163	<	if not FOwner.Showing then Exit;
162	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
163	>	end;
164
165	<	if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
166	<	begin
167	<	if (DataSet is TIBDataSet) then
168	<	FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
169	<	else
149	<	if (DataSet is TIBQuery) then
150	<	FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
151	<	end
152	<	else
153	<	inherited DataEvent(Event, Info);
165	>	{ TIBLookupComboDataLink }
166	>
167	>	procedure TIBLookupComboDataLink.ActiveChanged;
168	>	begin
169	>	FOwner.ActiveChanged(self)
170		end;
171
172		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
#	Line 179 | Line 195 | begin
195		UpdateList
196		end;
197
198	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
199	+	begin
200	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
201	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
202	+	else
203	+	FIBLookupControlLink.IBDataSet := nil;
204	+	end;
205	+
206		function TIBLookupComboEditBox.GetListSource: TDataSource;
207		begin
208		Result := inherited ListSource;
#	Line 196 | Line 220 | procedure TIBLookupComboEditBox.ActiveCh
220		begin
221		if not FInserting and not FUpdating then
222		Application.QueueAsyncCall(@DoActiveChanged,0);
223	+	IBControlLinkChanged;
224		end;
225
226		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 262 | begin
262		end;
263
264		procedure TIBLookupComboEditBox.ResetParser;
265	+	var curKeyValue: variant;
266		begin
267		if FFiltered then
268		begin
269		FFiltered := false;
270	+	curKeyValue := KeyValue;
271	+	Text := ''; {Ensure full list}
272		UpdateList;
273	+	KeyValue := curKeyValue;
274		UpdateData(self); {Force Scroll}
275		end;
276		end;
#	Line 276 | Line 305 | begin
305		begin
306		FDataLink.DataSource := AValue;
307		inherited ListSource := AValue;
308	+	IBControlLinkChanged;
309		end;
310		end;
311
#	Line 287 | Line 317 | procedure TIBLookupComboEditBox.UpdateLi
317		var
318		iSelStart: Integer; // char position
319		sCompleteText, sPrefixText, sResultText: string;
290	–	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;
301	–	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 321 | 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 ''' + Text + '%''')
380	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
381	>	SQLSafe(FilterText) + '%''')
382		else
383	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + 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);
347	<	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	<	SelectAll
398	>	if AppDestroying in Application.Flags then Exit;
399	>	SelectAll
400		end;
401
402		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | 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	<	UpdateList;
456	<	KeyValue := NewKeyValue;
457	<	UpdateData(nil); {Force sync with DataField}
458	<	finally
459	<	FInserting := false
460	<	end;
461	<	except
462	<	Text := FOriginalTextValue;
463	<	ResetParser;
464	<	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 428 | 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 453 | 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;
525	>	Operation: TOperation);
526	>	begin
527	>	inherited Notification(AComponent, Operation);
528	>	if (Operation = opRemove) and (AComponent = DataSource) then
529	>	ListSource := nil;
530		end;
531
532		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
#	Line 467 | Line 535 | begin
535		FLastKeyValue := KeyValue;
536		end;
537
538	+	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
539	+	var I: integer;
540	+	begin
541	+	Result := '';
542	+	for I := 1 to length(aText) do
543	+	if aText[I] = '''' then
544	+	Result := Result + ''''''
545	+	else
546	+	Result := Result + aText[I];
547	+	end;
548	+
549		procedure TIBLookupComboEditBox.UpdateShowing;
550		begin
551		inherited UpdateShowing;
#	Line 474 | 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);
565		FDataLink := TIBLookupComboDataLink.Create(self);
566	<	FKeyPressInterval := 500;
566	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
567	>	FKeyPressInterval := 200;
568		FAutoComplete := true;
569		FTimer := TTimer.Create(nil);
570		FTimer.Interval := 0;
#	Line 489 | Line 575 | end;
575		destructor TIBLookupComboEditBox.Destroy;
576		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