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

IDEIntf: Get LookupRoot for TFieldDefs, bug #25068

Browse Source 
git-svn-id: trunk@42953 -
This commit is contained in:
mattias 2013-09-26 23:03:07 +00:00
parent 005037e85b
commit 595776b9f2
3 changed files with 56 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/ideintf/componenttreeview.pas
View File

@ -19,7 +19,7 @@ unit ComponentTreeView;
{$mode objfpc}{$H+}
{$DEFINE VerboseComponentTVWalker}
{off $DEFINE VerboseComponentTVWalker}
interface

21
components/ideintf/dbpropedits.pas
View File

@ -17,8 +17,9 @@ unit DBPropEdits;
interface
uses
Classes, ObjInspStrConsts, PropEdits, ComponentEditors, TypInfo, DB, SysUtils,
DbCtrls, DBGrids;
Classes, SysUtils, ObjInspStrConsts, PropEdits, PropEditUtils,
ComponentEditors,
TypInfo, DB, DbCtrls, DBGrids;
type
TFieldProperty = class(TStringPropertyEditor)
@ -49,6 +50,8 @@ type
procedure ExecuteVerb(Index: Integer); override;
end;
function GetFieldDefsLookupRoot(APersistent: TPersistent): TPersistent;
implementation
procedure LoadDataSourceFields(DataSource: TDataSource; List: TStrings);
@ -72,6 +75,19 @@ begin
end;
end;
function GetFieldDefsLookupRoot(APersistent: TPersistent): TPersistent;
var
aFieldDefs: TFieldDefs;
begin
Result:=nil;
if not (APersistent is TFieldDefs) then exit;
aFieldDefs:=TFieldDefs(APersistent);
Result:=aFieldDefs.Owner;
if Result=nil then
Result:=aFieldDefs.Dataset;
Result:=GetLookupRootForComponent(Result);
end;
{ TFieldProperty }
function TFieldProperty.GetAttributes: TPropertyAttributes;
@ -156,6 +172,7 @@ initialization
RegisterPropertyEditor(TypeInfo(string), TDBLookupComboBox, 'ListField', TLookupFieldProperty);
RegisterPropertyEditor(TypeInfo(string), TColumn, 'FieldName', TDBGridFieldProperty);
RegisterComponentEditor(TDBGrid,TDBGridComponentEditor);
RegisterGetLookupRoot(@GetFieldDefsLookupRoot);
end.

40
components/ideintf/propeditutils.pp
View File

@ -76,27 +76,54 @@ type
function GetLookupRootForComponent(APersistent: TPersistent): TPersistent;
type
TGetLookupRoot = function(APersistent: TPersistent): TPersistent;
procedure RegisterGetLookupRoot(const OnGetLookupRoot: TGetLookupRoot);
procedure UnregisterGetLookupRoot(const OnGetLookupRoot: TGetLookupRoot);
implementation
type
TPersistentAccess = class(TPersistent);
var
GetLookupRoots: TFPList = nil; // list of TGetLookupRoot
function GetLookupRootForComponent(APersistent: TPersistent): TPersistent;
var
AOwner: TPersistent;
i: Integer;
begin
Result := APersistent;
if Result = nil then
Exit;
repeat
AOwner := TPersistentAccess(Result).GetOwner;
if AOwner <> nil then
Result := AOwner
else
Exit;
if (AOwner=nil) and (GetLookupRoots<>nil) then begin
for i:=GetLookupRoots.Count-1 downto 0 do begin
AOwner:=TGetLookupRoot(GetLookupRoots[i])(Result);
if AOwner<>nil then break;
end;
end;
if AOwner = nil then
exit;
Result := AOwner
until False;
end;
procedure RegisterGetLookupRoot(const OnGetLookupRoot: TGetLookupRoot);
begin
if GetLookupRoots=nil then
GetLookupRoots:=TFPList.Create;
GetLookupRoots.Add(OnGetLookupRoot);
end;
procedure UnregisterGetLookupRoot(const OnGetLookupRoot: TGetLookupRoot);
begin
if GetLookupRoots=nil then exit;
GetLookupRoots.Remove(OnGetLookupRoot);
end;
{ TPersistentSelectionList }
function TPersistentSelectionList.Add(APersistent: TPersistent): integer;
@ -319,5 +346,10 @@ begin
Result := True;
end;
initialization
GetLookupRoots:=nil;
finalization
FreeAndNil(GetLookupRoots);
end.