fixed registration for fpc 1.0.x

git-svn-id: trunk@4025 -
This commit is contained in:
mattias 2003-04-08 09:04:07 +00:00
parent 5ba8381011
commit 7a541bcc8f
3 changed files with 25 additions and 14 deletions

View File

@ -40,7 +40,9 @@ program Lazarus;
{$R *.res} {$R *.res}
{$ENDIF} {$ENDIF}
uses {off $DEFINE IDE_MEM_CHECK}
uses
//cmem, //cmem,
{$IFDEF IDE_MEM_CHECK} {$IFDEF IDE_MEM_CHECK}
MemCheck, MemCheck,
@ -88,6 +90,9 @@ end.
{ {
$Log$ $Log$
Revision 1.40 2003/04/08 09:04:07 mattias
fixed registration for fpc 1.0.x
Revision 1.39 2002/10/26 15:15:42 lazarus Revision 1.39 2002/10/26 15:15:42 lazarus
MG: broke LCL<->interface circles MG: broke LCL<->interface circles

View File

@ -271,7 +271,7 @@ const
procedure Register; procedure Register;
begin begin
RegisterComponentsProc('Dialogs',[TOpenDialog,TSaveDialog, RegisterComponents('Dialogs',[TOpenDialog,TSaveDialog,
TColorDialog,TFontDialog]); TColorDialog,TFontDialog]);
end; end;
@ -340,6 +340,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.29 2003/04/08 09:04:07 mattias
fixed registration for fpc 1.0.x
Revision 1.28 2003/04/04 16:35:24 mattias Revision 1.28 2003/04/04 16:35:24 mattias
started package registration started package registration

View File

@ -37,7 +37,14 @@ unit PackageSystem;
interface interface
{off $DEFINE IDE_MEM_CHECK}
{$DEFINE StopOnRegError}
uses uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, AVL_Tree, FileCtrl, Forms, Controls, Dialogs, Classes, SysUtils, AVL_Tree, FileCtrl, Forms, Controls, Dialogs,
LazarusIDEStrConsts, IDEProcs, PackageLinks, PackageDefs, LazarusPackageIntf, LazarusIDEStrConsts, IDEProcs, PackageLinks, PackageDefs, LazarusPackageIntf,
ComponentReg, RegisterLCL, RegisterFCL; ComponentReg, RegisterLCL, RegisterFCL;
@ -78,7 +85,6 @@ type
FItems: TList; // unsorted list of TLazPackage FItems: TList; // unsorted list of TLazPackage
function GetPackages(Index: integer): TLazPackage; function GetPackages(Index: integer): TLazPackage;
procedure SetAbortRegistration(const AValue: boolean); procedure SetAbortRegistration(const AValue: boolean);
procedure SetErrorMsg(const AValue: string);
procedure SetRegistrationPackage(const AValue: TLazPackage); procedure SetRegistrationPackage(const AValue: TLazPackage);
function CreateFCLPackage: TLazPackage; function CreateFCLPackage: TLazPackage;
function CreateLCLPackage: TLazPackage; function CreateLCLPackage: TLazPackage;
@ -123,7 +129,7 @@ type
write SetRegistrationPackage; write SetRegistrationPackage;
property RegistrationUnitName: string read FRegistrationUnitName; property RegistrationUnitName: string read FRegistrationUnitName;
property RegistrationFile: TPkgFile read FRegistrationFile; property RegistrationFile: TPkgFile read FRegistrationFile;
property ErrorMsg: string read FErrorMsg write SetErrorMsg; property ErrorMsg: string read FErrorMsg write FErrorMsg;
property AbortRegistration: boolean read FAbortRegistration property AbortRegistration: boolean read FAbortRegistration
write SetAbortRegistration; write SetAbortRegistration;
property FCLPackage: TLazPackage read FFCLPackage; property FCLPackage: TLazPackage read FFCLPackage;
@ -160,12 +166,6 @@ begin
FAbortRegistration:=AValue; FAbortRegistration:=AValue;
end; end;
procedure TLazPackageGraph.SetErrorMsg(const AValue: string);
begin
if FErrorMsg=AValue then exit;
FErrorMsg:=AValue;
end;
procedure TLazPackageGraph.SetRegistrationPackage(const AValue: TLazPackage); procedure TLazPackageGraph.SetRegistrationPackage(const AValue: TLazPackage);
begin begin
if FRegistrationPackage=AValue then exit; if FRegistrationPackage=AValue then exit;
@ -401,12 +401,12 @@ begin
RegistrationError('Register procedure is nil'); RegistrationError('Register procedure is nil');
exit; exit;
end; end;
{$IFNDEF StopOnError} {$IFNDEF StopOnRegError}
try try
{$ENDIF} {$ENDIF}
// call the registration procedure // call the registration procedure
RegisterProc(); RegisterProc();
{$IFNDEF StopOnError} {$IFNDEF StopOnRegError}
except except
on E: Exception do begin on E: Exception do begin
RegistrationError(E.Message); RegistrationError(E.Message);
@ -428,6 +428,9 @@ var
NewPkgComponent: TPkgComponent; NewPkgComponent: TPkgComponent;
CurClassname: string; CurClassname: string;
begin begin
{$IFDEF IDE_MEM_CHECK}
CheckHeap('TLazPackageGraph.RegisterComponentsHandler Page='+Page);
{$ENDIF}
if AbortRegistration or (Low(ComponentClasses)>High(ComponentClasses)) then if AbortRegistration or (Low(ComponentClasses)>High(ComponentClasses)) then
exit; exit;
@ -447,7 +450,7 @@ begin
for i:=Low(ComponentClasses) to High(ComponentClasses) do begin for i:=Low(ComponentClasses) to High(ComponentClasses) do begin
CurComponent:=ComponentClasses[i]; CurComponent:=ComponentClasses[i];
if (CurComponent=nil) then continue; if (CurComponent=nil) then continue;
{$IFNDEF StopOnError} {$IFNDEF StopOnRegError}
try try
{$ENDIF} {$ENDIF}
CurClassname:=CurComponent.Classname; CurClassname:=CurComponent.Classname;
@ -455,7 +458,7 @@ begin
RegistrationError('Invalid component class'); RegistrationError('Invalid component class');
continue; continue;
end; end;
{$IFNDEF StopOnError} {$IFNDEF StopOnRegError}
except except
on E: Exception do begin on E: Exception do begin
RegistrationError(E.Message); RegistrationError(E.Message);