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 39 by tony, Tue May 17 08:14:52 2016 UTC vs.
ibx/branches/journaling/ibcontrols/IBLookupComboEditBox.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 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, IBCustomDataSet;
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 < 2000000}
58	+	procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
59	+	{$endif}
60		procedure RecordChanged(Field: TField); override;
61		procedure UpdateData; override;
62		public
#	Line 76 | Line 79 | type
79
80		TIBLookupComboEditBox = class(TDBLookupComboBox)
81		private
79	–	FCanAutoInsert: TCanAutoInsert;
82		{ Private declarations }
83		FDataLink: TIBLookupComboDataLink;
84		FIBLookupControlLink: TIBLookupControlLink;
#	Line 95 | Line 97 | type
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;
#	Line 109 | Line 113 | type
113		procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
114		procedure HandleEnter(Data: PtrInt);
115		procedure UpdateLinkData(Sender: TObject);
116	+	procedure ValidateListField;
117		protected
118		{ Protected declarations }
119		procedure ActiveChanged(Sender: TObject);
120		procedure CheckAndInsert;
121		procedure DoEnter; override;
122		procedure DoExit; override;
123	+	{$if lcl_fullversion >= 2000002}
124	+	{Deferred update changes in Lazarus 2.0 stop the combo box working when
125	+	the datasource is nil. We thus have to reverse out the changes :(}
126	+	function DoEdit: boolean; override;
127	+	procedure Change; override;
128	+	procedure CloseUp; override;
129	+	procedure Select; override;
130	+	{$ifend}
131	+	{$if lcl_fullversion = 2000002}
132	+	procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
133	+	{$ifend}
134		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
135		procedure Loaded; override;
136		procedure Notification(AComponent: TComponent; Operation: TOperation); override;
137		procedure SetItemIndex(const Val: integer); override;
122	–	function SQLSafe(aText: string): string;
138		procedure UpdateShowing; override;
139	<
139	>	procedure UpdateData(Sender: TObject); override;
140		public
141		{ Public declarations }
142		constructor Create(TheComponent: TComponent); override;
#	Line 145 | Line 160 | type
160
161		implementation
162
163	<	uses IBQuery, LCLType, Variants, LCLProc;
163	>	uses Variants, LCLProc, LazUTF8, IBUtils, IBMessages;
164
165		{ TIBLookupControlLink }
166
#	Line 167 | Line 182 | begin
182		FOwner.ActiveChanged(self)
183		end;
184
185	+	{$if lcl_fullversion < 2000000}
186	+	procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
187	+	begin
188	+	inherited DataEvent(Event, Info);
189	+	if Event = deLayoutChange then
190	+	FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
191	+	end;
192	+	{$endif}
193	+
194		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
195		begin
196		FOwner.RecordChanged(self,Field);
#	Line 186 | Line 210 | end;
210		{ TIBLookupComboEditBox }
211
212		procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
189	–	var ActiveState: boolean;
213		begin
214		FTimer.Interval := 0;
215		FFiltered := Text <> '';
#	Line 229 | Line 252 | begin
252		and ListSource.DataSet.Active   then
253		begin
254		begin
255	+	ValidateListField;
256		if varIsNull(FLastKeyValue) and (ItemIndex = -1) then
257		KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant
258		else
#	Line 315 | Line 339 | procedure TIBLookupComboEditBox.UpdateLi
339		var
340		iSelStart: Integer; // char position
341		sCompleteText, sPrefixText, sResultText: string;
318	–	curText: string;
342		begin
343		if assigned(ListSource) and assigned(ListSource.DataSet) and (ListSource.DataSet is TIBCustomDataSet)
344		and ListSource.DataSet.Active then
345		begin
346	+	FCurText := Text;
347		FUpdating := true;
348		try
349		iSelStart := SelStart;//Capture original cursor position
350		if ((iSelStart < UTF8Length(Text)) and
351		(cbactEndOfLineComplete in AutoCompleteText)) then
352		Exit;
329	–	curText := Text;
353		sPrefixText := UTF8Copy(Text, 1, iSelStart);
354		ListSource.DataSet.Active := false;
355		ListSource.DataSet.Active :=  true;
356	<	Text := curText;
357	<	if not FExiting and (FForceAutoComplete or Focused) and (Text <> '')then
356	>	Text := FCurText;
357	>	if not FExiting and (FForceAutoComplete or Focused) and (FCurText <> '')then
358		begin
359		if ListSource.DataSet.Active and (ListSource.DataSet.RecordCount > 0) then
360		begin
361		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
362	<	if (sCompleteText <> Text) then
362	>	if (sCompleteText <> FCurText) then
363		begin
364	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
365		sResultText := sCompleteText;
366		if ((cbactEndOfLineComplete in AutoCompleteText) and
367		(cbactRetainPrefixCase in AutoCompleteText)) then
#	Line 346 | Line 370 | begin
370		UTF8Insert(sPrefixText, sResultText, 1);
371		end;
372		Text := sResultText;
349	–	SelStart := iSelStart;
350	–	SelLength := UTF8Length(Text);
373		end;
374	<	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
374	>	SelStart := iSelStart;
375	>	SelLength := UTF8Length(Text) - iSelStart;
376	>	end
377	>	else
378	>	begin
379	>	SelStart := iSelStart;
380	>	SelLength := 0;
381		end;
382		end;
383		finally
384		FUpdating := false
385		end;
386	+	FModified := true;
387		end;
388		end;
389
390		procedure TIBLookupComboEditBox.UpdateSQL(Sender: TObject;
391		Parser: TSelectSQLParser);
392		var FieldPosition: integer;
393	+	FilterText: string;
394	+	SQLDialect: integer;
395		begin
396		if FFiltered then
397		begin
398	+	if FUpdating then
399	+	FilterText := FCurText
400	+	else
401	+	FilterText := Text;
402	+
403	+	if Parser.DataSet <> nil then
404	+	SQLDialect := (Parser.DataSet as TIBCustomDataSet).Database.SQLDialect
405	+	else
406	+	SQLDialect := 1;
407	+
408		if cbactSearchCaseSensitive in AutoCompleteText then
409	<	Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
410	<	SQLSafe(Text) + '%''')
409	>	Parser.Add2WhereClause(GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ' Like ''' +
410	>	SQLSafeString(FilterText) + '%''')
411		else
412	<	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
413	<	SQLSafe(Text) + '%'')');
412	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ') Like Upper(''' +
413	>	SQLSafeString(FilterText) + '%'')');
414
415	<	end;
416	<	if cbactSearchAscending in AutoCompleteText then
417	<	begin
418	<	FieldPosition := Parser.GetFieldPosition(ListField);
378	<	if FieldPosition = 0 then Exit;
415	>	if cbactSearchAscending in AutoCompleteText then
416	>	begin
417	>	FieldPosition := Parser.GetFieldPosition(ListField);
418	>	if FieldPosition = 0 then Exit;
419
420	<	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
420	>	Parser.OrderByClause := IntToStr(FieldPosition) + ' ascending';
421	>	end;
422		end;
423		end;
424
#	Line 393 | Line 434 | begin
434		ListSource.DataSet.FieldByName(ListField).AsString := Text
435		end;
436
437	+	{Check to ensure that ListField exists and convert to upper case if necessary}
438	+
439	+	procedure TIBLookupComboEditBox.ValidateListField;
440	+	var SQLDialect: integer;
441	+	FieldNames: TStringList;
442	+	begin
443	+	if (ListSource = nil) or (ListSource.DataSet = nil) or
444	+	not (ListSource.DataSet is TIBCustomDataSet) or
445	+	((ListSource.DataSet as TIBCustomDataSet).Database = nil) then Exit;
446	+	SQLDialect := (ListSource.DataSet as TIBCustomDataSet).Database.SQLDialect;
447	+	FieldNames := TStringList.Create;
448	+	try
449	+	FieldNames.CaseSensitive := true;
450	+	FieldNames.Sorted := true;
451	+	FieldNames.Duplicates := dupError;
452	+	ListSource.DataSet.GetFieldNames(FieldNames);
453	+	if FieldNames.IndexOf(ListField) = -1 then {not found}
454	+	begin
455	+	if (SQLDialect = 3) and (FieldNames.IndexOf(AnsiUpperCase(ListField)) <> - 1) then {normalise to upper case}
456	+	ListField := AnsiUpperCase(ListField)
457	+	else
458	+	IBError(ibxeListFieldNotFound,[ListField])
459	+	end;
460	+	finally
461	+	FieldNames.Free;
462	+	end;
463	+	end;
464	+
465		procedure TIBLookupComboEditBox.CheckAndInsert;
466		var Accept: boolean;
467		NewKeyValue: variant;
#	Line 483 | Line 552 | end;
552		procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
553		begin
554		inherited KeyUp(Key, Shift);
486	–	if Key = VK_RETURN then
487	–	EditingDone
488	–	else
555		if Key = VK_ESCAPE then
556		begin
557		SelStart := UTF8Length(Text);      {Ensure end of line selection}
#	Line 494 | Line 560 | begin
560		SelectAll;
561		end
562		else
563	+	if AutoComplete and (Style <> csDropDownList) then
564		begin
565	<	FTimer.Interval := 0;
566	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
567	<	and AutoComplete and (Style <> csDropDownList) and
568	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
565	>	if (Key = VK_BACK) or (Key = VK_DELETE) then
566	>	begin
567	>	if SelStart = 0 then
568	>	begin
569	>	SelStart := UTF8Length(Text);
570	>	SelLength := 0;
571	>	end;
572	>	FTimer.Interval := 0;
573	>	end
574	>	else
575	>	if IsEditableTextKey(Key) and
576	>	(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
577	>	begin
578	>	FTimer.Interval := 0;
579		FTimer.Interval := FKeyPressInterval;
580	+	end;
581		end;
582		end;
583
#	Line 519 | Line 597 | end;
597
598		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
599		begin
600	+	if Val > 0 then
601	+	FCurText := '';
602		inherited SetItemIndex(Val);
603		FLastKeyValue := KeyValue;
604		end;
605
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	–
606		procedure TIBLookupComboEditBox.UpdateShowing;
607		begin
608		inherited UpdateShowing;
#	Line 541 | Line 610 | begin
610		ActiveChanged(nil);
611		end;
612
613	+	procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
614	+	begin
615	+	inherited UpdateData(Sender);
616	+	if FCurText <> '' then
617	+	Text := FCurText + Text;
618	+	FModified := false;
619	+	end;
620	+
621	+
622	+	{Workarounds due to bugs in various Lazarus 2.0 release candidates}
623	+	{$if lcl_fullversion >= 2000002}
624	+	type
625	+
626	+	{ THackedCustomComboBox }
627	+
628	+	THackedCustomComboBox = class(TCustomComboBox)
629	+	private
630	+	procedure CallChange;
631	+	procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
632	+	end;
633	+
634	+	{ THackedCustomComboBox }
635	+
636	+	procedure THackedCustomComboBox.CallChange;
637	+	begin
638	+	inherited Change;
639	+	end;
640	+
641	+	procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
642	+	begin
643	+	inherited UTF8KeyPress(UTF8Key);
644	+	end;
645	+
646	+	procedure TIBLookupComboEditBox.Change;
647	+	begin
648	+	if DataSource = nil then
649	+	THackedCustomComboBox(self).CallChange
650	+	else
651	+	inherited Change;
652	+	end;
653	+
654	+	procedure TIBLookupComboEditBox.CloseUp;
655	+	begin
656	+	inherited DoEdit;
657	+	inherited CloseUp;
658	+	EditingDone;
659	+	end;
660	+
661	+	procedure TIBLookupComboEditBox.Select;
662	+	begin
663	+	inherited Select;
664	+	if DataSource = nil then
665	+	inherited DoEdit;
666	+	end;
667	+
668	+	function TIBLookupComboEditBox.DoEdit: boolean;
669	+	begin
670	+	{DoEdit will swallow characters if no editable Field. Hence, to enabled
671	+	writing we must avoid calling the inherited method.}
672	+	if DataSource = nil then
673	+	Result := true
674	+	else
675	+	Result := inherited DoEdit;
676	+	end;
677	+	{$ifend}
678	+
679	+	{$if lcl_fullversion = 2000002}
680	+	procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
681	+	begin
682	+	if DataSource = nil then
683	+	THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key)
684	+	else
685	+	inherited;
686	+	end;
687	+	{$ifend}
688	+
689	+
690		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
691		begin
692		inherited Create(TheComponent);
#	Line 559 | Line 705 | begin
705		if assigned(FDataLink) then FDataLink.Free;
706		if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
707		if assigned(FTimer) then FTimer.Free;
708	+	Application.RemoveAsyncCalls(self);
709		inherited Destroy;
710		end;
711
#	Line 572 | Line 719 | begin
719		FForceAutoComplete := false;
720		end;
721		CheckAndInsert;
722	+	FCurText := '';
723	+	if FModified then
724	+	Change; {ensure Update}
725		inherited EditingDone;
726		end;
727

Diff Legend

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