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

* now it compiles with FPC

Browse Source
This commit is contained in:
florian 1998-05-01 17:53:12 +00:00
parent 3233d4aeb7
commit 36f2f583a4
1 changed files with 46 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
fcl/classes.pp
View File

@ -24,6 +24,24 @@ type
Exception = class(TObject); Exception = class(TObject);
EOutOfMemory = class(Exception); EOutOfMemory = class(Exception);
TRTLCriticalSection = class(TObject); TRTLCriticalSection = class(TObject);
HRSRC = longint;
THANDLE = longint;
TComponentName = string;
IUnKnown = class(TObject);
TGUID = longint;
HMODULE = longint;
TPoint = record
x,y : integer;
end;
TSmallPoint = record
x,y : smallint;
end;
TRect = record
Left,Right,Top,Bottom : Integer;
end;
const const
@ -510,7 +528,7 @@ type
{ TStreamAdapter } { TStreamAdapter }
{ Implements OLE IStream on VCL TStream } { Implements OLE IStream on VCL TStream }
{ we don't need that yet
TStreamAdapter = class(TInterfacedObject, IStream) TStreamAdapter = class(TInterfacedObject, IStream)
private private
FStream: TStream; FStream: TStream;
@ -535,7 +553,7 @@ type
grfStatFlag: Longint): HResult; stdcall; grfStatFlag: Longint): HResult; stdcall;
function Clone(out stm: IStream): HResult; stdcall; function Clone(out stm: IStream): HResult; stdcall;
end; end;
}
{ TFiler } { TFiler }
TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended, TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
@ -626,10 +644,10 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure BeginReferences; procedure BeginReferences;
procedure DefineProperty(const Name: string; procedure DefineProperty(const Name: string;
ReadData: TReaderProc; WriteData: TWriterProc; rd : TReaderProc; wd : TWriterProc;
HasData: Boolean); override; HasData: Boolean); override;
procedure DefineBinaryProperty(const Name: string; procedure DefineBinaryProperty(const Name: string;
ReadData, WriteData: TStreamProc; rd, wd: TStreamProc;
HasData: Boolean); override; HasData: Boolean); override;
function EndOfList: Boolean; function EndOfList: Boolean;
procedure EndReferences; procedure EndReferences;
@ -683,16 +701,16 @@ type
procedure WriteProperties(Instance: TPersistent); procedure WriteProperties(Instance: TPersistent);
procedure WritePropName(const PropName: string); procedure WritePropName(const PropName: string);
protected protected
procedure WriteBinary(WriteData: TStreamProc); procedure WriteBinary(wd : TStreamProc);
procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer); procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
procedure WriteValue(Value: TValueType); procedure WriteValue(Value: TValueType);
public public
destructor Destroy; override; destructor Destroy; override;
procedure DefineProperty(const Name: string; procedure DefineProperty(const Name: string;
ReadData: TReaderProc; WriteData: TWriterProc; rd : TReaderProc; wd : TWriterProc;
HasData: Boolean); override; HasData: Boolean); override;
procedure DefineBinaryProperty(const Name: string; procedure DefineBinaryProperty(const Name: string;
ReadData, WriteData: TStreamProc; rd, wd: TStreamProc;
HasData: Boolean); override; HasData: Boolean); override;
procedure FlushBuffer; override; procedure FlushBuffer; override;
procedure Write(const Buf; Count: Longint); procedure Write(const Buf; Count: Longint);
@ -738,7 +756,9 @@ type
procedure CheckToken(T: Char); procedure CheckToken(T: Char);
procedure CheckTokenSymbol(const S: string); procedure CheckTokenSymbol(const S: string);
procedure Error(const Ident: string); procedure Error(const Ident: string);
{!!!!!!
procedure ErrorFmt(const Ident: string; const Args: array of const); procedure ErrorFmt(const Ident: string; const Args: array of const);
}
procedure ErrorStr(const Message: string); procedure ErrorStr(const Message: string);
procedure HexToBinary(Stream: TStream); procedure HexToBinary(Stream: TStream);
function NextToken: Char; function NextToken: Char;
@ -805,6 +825,7 @@ type
TComponentStyle = set of (csInheritable, csCheckPropAvail); TComponentStyle = set of (csInheritable, csCheckPropAvail);
TGetChildProc = procedure (Child: TComponent) of object; TGetChildProc = procedure (Child: TComponent) of object;
{
TComponentName = type string; TComponentName = type string;
IVCLComObject = interface IVCLComObject = interface
@ -819,6 +840,7 @@ type
ExceptAddr: Pointer): Integer; ExceptAddr: Pointer): Integer;
procedure FreeOnRelease; procedure FreeOnRelease;
end; end;
}
TComponent = class(TPersistent) TComponent = class(TPersistent)
private private
@ -869,16 +891,16 @@ type
procedure ValidateInsert(AComponent: TComponent); dynamic; procedure ValidateInsert(AComponent: TComponent); dynamic;
procedure WriteState(Writer: TWriter); virtual; procedure WriteState(Writer: TWriter); virtual;
{ IUnknown } { IUnknown }
function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall; //!!!!! function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
function _AddRef: Integer; stdcall; //!!!! function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall; //!!!! function _Release: Integer; stdcall;
{ IDispatch } { IDispatch }
function GetTypeInfoCount(out Count: Integer): Integer; stdcall; //!!!! function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall; //!!!! function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer; //!!!! function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall; //!!!! NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; //!!!! function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall; //!!!! Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
public public
constructor Create(AOwner: TComponent); virtual; constructor Create(AOwner: TComponent); virtual;
destructor Destroy; override; destructor Destroy; override;
@ -903,8 +925,8 @@ type
property Owner: TComponent read FOwner; property Owner: TComponent read FOwner;
property VCLComObject: Pointer read FVCLComObject write FVCLComObject; property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
published published
property Name: TComponentName read FName write SetName stored False; //!!!! property Name: TComponentName read FName write SetName stored False;
property Tag: Longint read FTag write FTag default 0; //!!!! property Tag: Longint read FTag write FTag default 0;
end; end;
{ TComponent class reference type } { TComponent class reference type }
@ -915,6 +937,7 @@ type
TActiveXRegType = (axrComponentOnly, axrIncludeDescendants); TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
{!!!!!!!
var var
RegisterComponentsProc: procedure(const Page: string; RegisterComponentsProc: procedure(const Page: string;
ComponentClasses: array of TComponentClass) = nil; ComponentClasses: array of TComponentClass) = nil;
@ -923,7 +946,7 @@ var
AxRegType: TActiveXRegType) = nil; AxRegType: TActiveXRegType) = nil;
CurrentGroup: Integer = -1; { Current design group } CurrentGroup: Integer = -1; { Current design group }
CreateVCLComObjectProc: procedure(Component: TComponent) = nil; CreateVCLComObjectProc: procedure(Component: TComponent) = nil;
}
{ Point and rectangle constructors } { Point and rectangle constructors }
function Point(AX, AY: Integer): TPoint; function Point(AX, AY: Integer): TPoint;
@ -1008,11 +1031,13 @@ function LineStart(Buffer, BufPos: PChar): PChar;
implementation implementation
end. end.
{ {
$Log$ $Log$
Revision 1.4 1998-04-28 11:47:00 florian Revision 1.5 1998-05-01 17:53:12 florian
* now it compiles with FPC
Revision 1.4 1998/04/28 11:47:00 florian
* more adaptions to FPC * more adaptions to FPC
Revision 1.3 1998/04/27 12:55:57 florian Revision 1.3 1998/04/27 12:55:57 florian