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 41 by tony, Sat Jul 16 12:25:48 2016 UTC

#	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		procedure DoActiveChanged(Data: PtrInt);
99		function GetAutoCompleteText: TComboBoxAutoCompleteText;
100		function GetListSource: TDataSource;
101		function GetRelationNameQualifier: string;
102		procedure HandleTimer(Sender: TObject);
103	+	procedure IBControlLinkChanged;
104		procedure ResetParser;
105		procedure RecordChanged(Sender: TObject; aField: TField);
106		procedure SetAutoCompleteText(AValue: TComboBoxAutoCompleteText);
#	Line 102 | Line 116 | type
116		procedure DoEnter; override;
117		procedure DoExit; override;
118		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
119	+	procedure Loaded; override;
120	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
121		procedure SetItemIndex(const Val: integer); override;
122	+	function SQLSafe(aText: string): string;
123		procedure UpdateShowing; override;
124	+
125		public
126		{ Public declarations }
127		constructor Create(TheComponent: TComponent); override;
#	Line 118 | Line 136 | type
136		property ItemHeight;
137		property ItemWidth;
138		property ListSource: TDataSource read GetListSource write SetListSource;
139	<	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 500;
139	>	property KeyPressInterval: integer read FKeyPressInterval write FKeyPressInterval default 200;
140		property RelationName: string read FRelationName write FRelationName;
141		property OnAutoInsert: TAutoInsert read FOnAutoInsert write FOnAutoInsert;
142		property OnCanAutoInsert: TCanAutoInsert read FOnCanAutoInsert write FOnCanAutoInsert;
#	Line 127 | Line 145 | type
145
146		implementation
147
148	<	uses IBQuery, IBCustomDataSet, LCLType, Variants, LCLProc;
148	>	uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
149
150	<	{ TIBLookupComboDataLink }
150	>	{ TIBLookupControlLink }
151
152	<	procedure TIBLookupComboDataLink.ActiveChanged;
152	>	constructor TIBLookupControlLink.Create(AOwner: TIBLookupComboEditBox);
153		begin
154	<	FOwner.ActiveChanged(self)
154	>	inherited Create;
155	>	FOwner := AOwner;
156		end;
157
158	<	procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
158	>	procedure TIBLookupControlLink.UpdateSQL(Sender: TObject);
159		begin
160	<	{If we are not visible then avoid unnecessary work}
161	<	if not FOwner.Showing then Exit;
160	>	FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
161	>	end;
162
163	<	if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
164	<	begin
165	<	if (DataSet is TIBDataSet) then
166	<	FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
167	<	else
149	<	if (DataSet is TIBQuery) then
150	<	FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
151	<	end
152	<	else
153	<	inherited DataEvent(Event, Info);
163	>	{ TIBLookupComboDataLink }
164	>
165	>	procedure TIBLookupComboDataLink.ActiveChanged;
166	>	begin
167	>	FOwner.ActiveChanged(self)
168		end;
169
170		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
#	Line 179 | Line 193 | begin
193		UpdateList
194		end;
195
196	+	procedure TIBLookupComboEditBox.IBControlLinkChanged;
197	+	begin
198	+	if (ListSource <> nil) and (ListSource.DataSet <> nil) and (ListSource.DataSet is TIBParserDataSet) then
199	+	FIBLookupControlLink.IBDataSet := TIBCustomDataSet(ListSource.DataSet)
200	+	else
201	+	FIBLookupControlLink.IBDataSet := nil;
202	+	end;
203	+
204		function TIBLookupComboEditBox.GetListSource: TDataSource;
205		begin
206		Result := inherited ListSource;
#	Line 196 | Line 218 | procedure TIBLookupComboEditBox.ActiveCh
218		begin
219		if not FInserting and not FUpdating then
220		Application.QueueAsyncCall(@DoActiveChanged,0);
221	+	IBControlLinkChanged;
222		end;
223
224		procedure TIBLookupComboEditBox.DoActiveChanged(Data: PtrInt);
#	Line 237 | Line 260 | begin
260		end;
261
262		procedure TIBLookupComboEditBox.ResetParser;
263	+	var curKeyValue: variant;
264		begin
265		if FFiltered then
266		begin
267		FFiltered := false;
268	+	curKeyValue := KeyValue;
269	+	Text := ''; {Ensure full list}
270		UpdateList;
271	+	KeyValue := curKeyValue;
272		UpdateData(self); {Force Scroll}
273		end;
274		end;
#	Line 276 | Line 303 | begin
303		begin
304		FDataLink.DataSource := AValue;
305		inherited ListSource := AValue;
306	+	IBControlLinkChanged;
307		end;
308		end;
309
#	Line 303 | Line 331 | begin
331		ListSource.DataSet.Active := false;
332		ListSource.DataSet.Active :=  true;
333		Text := curText;
334	<	if not FExiting and Focused and (Text <> '')then
334	>	if not FExiting and (FForceAutoComplete or Focused) and (Text <> '')then
335		begin
336		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
337		begin
#	Line 321 | Line 349 | begin
349		SelStart := iSelStart;
350		SelLength := UTF8Length(Text);
351		end;
352	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
353		end;
354		end;
355		finally
#	Line 336 | Line 365 | begin
365		if FFiltered then
366		begin
367		if cbactSearchCaseSensitive in AutoCompleteText then
368	<	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' + Text + '%''')
368	>	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
369	>	SQLSafe(Text) + '%''')
370		else
371	<	Parser.Add2WhereClause(GetRelationNameQualifier + 'Upper("' + ListField + '") Like Upper(''' + Text + '%'')');
371	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
372	>	SQLSafe(Text) + '%'')');
373
374	<	end;
375	<	if cbactSearchAscending in AutoCompleteText then
376	<	begin
377	<	FieldPosition := Parser.GetFieldPosition(ListField);
347	<	if FieldPosition = 0 then Exit;
374	>	if cbactSearchAscending in AutoCompleteText then
375	>	begin
376	>	FieldPosition := Parser.GetFieldPosition(ListField);
377	>	if FieldPosition = 0 then Exit;
378
379	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
379	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
380	>	end;
381		end;
382		end;
383
384		procedure TIBLookupComboEditBox.HandleEnter(Data: PtrInt);
385		begin
386	<	SelectAll
386	>	if AppDestroying in Application.Flags then Exit;
387	>	SelectAll
388		end;
389
390		procedure TIBLookupComboEditBox.UpdateLinkData(Sender: TObject);
#	Line 365 | Line 397 | procedure TIBLookupComboEditBox.CheckAnd
397		var Accept: boolean;
398		NewKeyValue: variant;
399		begin
400	<	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
401	<	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
400	>	if FInCheckAndInsert then Exit;
401	>	FInCheckAndInsert := true;
402		try
403	<	{Is it OK to insert a new list member?}
404	<	Accept := true;
405	<	if assigned(FOnCanAutoInsert) then
406	<	OnCanAutoInsert(self,Text,Accept);
407	<	if not Accept then
408	<	begin
409	<	ResetParser;
410	<	Text := FOriginalTextValue;
411	<	SelectAll;
412	<	Exit;
413	<	end;
403	>	if AutoInsert and (Text <> '') and assigned(ListSource) and assigned(ListSource.DataSet)
404	>	and ListSource.DataSet.Active and (ListSource.DataSet.RecordCount = 0) then
405	>	try
406	>	{Is it OK to insert a new list member?}
407	>	Accept := true;
408	>	if assigned(FOnCanAutoInsert) then
409	>	OnCanAutoInsert(self,Text,Accept);
410	>	if not Accept then
411	>	begin
412	>	ResetParser;
413	>	Text := FOriginalTextValue;
414	>	SelectAll;
415	>	Exit;
416	>	end;
417
418	<	FInserting := true;
419	<	try
420	<	{New Value}
421	<	FFiltered := false;
422	<	if assigned(FOnAutoInsert) then
423	<	begin
424	<	{In an OnAutoInsert handler, the client is expected to insert the new
425	<	row into the List DataSet and to set the KeyValue property to the
426	<	value of the primary key of the new row.}
427	<	OnAutoInsert(self,Text,NewKeyValue);
428	<	end
429	<	else
430	<	begin
431	<	ListSource.DataSet.Append;
432	<	{The new KeyValue should be determined by an external generator or
433	<	in the "OnInsert" handler. If it is the same as the ListField, then
434	<	it will be set from the UpdateLinkData method}
435	<	try
436	<	ListSource.DataSet.Post;
437	<	except
438	<	ListSource.DataSet.Cancel;
439	<	raise;
440	<	end;
441	<	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
442	<	end;
443	<	Text := ''; {Ensure full list}
444	<	UpdateList;
445	<	KeyValue := NewKeyValue;
446	<	UpdateData(nil); {Force sync with DataField}
447	<	finally
448	<	FInserting := false
449	<	end;
450	<	except
451	<	Text := FOriginalTextValue;
452	<	ResetParser;
453	<	raise;
418	>	FInserting := true;
419	>	try
420	>	{New Value}
421	>	FFiltered := false;
422	>	if assigned(FOnAutoInsert) then
423	>	begin
424	>	{In an OnAutoInsert handler, the client is expected to insert the new
425	>	row into the List DataSet and to set the KeyValue property to the
426	>	value of the primary key of the new row.}
427	>	OnAutoInsert(self,Text,NewKeyValue);
428	>	end
429	>	else
430	>	begin
431	>	ListSource.DataSet.Append;
432	>	{The new KeyValue should be determined by an external generator or
433	>	in the "OnInsert" handler. If it is the same as the ListField, then
434	>	it will be set from the UpdateLinkData method}
435	>	try
436	>	ListSource.DataSet.Post;
437	>	except
438	>	ListSource.DataSet.Cancel;
439	>	raise;
440	>	end;
441	>	NewKeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
442	>	end;
443	>	Text := ''; {Ensure full list}
444	>	UpdateList;
445	>	KeyValue := NewKeyValue;
446	>	UpdateData(nil); {Force sync with DataField}
447	>	finally
448	>	FInserting := false
449	>	end;
450	>	except
451	>	Text := FOriginalTextValue;
452	>	ResetParser;
453	>	raise;
454	>	end;
455	>	finally
456	>	FInCheckAndInsert := false
457		end;
458		end;
459
#	Line 429 | Line 467 | end;
467
468		procedure TIBLookupComboEditBox.DoExit;
469		begin
470	+	if FTimer.Interval <> 0 then
471	+	HandleTimer(nil);
472		FExiting := true;
473		try
474		CheckAndInsert;
#	Line 454 | Line 494 | begin
494		SelectAll;
495		end
496		else
497	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
498	<	and AutoComplete and (Style <> csDropDownList) and
499	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
500	<	FTimer.Interval := FKeyPressInterval
501	<	else
502	<	FTimer.Interval := 0
497	>	begin
498	>	FTimer.Interval := 0;
499	>	if (IsEditableTextKey(Key) or (Key = VK_BACK))
500	>	and AutoComplete and (Style <> csDropDownList) and
501	>	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
502	>	FTimer.Interval := FKeyPressInterval;
503	>	end;
504	>	end;
505	>
506	>	procedure TIBLookupComboEditBox.Loaded;
507	>	begin
508	>	inherited Loaded;
509	>	IBControlLinkChanged;
510	>	end;
511	>
512	>	procedure TIBLookupComboEditBox.Notification(AComponent: TComponent;
513	>	Operation: TOperation);
514	>	begin
515	>	inherited Notification(AComponent, Operation);
516	>	if (Operation = opRemove) and (AComponent = DataSource) then
517	>	ListSource := nil;
518		end;
519
520		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
#	Line 468 | Line 523 | begin
523		FLastKeyValue := KeyValue;
524		end;
525
526	+	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
527	+	var I: integer;
528	+	begin
529	+	Result := '';
530	+	for I := 1 to length(aText) do
531	+	if aText[I] = '''' then
532	+	Result := Result + ''''''
533	+	else
534	+	Result := Result + aText[I];
535	+	end;
536	+
537		procedure TIBLookupComboEditBox.UpdateShowing;
538		begin
539		inherited UpdateShowing;
#	Line 479 | Line 545 | constructor TIBLookupComboEditBox.Create
545		begin
546		inherited Create(TheComponent);
547		FDataLink := TIBLookupComboDataLink.Create(self);
548	<	FKeyPressInterval := 500;
548	>	FIBLookupControlLink := TIBLookupControlLink.Create(self);
549	>	FKeyPressInterval := 200;
550		FAutoComplete := true;
551		FTimer := TTimer.Create(nil);
552		FTimer.Interval := 0;
#	Line 490 | Line 557 | end;
557		destructor TIBLookupComboEditBox.Destroy;
558		begin
559		if assigned(FDataLink) then FDataLink.Free;
560	+	if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
561		if assigned(FTimer) then FTimer.Free;
562		inherited Destroy;
563		end;
564
565		procedure TIBLookupComboEditBox.EditingDone;
566		begin
567	+	FForceAutoComplete := true;
568	+	try
569	+	if FTimer.Interval <> 0 then
570	+	HandleTimer(nil);
571	+	finally
572	+	FForceAutoComplete := false;
573	+	end;
574		CheckAndInsert;
575		inherited EditingDone;
576		end;

Diff Legend

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