Код:
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2},
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DBCtrls, ExtCtrls;
Type
TOurOpenDialog = class ( TOpenDialog )
Private
{ Private declarations }
Protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
end;
procedure register;
implementation
procedure register;
begin
RegisterComponents('Samples', [TOurOpenDialog]);
end;
{ TOurOpenDialog }
constructor TOurOpenDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Options := Options + [ofFileMustExist, ofPathMustExist];
end;
end.
Type
TOurComponent = class ( TComponent )
Private
{ Private declarations }
FArrayProp : array [0..9] of integer ;
Function GetArrayProp ( aIndex : integer ): integer ;
Procedure SetArrayProp ( aIndex : integer ; const
Value : integer );
Protected
{ Protected declarations }
Public
{ Public declarations }
Property ArrayProp [ aIndex : integer ]: integer read
GetArrayProp
Write SetArrayProp ;
Published
{ Published declarations }
End ;
Type
TOurComponent = class ( TComponent )
Private
{ Private declarations }
FMyInteger : Integer ;
Protected
{ Protected declarations }
Public
{ Public declarations }
Constructor Create ( AOwner : TComponent ); override ;
Published
{ Published declarations }
Property MyInteger : Integer read FMyInteger
Write FMyInteger default 10;
End ;
Procedure Register ;
Begin
Interface
Uses
SysUtils , Classes , Controls , StdCtrls ;
Type
TmgCoolLabel = class ( TLabel )
Private
{ Private declarations }
Protected
{ Protected declarations }
Public
{ Public declarations }
Published
{ Published declarations }
End ;
Procedure Register ;
Implementation
End ;
End .
Implementation
Create constructor TOurComponent . ( AOwner : TComponent );
Begin
Inherited Create ( AOwner );
FInteger :=10;
End ;
End .
Interface
Uses
SysUtils , Classes , Controls , StdCtrls ;
type
TmgCoolLabel = class(TLabel)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
published
{ Published declarations }
property Height default 30;
property Width default 85;
end;
procedure Register;
implementation
uses Graphics;
procedure Register;
begin
RegisterComponents('Our components', [TmgCoolLabel]);
end;
{ TmgCoolLabel }
constructor TmgCoolLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoSize:=false;
Height:=30;
Width:=120;
Font.Color:=clBlue;
Font.Style:=[fsBold];
Font.Height:=16;
Font.Size:=12;
end;
end.
RegisterComponents (' Our components ',[ TmgCoolLabel ]);
Var
Stream : TStream ;
Begin
Stream := Create TFileStream . ( FileName , fmCreate );
Try
WriteComponentRes Stream . ( ClassName Instance . , Instance );
Finally
Free Stream . ;
End ;
End ;
Private
FStream : TStream ;
FBuffer : Pointer ;
FBufSize : Integer ;
FBufPos : Integer ;
FBufEnd : Integer ;
FRoot : TComponent ;
FLookupRoot : TComponent ;
FAncestor : TPersistent ;
FIgnoreChildren : Boolean ;
Protected
Procedure SetRoot ( Value : TComponent ); virtual ;
Public
Constructor Create ( Stream : TStream ; BufSize : Integer );
Destructor Destroy ; override ;
Procedure DefineProperty ( const Name : string ;
ReadData : TReaderProc ; WriteData : TWriterProc ;
HasData : Boolean ); virtual ; abstract ;
Procedure DefineBinaryProperty ( const Name : string ;
ReadData , WriteData : TStreamProc ;
HasData : Boolean ); virtual ; abstract ;
Procedure FlushBuffer ; virtual ; abstract ;
Property Root : TComponent read FRoot write SetRoot ;
Property
LookupRoot : TComponent read FLookupRoot ;
Property Ancestor : TPersistent read FAncestor write FAncestor ;
Property IgnoreChildren : Boolean read FIgnoreChildren write FIgnoreChildren ;
End ;
Type
TForm 1= class ( TForm )
Button 1: TButton ;
OpenDialog 1: TOpenDialog ;
Button 2: TButton ;
Procedure Button 1 Click ( Sender : TObject );
Procedure Button 2 Click ( Sender : TObject );
Private
{ Private declarations }
Procedure ReadFormProperties ( DfmName : String ; Form : TComponent );
Procedure WriteFormProperties ( DfmName : String ; Form : TComponent );
Public
{ Public declarations }
End ;
Var
Form 1: TForm 1;
Implementation
{$ R dfm }
Procedure TForm 1. Button 1 Click ( Sender : TObject );
Var
RunTimeForm : TForm ;
Begin
RunTimeForm := TForm 1. CreateNew ( Self );
With RunTimeForm do try
If OpenDialog 1. Execute then
Begin
ReadFormProperties ( OpenDialog 1. FileName , RunTimeForm );
ShowModal ;
End ;
Finally
Free RunTimeForm . ;
End ;
End ;
Procedure TForm 1. ReadFormProperties ( DfmName : String ; Form : TComponent );
Var
FileStream : TFileStream ;
BinStream : TMemoryStream ;
Begin
FileStream := Create TFileStream . ( DfmName , fmOpenRead );
Try
BinStream := Create TMemoryStream . ;
Try
ObjectTextToBinary ( FileStream , BinStream );
Seek BinStream . (0, soFromBeginning );
ReadComponent BinStream . ( Form );
Finally
Free BinStream . ;
End ;
Finally
Free FileStream . ;
End ;
End ;
Procedure TForm 1. WriteFormProperties ( DfmName : String ; Form : TComponent );
Var
BinStream : TMemoryStream ;
FileStream : TFileStream ;
Begin
BinStream := Create TMemoryStream . ;
Try
FileStream := Create TFileStream . ( DfmName , fmOpenWrite or fmCreate );
Try
WriteComponent BinStream . ( Form );
Seek BinStream . (0, soFromBeginning );
ObjectBinaryToText ( BinStream , FileStream );
Finally
Free FileStream . ;
End ;
Finally
Free BinStream .
End ;
End ;
Procedure TForm 1. Button 2 Click ( Sender : TObject );
Begin
If OpenDialog 1. Execute then
Begin
WriteFormProperties ( OpenDialog 1. FileName , Self );
ShowModal ;
End ;
End ;
Left =192
Top =114
Width =870
Height =640
Caption =' Form 1'
Color = clBtnFace
А
Color Font . = clWindowText
Height Font . =-11
Name Font . =' MS Sans Serif '
Style Font . =[]
OldCreateOrder = False
PixelsPerInch =96
TextHeight =13
Object TextLogger 1: TTextLogger
Text ='678'
Left =368
Top =160
TextHistory =(
End
End.
ошибки
[Pascal Error] Project3.dpr(13): E2029 Identifier expected but 'BEGIN' found
[Pascal Error] Project3.dpr(15): E2003 Undeclared identifier: 'Application'
[Pascal Error] Project3.dpr(15): E2066 Missing operator or semicolon
[Pascal Hint] Project3.dpr(15): H2243 Expression needs no Initialize/Finalize
[Pascal Error] Project3.dpr(17): E2066 Missing operator or semicolon
[Pascal Error] Project3.dpr(17): E2003 Undeclared identifier: 'TForm1'
[Pascal Error] Project3.dpr(19): E2066 Missing operator or semicolon
[Pascal Error] Project3.dpr(19): E2003 Undeclared identifier: 'TForm2'
[Pascal Warning] Project3.dpr(23): W1011 Text after final 'END.' - ignored by compiler
[Pascal Error] Project3.dpr(389): E1030 Invalid compiler directive: '$ '