paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 21:09:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: improve the workaround to support fpc 2.6.4 TMemDataset in a way that other datasets are not affected. Issues #26356, #27959

Browse Source 
git-svn-id: branches/fixes_1_6@50864 -
This commit is contained in:
mattias 2015-12-17 14:23:04 +00:00
parent d86fa92092
commit fe582332c2
2 changed files with 54 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/dbctrls.pp
View File

@ -127,6 +127,9 @@ Type
FLookUpFieldIsCached: Boolean;
FLookupCache: Boolean;
FInitializing: Boolean;
{$IF FPC_FULLVERSION < 30000}
FFetchingLookupData: Boolean;
{$ENDIF}
procedure ActiveChange(Sender: TObject);
procedure DatasetChange(Sender: TObject);
procedure DoInitialize;

59
lcl/include/dblookup.inc
View File

@ -76,10 +76,15 @@ begin
end;
procedure TDBLookupDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
var
I: Integer;
S: TDataSetState;
begin
inherited DataEvent(Event, Info);
if Event = deDataSetChange then
begin
I := DataSet.RecordCount;
S := DataSet.State;
if FRecordUpdated or ((FLookup.ControlItems <> nil) and (FLookup.ControlItems.Count <> DataSet.RecordCount)) then
begin
FRecordUpdated := False;
@ -228,14 +233,38 @@ begin
KeyList[i + 1] := KeyList[i];
end;
{$IF FPC_FULLVERSION < 30000}
function IsClass(Instance: TObject; const ClassName: ShortString): Boolean;
var
ClassRef: TClass;
begin
Result := False;
ClassRef := Instance.ClassType;
while ClassRef <> nil do
begin
Result := ClassRef.ClassNameIs(ClassName);
if Result then
Exit;
ClassRef := ClassRef.ClassParent;
end;
end;
{$ENDIF}
procedure TDBLookup.FetchLookupData;
var
KeyIndex, KeyListCount: Integer;
ListLinkDataSet: TDataSet;
Bookmark: TBookmark;
{$IF FPC_FULLVERSION < 30000}
DatasetSupportsBlockRead: Boolean;
{$ENDIF}
begin
if not Assigned(FControlItems) then
Exit;
{$IF FPC_FULLVERSION < 30000}
if FFetchingLookupData then
Exit;
{$ENDIF}
FControlItems.Clear;
ListLinkDataSet := FListLink.DataSet;
if not (Assigned(ListLinkDataSet) and Assigned(FListField)) then
@ -243,11 +272,19 @@ begin
if ListLinkDataSet.IsEmpty then
Exit;
Bookmark := ListLinkDataSet.GetBookmark;
{$ifdef EnableLookupWithBlockRead}
//in fpc 2.6.4, TMemDataset does not supports BlockRead. Issues 26356, 27959
{$IF FPC_FULLVERSION < 30000}
DatasetSupportsBlockRead := not IsClass(ListLinkDataSet, 'TMemDataset');
if DatasetSupportsBlockRead then
ListLinkDataSet.BlockReadSize := 1
else
begin
FFetchingLookupData := True;
ListLinkDataSet.DisableControls;
end;
{$ELSE}
ListLinkDataSet.BlockReadSize := 1;
{$else}
ListLinkDataSet.DisableControls;
{$endif}
{$ENDIF}
FControlItems.BeginUpdate;
try
//needed to handle sqldb.TSQLQuery that does not has a reliable recordcount after Open
@ -273,11 +310,17 @@ begin
FControlItems.EndUpdate;
ListLinkDataSet.GotoBookmark(Bookmark);
ListLinkDataSet.FreeBookmark(Bookmark);
{$ifdef EnableLookupWithBlockRead}
{$IF FPC_FULLVERSION < 30000}
if DatasetSupportsBlockRead then
ListLinkDataSet.BlockReadSize := 0
else
begin
ListLinkDataSet.EnableControls;
FFetchingLookupData := False;
end;
{$ELSE}
ListLinkDataSet.BlockReadSize := 0;
{$else}
ListLinkDataSet.EnableControls;
{$endif}
{$ENDIF}
end;
end;