mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 18:59:21 +02:00
fixed streaming TDataModule in programs
git-svn-id: trunk@2491 -
This commit is contained in:
mattias
parent
8573cc7387
commit
f2da2ebf95
258
lcl/controls.pp
258
lcl/controls.pp
@ -156,55 +156,6 @@ const
|
|||||||
mrLast = mrYesToAll;
|
mrLast = mrYesToAll;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{$IFNDEF UseFCLDataModule}
|
|
||||||
type
|
|
||||||
{ TDataModule }
|
|
||||||
|
|
||||||
TDataModule = class(TComponent)
|
|
||||||
private
|
|
||||||
FDesignSize: TPoint;
|
|
||||||
FDesignOffset: TPoint;
|
|
||||||
FOnCreate: TNotifyEvent;
|
|
||||||
FOnDestroy: TNotifyEvent;
|
|
||||||
FOldCreateOrder: Boolean;
|
|
||||||
procedure ReadHeight(Reader: TReader);
|
|
||||||
procedure ReadHorizontalOffset(Reader: TReader);
|
|
||||||
procedure ReadVerticalOffset(Reader: TReader);
|
|
||||||
procedure ReadWidth(Reader: TReader);
|
|
||||||
procedure WriteWidth(Writer: TWriter);
|
|
||||||
procedure WriteHorizontalOffset(Writer: TWriter);
|
|
||||||
procedure WriteVerticalOffset(Writer: TWriter);
|
|
||||||
procedure WriteHeight(Writer: TWriter);
|
|
||||||
protected
|
|
||||||
procedure DoCreate; virtual;
|
|
||||||
procedure DoDestroy; virtual;
|
|
||||||
procedure DefineProperties(Filer: TFiler); override;
|
|
||||||
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
|
|
||||||
function HandleCreateException: Boolean; dynamic;
|
|
||||||
procedure ReadState(Reader: TReader); override;
|
|
||||||
public
|
|
||||||
constructor Create(TheOwner: TComponent); override;
|
|
||||||
constructor CreateNew(TheOwner: TComponent; CreateMode: Integer); virtual;
|
|
||||||
destructor Destroy; override;
|
|
||||||
procedure AfterConstruction; override;
|
|
||||||
procedure BeforeDestruction; override;
|
|
||||||
property DesignOffset: TPoint read FDesignOffset write FDesignOffset;
|
|
||||||
property DesignSize: TPoint read FDesignSize write FDesignSize;
|
|
||||||
property OldCreateOrder: Boolean read FOldCreateOrder write FOldCreateOrder;
|
|
||||||
published
|
|
||||||
property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
|
|
||||||
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
|
|
||||||
end;
|
|
||||||
|
|
||||||
const
|
|
||||||
AddDataModule: procedure (DataModule: TDataModule) of object = nil;
|
|
||||||
RemoveDataModule: procedure (DataModule: TDataModule) of object = nil;
|
|
||||||
ApplicationHandleException: procedure (Sender: TObject) of object = nil;
|
|
||||||
ApplicationShowException: procedure (E: Exception) of object = nil;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
|
|
||||||
type
|
type
|
||||||
TWinControl = class;
|
TWinControl = class;
|
||||||
TControl = class;
|
TControl = class;
|
||||||
@ -1471,212 +1422,6 @@ begin
|
|||||||
Result := IdentToInt(Ident, Cursor, Cursors);
|
Result := IdentToInt(Ident, Cursor, Cursors);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IFNDEF UseFCLDataModule}
|
|
||||||
{ TDataModule }
|
|
||||||
|
|
||||||
constructor TDataModule.Create(TheOwner: TComponent);
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.Create START');
|
|
||||||
//GlobalNameSpace.BeginWrite;
|
|
||||||
try
|
|
||||||
CreateNew(TheOwner,0);
|
|
||||||
if (ClassType <> TDataModule) and not (csDesigning in ComponentState) then
|
|
||||||
begin
|
|
||||||
if not InitInheritedComponent(Self, TDataModule) then
|
|
||||||
raise EResNotFound.CreateFmt(lisLCLResourceSNotFound, [ClassName]);
|
|
||||||
if OldCreateOrder then DoCreate;
|
|
||||||
end;
|
|
||||||
writeln('TDataModule.Create END');
|
|
||||||
finally
|
|
||||||
//GlobalNameSpace.EndWrite;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.AfterConstruction;
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.AfterConstruction');
|
|
||||||
if not OldCreateOrder then DoCreate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
constructor TDataModule.CreateNew(TheOwner: TComponent; CreateMode: Integer);
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.CreateNew START');
|
|
||||||
inherited Create(TheOwner);
|
|
||||||
|
|
||||||
if Assigned(AddDataModule) and (CreateMode >= 0) then
|
|
||||||
AddDataModule(Self);
|
|
||||||
writeln('TDataModule.CreateNew END');
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.BeforeDestruction;
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.BeforeDestruction START');
|
|
||||||
//GlobalNameSpace.BeginWrite;
|
|
||||||
Destroying;
|
|
||||||
RemoveFixupReferences(Self, '');
|
|
||||||
if not OldCreateOrder then DoDestroy;
|
|
||||||
writeln('TDataModule.BeforeDestruction END');
|
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TDataModule.Destroy;
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.Destroy START');
|
|
||||||
if not (csDestroying in ComponentState) then
|
|
||||||
; //GlobalNameSpace.BeginWrite;
|
|
||||||
try
|
|
||||||
if OldCreateOrder then DoDestroy;
|
|
||||||
if Assigned(RemoveDataModule) then
|
|
||||||
RemoveDataModule(Self);
|
|
||||||
inherited Destroy;
|
|
||||||
finally
|
|
||||||
//GlobalNameSpace.EndWrite;
|
|
||||||
end;
|
|
||||||
writeln('TDataModule.Destroy END');
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.DoCreate;
|
|
||||||
begin
|
|
||||||
if Assigned(FOnCreate) then
|
|
||||||
try
|
|
||||||
FOnCreate(Self);
|
|
||||||
except
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.DoCreate A');
|
|
||||||
if not HandleCreateException then
|
|
||||||
raise;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.DoDestroy;
|
|
||||||
begin
|
|
||||||
if Assigned(FOnDestroy) then
|
|
||||||
try
|
|
||||||
FOnDestroy(Self);
|
|
||||||
except
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.DoDestroy A');
|
|
||||||
if Assigned(ApplicationHandleException) then
|
|
||||||
ApplicationHandleException(Self);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.DefineProperties(Filer: TFiler);
|
|
||||||
var
|
|
||||||
Ancestor: TDataModule;
|
|
||||||
|
|
||||||
function DoWriteWidth: Boolean;
|
|
||||||
begin
|
|
||||||
Result := True;
|
|
||||||
if Ancestor <> nil then Result := FDesignSize.X <> Ancestor.FDesignSize.X;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function DoWriteHorizontalOffset: Boolean;
|
|
||||||
begin
|
|
||||||
if Ancestor <> nil then
|
|
||||||
Result := FDesignOffset.X <> Ancestor.FDesignOffset.X else
|
|
||||||
Result := FDesignOffset.X <> 0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function DoWriteVerticalOffset: Boolean;
|
|
||||||
begin
|
|
||||||
if Ancestor <> nil then
|
|
||||||
Result := FDesignOffset.Y <> Ancestor.FDesignOffset.Y else
|
|
||||||
Result := FDesignOffset.Y <> 0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function DoWriteHeight: Boolean;
|
|
||||||
begin
|
|
||||||
Result := True;
|
|
||||||
if Ancestor <> nil then Result := FDesignSize.Y <> Ancestor.FDesignSize.Y;
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
|
||||||
inherited DefineProperties(Filer);
|
|
||||||
Ancestor := TDataModule(Filer.Ancestor);
|
|
||||||
Filer.DefineProperty('Height', @ReadHeight, @WriteHeight, DoWriteHeight);
|
|
||||||
Filer.DefineProperty('HorizontalOffset', @ReadHorizontalOffset,
|
|
||||||
@WriteHorizontalOffset, DoWriteHorizontalOffset);
|
|
||||||
Filer.DefineProperty('VerticalOffset', @ReadVerticalOffset,
|
|
||||||
@WriteVerticalOffset, DoWriteVerticalOffset);
|
|
||||||
Filer.DefineProperty('Width', @ReadWidth, @WriteWidth, DoWriteWidth);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.GetChildren(Proc: TGetChildProc; Root: TComponent);
|
|
||||||
var
|
|
||||||
I: Integer;
|
|
||||||
OwnedComponent: TComponent;
|
|
||||||
begin
|
|
||||||
inherited GetChildren(Proc, Root);
|
|
||||||
if Root = Self then begin
|
|
||||||
for I := 0 to ComponentCount - 1 do
|
|
||||||
begin
|
|
||||||
OwnedComponent := Components[I];
|
|
||||||
if not OwnedComponent.HasParent then Proc(OwnedComponent);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TDataModule.HandleCreateException: Boolean;
|
|
||||||
begin
|
|
||||||
writeln('TDataModule.HandleCreateException A');
|
|
||||||
if Assigned(ApplicationHandleException) then
|
|
||||||
begin
|
|
||||||
ApplicationHandleException(Self);
|
|
||||||
Result := True;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
Result := False;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.ReadState(Reader: TReader);
|
|
||||||
begin
|
|
||||||
FOldCreateOrder := false;
|
|
||||||
inherited ReadState(Reader);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.ReadWidth(Reader: TReader);
|
|
||||||
begin
|
|
||||||
FDesignSize.X := Reader.ReadInteger;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.ReadHorizontalOffset(Reader: TReader);
|
|
||||||
begin
|
|
||||||
FDesignOffset.X := Reader.ReadInteger;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.ReadVerticalOffset(Reader: TReader);
|
|
||||||
begin
|
|
||||||
FDesignOffset.Y := Reader.ReadInteger;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.ReadHeight(Reader: TReader);
|
|
||||||
begin
|
|
||||||
FDesignSize.Y := Reader.ReadInteger;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.WriteWidth(Writer: TWriter);
|
|
||||||
begin
|
|
||||||
Writer.WriteInteger(FDesignSize.X);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.WriteHorizontalOffset(Writer: TWriter);
|
|
||||||
begin
|
|
||||||
Writer.WriteInteger(FDesignOffset.X);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.WriteVerticalOffset(Writer: TWriter);
|
|
||||||
begin
|
|
||||||
Writer.WriteInteger(FDesignOffset.Y);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TDataModule.WriteHeight(Writer: TWriter);
|
|
||||||
begin
|
|
||||||
Writer.WriteInteger(FDesignSize.Y);
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
// turn off before includes !!
|
// turn off before includes !!
|
||||||
{$IFDEF ASSERT_IS_ON}
|
{$IFDEF ASSERT_IS_ON}
|
||||||
{$UNDEF ASSERT_IS_ON}
|
{$UNDEF ASSERT_IS_ON}
|
||||||
@ -1713,6 +1458,9 @@ end.
|
|||||||
{ =============================================================================
|
{ =============================================================================
|
||||||
|
|
||||||
$Log$
|
$Log$
|
||||||
|
Revision 1.121 2003/06/01 21:37:18 mattias
|
||||||
|
fixed streaming TDataModule in programs
|
||||||
|
|
||||||
Revision 1.120 2003/06/01 21:09:09 mattias
|
Revision 1.120 2003/06/01 21:09:09 mattias
|
||||||
implemented datamodules
|
implemented datamodules
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user