[ViewVC] Diff of: public/ibx/branches/journaling/ibcontrols/IBLookupComboEditBox.pas

Comparing ibx/trunk/ibcontrols/IBLookupComboEditBox.pas (file contents):
Revision 64 by tony, Thu Jun 29 11:11:22 2017 UTC vs.
Revision 276 by tony, Mon Feb 4 13:43:20 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 76 \| Line 79 \| type
79
80		TIBLookupComboEditBox = class(TDBLookupComboBox)
81		private
79	–	FCanAutoInsert: TCanAutoInsert;
82		{ Private declarations }
83		FDataLink: TIBLookupComboDataLink;
84		FIBLookupControlLink: TIBLookupControlLink;
#	Line 96 \| Line 98 \| type
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 116 \| Line 119 \| type
119		procedure CheckAndInsert;
120		procedure DoEnter; override;
121		procedure DoExit; override;
122	+	{$if lcl_fullversion >= 2000002}
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	+	{$if lcl_fullversion = 2000002}
131	+	procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
132	+	{$ifend}
133		procedure KeyUp(var Key: Word; Shift: TShiftState); override;
134		procedure Loaded; override;
135		procedure Notification(AComponent: TComponent; Operation: TOperation); override;
136		procedure SetItemIndex(const Val: integer); override;
123	–	function SQLSafe(aText: string): string;
137		procedure UpdateShowing; override;
138	<
138	>	procedure UpdateData(Sender: TObject); override;
139		public
140		{ Public declarations }
141		constructor Create(TheComponent: TComponent); override;
#	Line 146 \| Line 159 \| type
159
160		implementation
161
162	<	uses IBQuery, LCLType, Variants, LCLProc, LazUTF8;
162	>	uses Variants, LCLProc, LazUTF8, IBUtils;
163
164		{ TIBLookupControlLink }
165
#	Line 168 \| Line 181 \| begin
181		FOwner.ActiveChanged(self)
182		end;
183
184	+	{$if lcl_fullversion < 2000003}
185	+	procedure TIBLookupComboDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
186	+	begin
187	+	inherited DataEvent(Event, Info);
188	+	if Event = deLayoutChange then
189	+	FOwner.LookupCache := FOwner.LookupCache; {sneaky way of calling UpdateLookup}
190	+	end;
191	+	{$endif}
192	+
193		procedure TIBLookupComboDataLink.RecordChanged(Field: TField);
194		begin
195		FOwner.RecordChanged(self,Field);
#	Line 187 \| Line 209 \| end;
209		{ TIBLookupComboEditBox }
210
211		procedure TIBLookupComboEditBox.HandleTimer(Sender: TObject);
190	–	var ActiveState: boolean;
212		begin
213		FTimer.Interval := 0;
214		FFiltered := Text <> '';
#	Line 338 \| Line 359 \| begin
359		sCompleteText := ListSource.DataSet.FieldByName(ListField).AsString;
360		if (sCompleteText <> FCurText) then
361		begin
362	+	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
363		sResultText := sCompleteText;
364		if ((cbactEndOfLineComplete in AutoCompleteText) and
365		(cbactRetainPrefixCase in AutoCompleteText)) then
#	Line 347 \| Line 369 \| begin
369		end;
370		Text := sResultText;
371		SelStart := iSelStart;
372	<	SelLength := UTF8Length(Text);
372	>	SelLength := UTF8Length(Text) - iSelStart;
373		end;
374	<	KeyValue := ListSource.DataSet.FieldByName(KeyField).AsVariant;
374	>	end
375	>	else
376	>	begin
377	>	SelStart := iSelStart;
378	>	SelLength := 0;
379		end;
380		end;
381		finally
382		FUpdating := false
383		end;
384	+	FModified := true;
385		end;
386		end;
387
#	Line 371 \| Line 398 \| begin
398		FilterText := Text;
399		if cbactSearchCaseSensitive in AutoCompleteText then
400		Parser.Add2WhereClause(GetRelationNameQualifier + '"' + ListField + '" Like ''' +
401	<	SQLSafe(FilterText) + '%''')
401	>	SQLSafeString(FilterText) + '%''')
402		else
403		Parser.Add2WhereClause('Upper(' + GetRelationNameQualifier + '"' + ListField + '") Like Upper(''' +
404	<	SQLSafe(FilterText) + '%'')');
404	>	SQLSafeString(FilterText) + '%'')');
405
406		if cbactSearchAscending in AutoCompleteText then
407		begin
#	Line 488 \| Line 515 \| end;
515		procedure TIBLookupComboEditBox.KeyUp(var Key: Word; Shift: TShiftState);
516		begin
517		inherited KeyUp(Key, Shift);
491	–	if Key = VK_RETURN then
492	–	EditingDone
493	–	else
518		if Key = VK_ESCAPE then
519		begin
520		SelStart := UTF8Length(Text); {Ensure end of line selection}
#	Line 499 \| Line 523 \| begin
523		SelectAll;
524		end
525		else
526	+	if AutoComplete and (Style <> csDropDownList) then
527		begin
528	<	FTimer.Interval := 0;
529	<	if (IsEditableTextKey(Key) or (Key = VK_BACK))
530	<	and AutoComplete and (Style <> csDropDownList) and
531	<	(not (cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
528	>	if (Key = VK_BACK) or (Key = VK_DELETE) then
529	>	begin
530	>	if SelStart = 0 then
531	>	begin
532	>	SelStart := UTF8Length(Text);
533	>	SelLength := 0;
534	>	end;
535	>	FTimer.Interval := 0;
536	>	end
537	>	else
538	>	if IsEditableTextKey(Key) and
539	>	(not(cbactEndOfLineComplete in AutoCompleteText) or (SelStart = UTF8Length(Text))) then
540	>	begin
541	>	FTimer.Interval := 0;
542		FTimer.Interval := FKeyPressInterval;
543	+	end;
544		end;
545		end;
546
#	Line 524 \| Line 560 \| end;
560
561		procedure TIBLookupComboEditBox.SetItemIndex(const Val: integer);
562		begin
563	+	if Val > 0 then
564	+	FCurText := '';
565		inherited SetItemIndex(Val);
566		FLastKeyValue := KeyValue;
567		end;
568
531	–	function TIBLookupComboEditBox.SQLSafe(aText: string): string;
532	–	var I: integer;
533	–	begin
534	–	Result := '';
535	–	for I := 1 to length(aText) do
536	–	if aText[I] = '''' then
537	–	Result := Result + ''''''
538	–	else
539	–	Result := Result + aText[I];
540	–	end;
541	–
569		procedure TIBLookupComboEditBox.UpdateShowing;
570		begin
571		inherited UpdateShowing;
#	Line 546 \| Line 573 \| begin
573		ActiveChanged(nil);
574		end;
575
576	+	procedure TIBLookupComboEditBox.UpdateData(Sender: TObject);
577	+	begin
578	+	inherited UpdateData(Sender);
579	+	if FCurText <> '' then
580	+	Text := FCurText + Text;
581	+	FModified := false;
582	+	end;
583	+
584	+
585	+	{Workarounds due to bugs in various Lazarus 2.0 release candidates}
586	+	{$if lcl_fullversion >= 2000002}
587	+	type
588	+
589	+	{ THackedCustomComboBox }
590	+
591	+	THackedCustomComboBox = class(TCustomComboBox)
592	+	private
593	+	procedure CallChange;
594	+	procedure CallUTF8KeyPress(var UTF8Key: TUTF8Char);
595	+	end;
596	+
597	+	{ THackedCustomComboBox }
598	+
599	+	procedure THackedCustomComboBox.CallChange;
600	+	begin
601	+	inherited Change;
602	+	end;
603	+
604	+	procedure THackedCustomComboBox.CallUTF8KeyPress(var UTF8Key: TUTF8Char);
605	+	begin
606	+	inherited UTF8KeyPress(UTF8Key);
607	+	end;
608	+
609	+	procedure TIBLookupComboEditBox.Change;
610	+	begin
611	+	if DataSource = nil then
612	+	THackedCustomComboBox(self).CallChange
613	+	else
614	+	inherited Change;
615	+	end;
616	+
617	+	procedure TIBLookupComboEditBox.CloseUp;
618	+	begin
619	+	inherited DoEdit;
620	+	inherited CloseUp;
621	+	EditingDone;
622	+	end;
623	+
624	+	procedure TIBLookupComboEditBox.Select;
625	+	begin
626	+	inherited Select;
627	+	if DataSource = nil then
628	+	inherited DoEdit;
629	+	end;
630	+
631	+	function TIBLookupComboEditBox.DoEdit: boolean;
632	+	begin
633	+	{DoEdit will swallow characters if no editable Field. Hence, to enabled
634	+	writing we must avoid calling the inherited method.}
635	+	if DataSource = nil then
636	+	Result := true
637	+	else
638	+	Result := inherited DoEdit;
639	+	end;
640	+	{$ifend}
641	+
642	+	{$if lcl_fullversion = 2000002}
643	+	procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
644	+	begin
645	+	if DataSource = nil then
646	+	THackedCustomComboBox(self).UTF8KeyPress(UTF8Key)
647	+	else
648	+	inherited;
649	+	end;
650	+	{$ifend}
651	+
652	+
653		constructor TIBLookupComboEditBox.Create(TheComponent: TComponent);
654		begin
655		inherited Create(TheComponent);
#	Line 564 \| Line 668 \| begin
668		if assigned(FDataLink) then FDataLink.Free;
669		if assigned(FIBLookupControlLink) then FIBLookupControlLink.Free;
670		if assigned(FTimer) then FTimer.Free;
671	+	Application.RemoveAsyncCalls(self);
672		inherited Destroy;
673		end;
674
#	Line 577 \| Line 682 \| begin
682		FForceAutoComplete := false;
683		end;
684		CheckAndInsert;
685	+	FCurText := '';
686	+	if FModified then
687	+	Change; {ensure Update}
688		inherited EditingDone;
689		end;
690

Diff Legend

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

Comparing ibx/trunk/ibcontrols/IBLookupComboEditBox.pas (file contents): Revision 64 by tony, Thu Jun 29 11:11:22 2017 UTC vs. Revision 276 by tony, Mon Feb 4 13:43:20 2019 UTC

Diff Legend

Comparing ibx/trunk/ibcontrols/IBLookupComboEditBox.pas (file contents):
Revision 64 by tony, Thu Jun 29 11:11:22 2017 UTC vs.
Revision 276 by tony, Mon Feb 4 13:43:20 2019 UTC