paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 14:09:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

Added code for registerclass, GetClass and RegisterClasses

Browse Source 
Shane
This commit is contained in:
lazarus 2000-06-27 17:17:34 +00:00
parent ff7424265d
commit 6673c39beb
2 changed files with 60 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
fcl/inc/cregist.inc
View File

@ -17,14 +17,36 @@
{ Class registration routines }
procedure RegisterClass(AClass: TPersistentClass);
var
aClassname : String;
begin
//Classlist is created during initialization.
with Classlist.Locklist do
try
while Indexof(AClass) = -1 do
begin
aClassname := AClass.ClassName;
if GetClass(aClassName) <> nil then //class alread registered!
Begin
//raise an error
exit;
end;
Add(AClass);
if AClass = TPersistent then break;
AClass := TPersistentClass(AClass.ClassParent);
end;
finally
ClassList.UnlockList;
end;
end;
procedure RegisterClasses(AClasses: array of TPersistentClass);
var
I : Integer;
begin
for I := low(aClasses) to high(aClasses) do
RegisterClass(aClasses[I]);
end;
@ -60,13 +82,28 @@ end;
function GetClass(const ClassName: string): TPersistentClass;
var
I : Integer;
begin
GetClass:=nil;
with ClassList.LockList do
try
for I := 0 to Count-1 do
begin
Result := TPersistentClass(Items[I]);
if Result.ClassNameIs(ClassName) then Exit;
end;
I := ClassAliasList.Indexof(ClassName);
if I >= 0 then //found
Begin
Result := TPersistentClass(ClassAliasList.Objects[i]);
exit;
end;
Result := nil;
finally
ClassList.Unlocklist;
end;
end;
{ Component registration routines }
type
@ -148,7 +185,11 @@ end;
{
$Log$
Revision 1.4 2000-01-07 01:24:33 peter
Revision 1.5 2000-06-27 17:17:34 lazarus
Added code for registerclass, GetClass and RegisterClasses
Shane
Revision 1.4 2000/01/07 01:24:33 peter
* updated copyright to 2000
Revision 1.3 2000/01/06 01:20:33 peter

18
fcl/linux/classes.pp
View File

@ -36,24 +36,30 @@ uses
var
ClassList : TThreadlist;
ClassAliasList : TStringList;
{ OS - independent class implementations are in /inc directory. }
{$i classes.inc}
initialization
ClassList := TThreadList.Create;
ClassList := TThreadList.Create;
ClassAliasList := TStringList.Create;
finalization
ClassList.Free;
ClassList.Free;
ClassAliasList.Free;
if ThreadsInited then
DoneThreads;
if ThreadsInited then
DoneThreads;
end.
{
$Log$
Revision 1.16 2000-06-27 15:55:19 lazarus
Revision 1.17 2000-06-27 17:17:34 lazarus
Added code for registerclass, GetClass and RegisterClasses
Shane
Revision 1.16 2000/06/27 15:55:19 lazarus
Added TThreadlist code. Shane
Revision 1.15 2000/01/07 01:24:34 peter