ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/ibcontrols/IBLookupComboEditBox.pas

Comparing ibx/trunk/ibcontrols/IBLookupComboEditBox.pas (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 272 by tony, Mon Feb 4 13:34:37 2019 UTC

#	Line 30 | Line 30 | unit IBLookupComboEditBox;
30		interface
31
32		uses
33	<	Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
33	>	Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls,
34		ExtCtrls, IBSQLParser, DB, StdCtrls, IBCustomDataSet, LCLVersion;
35
36		type
#	Line 54 | Line 54 | type
54		FOwner: TIBLookupComboEditBox;
55		protected
56		procedure ActiveChanged; override;
57	+	{$if lcl_fullversion < 2000003}
58		procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
59	+	{$endif}
60		procedure RecordChanged(Field: TField); override;
61		procedure UpdateData; override;
62		public
#	Line 77 | Line 79 | type
79
80		TIBLookupComboEditBox = class(TDBLookupComboBox)
81		private
80	–	FCanAutoInsert: TCanAutoInsert;
82		{ Private declarations }
83		FDataLink: TIBLookupComboDataLink;
84		FIBLookupControlLink: TIBLookupControlLink;
#	Line 118 | Line 119 | type
119		procedure CheckAndInsert;
120		procedure DoEnter; override;
121		procedure DoExit; override;
122	+	{$if lcl_fullversion >= 2000003}
123	+	{Deferred update changes in Lazarus 2.0 stop the combo box working when
124	+	the datasource is nil. We thus have to reverse out the changes :(}
125	+	function DoEdit: boolean; override;
126	+	procedure Change; override;
127	+	procedure CloseUp; override;
128	+	procedure Select; override;
129	+	{$ifend}
130		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
131		procedure Loaded; override;
132		procedure Notification(AComponent: TComponent; Operation: TOperation); override;
133		procedure SetItemIndex(const Val: integer); override;
125	–	function SQLSafe(aText: string): string;
134		procedure UpdateShowing; override;
135		procedure UpdateData(Sender: TObject); override;
136		public
#	Line 148 | Line 156 | type
156
157		implementation
158
159	<	uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
159	>	uses Variants, LCLProc, LazUTF8, IBUtils;
160
161		{ TIBLookupControlLink }
162
#	Line 170 | Line 178 | begin
178		FOwner.ActiveChanged(self)
179		end;
180
181	+	{$if lcl_fullversion < 2000003}
182		procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
183		begin
184		inherited DataEvent(Event, Info);
185		if Event = deLayoutChange then
186		FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
187		end;
188	+	{$endif}
189
190		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
191		begin
#	Line 196 | Line 206 | end;
206		{ TIBLookupComboEditBox }
207
208		procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
199	–	var ActiveState: boolean;
209		begin
210		FTimer.Interval := 0;
211		FFiltered := Text <> '';
#	Line 347 | Line 356 | begin
356		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
357		if (sCompleteText <> FCurText) then
358		begin
359	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
360		sResultText := sCompleteText;
361		if ((cbactEndOfLineComplete in AutoCompleteText) and
362		(cbactRetainPrefixCase in AutoCompleteText)) then
#	Line 356 | Line 366 | begin
366		end;
367		Text := sResultText;
368		SelStart := iSelStart;
369	<	SelLength := UTF8Length(Text);
369	>	SelLength := UTF8Length(Text) - iSelStart;
370		end;
361	–	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
371		end
372		else
373		begin
#	Line 386 | Line 395 | begin
395		FilterText := Text;
396		if cbactSearchCaseSensitive in AutoCompleteText then
397		Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
398	<	SQLSafe(FilterText) + '%''')
398	>	SQLSafeString(FilterText) + '%''')
399		else
400		Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' +  ListField + '") Like Upper(''' +
401	<	SQLSafe(FilterText) + '%'')');
401	>	SQLSafeString(FilterText) + '%'')');
402
403		if cbactSearchAscending in AutoCompleteText then
404		begin
#	Line 503 | Line 512 | end;
512		procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
513		begin
514		inherited KeyUp(Key, Shift);
506	–	if Key = VK_RETURN then
507	–	EditingDone
508	–	else
515		if Key = VK_ESCAPE then
516		begin
517		SelStart := UTF8Length(Text);      {Ensure end of line selection}
#	Line 514 | Line 520 | begin
520		SelectAll;
521		end
522		else
523	+	if AutoComplete and (Style <> csDropDownList) then
524		begin
525	<	FTimer.Interval := 0;
526	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
527	<	and AutoComplete and (Style <> csDropDownList) and
528	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
525	>	if (Key = VK_BACK) or (Key = VK_DELETE) then
526	>	begin
527	>	if SelStart = 0 then
528	>	begin
529	>	SelStart := UTF8Length(Text);
530	>	SelLength := 0;
531	>	end;
532	>	FTimer.Interval := 0;
533	>	end
534	>	else
535	>	if IsEditableTextKey(Key) and
536	>	(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
537	>	begin
538	>	FTimer.Interval := 0;
539		FTimer.Interval := FKeyPressInterval;
540	+	end;
541		end;
542		end;
543
#	Line 539 | Line 557 | end;
557
558		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
559		begin
560	+	if Val > 0 then
561	+	FCurText := '';
562		inherited SetItemIndex(Val);
563		FLastKeyValue := KeyValue;
564		end;
565
546	–	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
547	–	var I: integer;
548	–	begin
549	–	Result := '';
550	–	for I := 1 to length(aText) do
551	–	if aText[I] = '''' then
552	–	Result := Result + ''''''
553	–	else
554	–	Result := Result + aText[I];
555	–	end;
556	–
566		procedure TIBLookupComboEditBox.UpdateShowing;
567		begin
568		inherited UpdateShowing;
#	Line 564 | Line 573 | end;
573		procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
574		begin
575		inherited UpdateData(Sender);
576	+	if FCurText <> '' then
577	+	Text := FCurText + Text;
578		FModified := false;
579		end;
580
581	+	{$if lcl_fullversion >= 2000003}
582	+	type
583	+
584	+	{ THackedCustomComboBox }
585	+
586	+	THackedCustomComboBox = class(TCustomComboBox)
587	+	private
588	+	procedure CallChange;
589	+	end;
590	+
591	+	{ THackedCustomComboBox }
592	+
593	+	procedure THackedCustomComboBox.CallChange;
594	+	begin
595	+	inherited Change;
596	+	end;
597	+
598	+	procedure TIBLookupComboEditBox.Change;
599	+	begin
600	+	if IsUnbound then
601	+	THackedCustomComboBox(self).CallChange
602	+	else
603	+	inherited Change;
604	+	end;
605	+
606	+	procedure TIBLookupComboEditBox.CloseUp;
607	+	begin
608	+	inherited DoEdit;
609	+	inherited CloseUp;
610	+	EditingDone;
611	+	end;
612	+
613	+	procedure TIBLookupComboEditBox.Select;
614	+	begin
615	+	inherited Select;
616	+	if IsUnbound then
617	+	inherited DoEdit;
618	+	end;
619	+
620	+	function TIBLookupComboEditBox.DoEdit: boolean;
621	+	begin
622	+	{DoEdit will swallow characters if no editable Field. Hence, to enabled
623	+	writing we must avoid calling the inherited method.}
624	+	if IsUnbound then
625	+	Result := true
626	+	else
627	+	Result := inherited DoEdit;
628	+	end;
629	+	{$ifend}
630	+
631		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
632		begin
633		inherited Create(TheComponent);
#	Line 599 | Line 660 | begin
660		FForceAutoComplete := false;
661		end;
662		CheckAndInsert;
663	+	FCurText := '';
664		if FModified then
665		Change; {ensure Update}
666		inherited EditingDone;

Diff Legend

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