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 217 by tony, Fri Mar 16 10:27:26 2018 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 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 111 | 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;
124	–	function SQLSafe(aText: string): string;
138		procedure UpdateShowing; override;
139		procedure UpdateData(Sender: TObject); override;
140		public
#	Line 147 | Line 160 | type
160
161		implementation
162
163	<	uses LCLType, Variants, LCLProc, LazUTF8;
163	>	uses Variants, LCLProc, LazUTF8, IBUtils, IBMessages;
164
165		{ TIBLookupControlLink }
166
#	Line 169 | 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
#	Line 237 | 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 345 | Line 361 | begin
361		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
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 354 | Line 371 | begin
371		end;
372		Text := sResultText;
373		SelStart := iSelStart;
374	<	SelLength := UTF8Length(Text);
374	>	SelLength := UTF8Length(Text) - iSelStart;
375		end;
359	–	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
376		end
377		else
378		begin
#	Line 375 | Line 391 | procedure TIBLookupComboEditBox.UpdateSQ
391		Parser: TSelectSQLParser);
392		var FieldPosition: integer;
393		FilterText: string;
394	+	SQLDialect: integer;
395		begin
396		if FFiltered then
397		begin
#	Line 382 | Line 399 | begin
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(FilterText) + '%''')
409	>	Parser.Add2WhereClause(GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ' Like ''' +
410	>	SQLSafeString(FilterText) + '%''')
411		else
412	<	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
413	<	SQLSafe(FilterText) + '%'')');
412	>	Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + QuoteIdentifierIfNeeded(SQLDialect,ListField) + ') Like Upper(''' +
413	>	SQLSafeString(FilterText) + '%'')');
414
415		if cbactSearchAscending in AutoCompleteText then
416		begin
#	Line 411 | 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) then Exit;
444	+	SQLDialect := (ListSource.DataSet as TIBCustomDataSet).Database.SQLDialect;
445	+	FieldNames := TStringList.Create;
446	+	try
447	+	FieldNames.CaseSensitive := true;
448	+	FieldNames.Sorted := true;
449	+	FieldNames.Duplicates := dupError;
450	+	ListSource.DataSet.GetFieldNames(FieldNames);
451	+	if FieldNames.IndexOf(ListField) = -1 then {not found}
452	+	begin
453	+	if (SQLDialect = 3) and (FieldNames.IndexOf(AnsiUpperCase(ListField)) <> - 1) then {normalise to upper case}
454	+	ListField := AnsiUpperCase(ListField)
455	+	else
456	+	IBError(ibxeListFieldNotFound,[ListField])
457	+	end;
458	+	finally
459	+	FieldNames.Free;
460	+	end;
461	+	end;
462	+
463		procedure TIBLookupComboEditBox.CheckAndInsert;
464		var Accept: boolean;
465		NewKeyValue: variant;
#	Line 501 | Line 550 | end;
550		procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
551		begin
552		inherited KeyUp(Key, Shift);
504	–	if Key = VK_RETURN then
505	–	EditingDone
506	–	else
553		if Key = VK_ESCAPE then
554		begin
555		SelStart := UTF8Length(Text);      {Ensure end of line selection}
#	Line 512 | Line 558 | begin
558		SelectAll;
559		end
560		else
561	+	if AutoComplete and (Style <> csDropDownList) then
562		begin
563	<	FTimer.Interval := 0;
564	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
565	<	and AutoComplete and (Style <> csDropDownList) and
566	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
563	>	if (Key = VK_BACK) or (Key = VK_DELETE) then
564	>	begin
565	>	if SelStart = 0 then
566	>	begin
567	>	SelStart := UTF8Length(Text);
568	>	SelLength := 0;
569	>	end;
570	>	FTimer.Interval := 0;
571	>	end
572	>	else
573	>	if IsEditableTextKey(Key) and
574	>	(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
575	>	begin
576	>	FTimer.Interval := 0;
577		FTimer.Interval := FKeyPressInterval;
578	+	end;
579		end;
580		end;
581
#	Line 537 | Line 595 | end;
595
596		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
597		begin
598	+	if Val > 0 then
599	+	FCurText := '';
600		inherited SetItemIndex(Val);
601		FLastKeyValue := KeyValue;
602		end;
603
544	–	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
545	–	var I: integer;
546	–	begin
547	–	Result := '';
548	–	for I := 1 to length(aText) do
549	–	if aText[I] = '''' then
550	–	Result := Result + ''''''
551	–	else
552	–	Result := Result + aText[I];
553	–	end;
554	–
604		procedure TIBLookupComboEditBox.UpdateShowing;
605		begin
606		inherited UpdateShowing;
#	Line 562 | Line 611 | end;
611		procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
612		begin
613		inherited UpdateData(Sender);
614	+	if FCurText <> '' then
615	+	Text := FCurText + Text;
616		FModified := false;
617		end;
618
619	+
620	+	{Workarounds due to bugs in various Lazarus 2.0 release candidates}
621	+	{$if lcl_fullversion >= 2000002}
622	+	type
623	+
624	+	{ THackedCustomComboBox }
625	+
626	+	THackedCustomComboBox = class(TCustomComboBox)
627	+	private
628	+	procedure CallChange;
629	+	procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
630	+	end;
631	+
632	+	{ THackedCustomComboBox }
633	+
634	+	procedure THackedCustomComboBox.CallChange;
635	+	begin
636	+	inherited Change;
637	+	end;
638	+
639	+	procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
640	+	begin
641	+	inherited UTF8KeyPress(UTF8Key);
642	+	end;
643	+
644	+	procedure TIBLookupComboEditBox.Change;
645	+	begin
646	+	if DataSource = nil then
647	+	THackedCustomComboBox(self).CallChange
648	+	else
649	+	inherited Change;
650	+	end;
651	+
652	+	procedure TIBLookupComboEditBox.CloseUp;
653	+	begin
654	+	inherited DoEdit;
655	+	inherited CloseUp;
656	+	EditingDone;
657	+	end;
658	+
659	+	procedure TIBLookupComboEditBox.Select;
660	+	begin
661	+	inherited Select;
662	+	if DataSource = nil then
663	+	inherited DoEdit;
664	+	end;
665	+
666	+	function TIBLookupComboEditBox.DoEdit: boolean;
667	+	begin
668	+	{DoEdit will swallow characters if no editable Field. Hence, to enabled
669	+	writing we must avoid calling the inherited method.}
670	+	if DataSource = nil then
671	+	Result := true
672	+	else
673	+	Result := inherited DoEdit;
674	+	end;
675	+	{$ifend}
676	+
677	+	{$if lcl_fullversion = 2000002}
678	+	procedure TIBLookupComboEditBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
679	+	begin
680	+	if DataSource = nil then
681	+	THackedCustomComboBox(self).CallUTF8KeyPress(UTF8Key)
682	+	else
683	+	inherited;
684	+	end;
685	+	{$ifend}
686	+
687	+
688		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
689		begin
690		inherited Create(TheComponent);
#	Line 597 | Line 717 | begin
717		FForceAutoComplete := false;
718		end;
719		CheckAndInsert;
720	+	FCurText := '';
721		if FModified then
722		Change; {ensure Update}
723		inherited EditingDone;

Diff Legend

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