mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-14 06:59:14 +02:00
LCL: improve the workaround to support fpc 2.6.4 TMemDataset in a way that other datasets are not affected. Issues #26356, #27959
git-svn-id: branches/fixes_1_6@50864 -
This commit is contained in:
parent
d86fa92092
commit
fe582332c2
@ -127,6 +127,9 @@ Type
|
|||||||
FLookUpFieldIsCached: Boolean;
|
FLookUpFieldIsCached: Boolean;
|
||||||
FLookupCache: Boolean;
|
FLookupCache: Boolean;
|
||||||
FInitializing: Boolean;
|
FInitializing: Boolean;
|
||||||
|
{$IF FPC_FULLVERSION < 30000}
|
||||||
|
FFetchingLookupData: Boolean;
|
||||||
|
{$ENDIF}
|
||||||
procedure ActiveChange(Sender: TObject);
|
procedure ActiveChange(Sender: TObject);
|
||||||
procedure DatasetChange(Sender: TObject);
|
procedure DatasetChange(Sender: TObject);
|
||||||
procedure DoInitialize;
|
procedure DoInitialize;
|
||||||
|
@ -76,10 +76,15 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TDBLookupDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
|
procedure TDBLookupDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
S: TDataSetState;
|
||||||
begin
|
begin
|
||||||
inherited DataEvent(Event, Info);
|
inherited DataEvent(Event, Info);
|
||||||
if Event = deDataSetChange then
|
if Event = deDataSetChange then
|
||||||
begin
|
begin
|
||||||
|
I := DataSet.RecordCount;
|
||||||
|
S := DataSet.State;
|
||||||
if FRecordUpdated or ((FLookup.ControlItems <> nil) and (FLookup.ControlItems.Count <> DataSet.RecordCount)) then
|
if FRecordUpdated or ((FLookup.ControlItems <> nil) and (FLookup.ControlItems.Count <> DataSet.RecordCount)) then
|
||||||
begin
|
begin
|
||||||
FRecordUpdated := False;
|
FRecordUpdated := False;
|
||||||
@ -228,14 +233,38 @@ begin
|
|||||||
KeyList[i + 1] := KeyList[i];
|
KeyList[i + 1] := KeyList[i];
|
||||||
end;
|
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;
|
procedure TDBLookup.FetchLookupData;
|
||||||
var
|
var
|
||||||
KeyIndex, KeyListCount: Integer;
|
KeyIndex, KeyListCount: Integer;
|
||||||
ListLinkDataSet: TDataSet;
|
ListLinkDataSet: TDataSet;
|
||||||
Bookmark: TBookmark;
|
Bookmark: TBookmark;
|
||||||
|
{$IF FPC_FULLVERSION < 30000}
|
||||||
|
DatasetSupportsBlockRead: Boolean;
|
||||||
|
{$ENDIF}
|
||||||
begin
|
begin
|
||||||
if not Assigned(FControlItems) then
|
if not Assigned(FControlItems) then
|
||||||
Exit;
|
Exit;
|
||||||
|
{$IF FPC_FULLVERSION < 30000}
|
||||||
|
if FFetchingLookupData then
|
||||||
|
Exit;
|
||||||
|
{$ENDIF}
|
||||||
FControlItems.Clear;
|
FControlItems.Clear;
|
||||||
ListLinkDataSet := FListLink.DataSet;
|
ListLinkDataSet := FListLink.DataSet;
|
||||||
if not (Assigned(ListLinkDataSet) and Assigned(FListField)) then
|
if not (Assigned(ListLinkDataSet) and Assigned(FListField)) then
|
||||||
@ -243,11 +272,19 @@ begin
|
|||||||
if ListLinkDataSet.IsEmpty then
|
if ListLinkDataSet.IsEmpty then
|
||||||
Exit;
|
Exit;
|
||||||
Bookmark := ListLinkDataSet.GetBookmark;
|
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;
|
ListLinkDataSet.BlockReadSize := 1;
|
||||||
{$else}
|
{$ENDIF}
|
||||||
ListLinkDataSet.DisableControls;
|
|
||||||
{$endif}
|
|
||||||
FControlItems.BeginUpdate;
|
FControlItems.BeginUpdate;
|
||||||
try
|
try
|
||||||
//needed to handle sqldb.TSQLQuery that does not has a reliable recordcount after Open
|
//needed to handle sqldb.TSQLQuery that does not has a reliable recordcount after Open
|
||||||
@ -273,11 +310,17 @@ begin
|
|||||||
FControlItems.EndUpdate;
|
FControlItems.EndUpdate;
|
||||||
ListLinkDataSet.GotoBookmark(Bookmark);
|
ListLinkDataSet.GotoBookmark(Bookmark);
|
||||||
ListLinkDataSet.FreeBookmark(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;
|
ListLinkDataSet.BlockReadSize := 0;
|
||||||
{$else}
|
{$ENDIF}
|
||||||
ListLinkDataSet.EnableControls;
|
|
||||||
{$endif}
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user