From 4c98ff802b5dbbf2aafcea678e12d50c38c4b2f5 Mon Sep 17 00:00:00 2001 From: florian Date: Mon, 4 May 1998 12:16:01 +0000 Subject: [PATCH] + Initial revisions after making a new directory structure --- fcl/dos/go32v2/classes.pp | 101 +++++ fcl/inc/classes.inc | 515 +++++++++++++++++++++++++ fcl/{classes.pp => inc/classesh.inc} | 540 +-------------------------- fcl/linux/classes.pp | 101 +++++ fcl/os2/classes.pp | 101 +++++ fcl/win32/classes.pp | 101 +++++ 6 files changed, 924 insertions(+), 535 deletions(-) create mode 100644 fcl/dos/go32v2/classes.pp create mode 100644 fcl/inc/classes.inc rename fcl/{classes.pp => inc/classesh.inc} (79%) create mode 100644 fcl/linux/classes.pp create mode 100644 fcl/os2/classes.pp create mode 100644 fcl/win32/classes.pp diff --git a/fcl/dos/go32v2/classes.pp b/fcl/dos/go32v2/classes.pp new file mode 100644 index 0000000000..fa9edf83e8 --- /dev/null +++ b/fcl/dos/go32v2/classes.pp @@ -0,0 +1,101 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ exceptions aren't implemented yet in the compiler } +{$define NoExceptions} + +{ determine the type of the resource/form file } +{$define Win16Res} +unit Classes; + +interface + +uses + objpas,dos; + +{$i classesh.inc} + +implementation + +{$i classes.inc} + +{****************************************************************************} +{* THandleStream *} +{****************************************************************************} + + procedure THandleStream.SetSize(NewSize: Longint); + + begin + inherited SetSize(NewSize); + {!!!!!} + end; + + constructor THandleStream.Create(AHandle: Integer); + + begin + inherited Create; + FHandle:=AHandle; + end; + + function THandleStream.Read(var Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Write(const Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Seek(Offset: Longint; Origin: Word): Longint; + + var + regs : registers; + + begin + regs.ebx:=FHandle; + regs.ecx:=pos shr 16; + regs.edx:=Offset and $ffff; + regs.eax:=$4200+Origin; + Intr($21,regs); + if (regs.realflags and carryflag) <> 0 then + InOutRes:=lo(regs.realeax); + end; + +{****************************************************************************} +{* TFileStream *} +{****************************************************************************} + + constructor TFileStream.Create(const FileName: string; Mode: Word); + + begin + {!!!!!} + end; + + destructor TFileStream.Destroy; + + begin + {!!!!!} + end; + +end. + +{ + $Log$ + Revision 1.1 1998-05-04 12:16:01 florian + + Initial revisions after making a new directory structure + +} \ No newline at end of file diff --git a/fcl/inc/classes.inc b/fcl/inc/classes.inc new file mode 100644 index 0000000000..b91669f8c1 --- /dev/null +++ b/fcl/inc/classes.inc @@ -0,0 +1,515 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{****************************************************************************} +{* TBits *} +{****************************************************************************} + + procedure TBits.Error; + + begin +{$ifdef NoExceptions} + ; +{$else} + Raise(EBitsError); +{$endif} + end; + + procedure TBits.SetSize(Value: Integer); + + var + hp : pointer; + cvalue,csize : Integer; + + begin + { ajust value to n*8 } + cvalue:=Value; + if cvalue mod 8<>0 then + cvalue:=cvalue+(8-(cvalue mod 8)); + + { store pointer to release it later } + hp:=FBits; + + { ajust size to n*8 } + csize:=FSize; + if csize mod 8<>0 then + csize:=csize+(8-(csize mod 8)); + + if FSize>0 then + begin + { get new memory } + GetMem(FBits,cvalue div 8); + { clear the whole array } + FillChar(FBits^,cvalue div 8,0); + { copy old data } + Move(hp^,FBits^,csize div 8); + end + else + FBits:=nil; + + if assigned(hp) then + FreeMem(hp,csize div 8); + + FSize:=Value; + end; + + procedure TBits.SetBit(Index: Integer; Value: Boolean); + + type + pbyte = ^byte; + + begin + if (Index>=FSize) or (Index<0) then + Error + else + begin + if Value then + pbyte(FBits)[Index div 8]:=pbyte(FBits)[Index div 8] or + (1 shl (Index mod 8)) + else + pbyte(FBits)[Index div 8]:=pbyte(FBits)[Index div 8] and + not(1 shl (Index mod 8)); + end; + end; + + function TBits.GetBit(Index: Integer): Boolean; + + type + pbyte = ^byte; + + begin + if (Index>=FSize) or (Index<0) then + Error + else + GetBit:=(pbyte(FBits)[Index div 8] and (1 shl (Index mod 8)))<>0; + end; + + destructor TBits.Destroy; + + var + csize : Integer; + + begin + { ajust size to n*8 } + csize:=FSize; + if csize mod 8<>0 then + csize:=csize+(8-(csize mod 8)); + if assigned(FBits) then + FreeMem(FBits,csize); + inherited Destroy; + end; + + function TBits.OpenBit: Integer; + + type + pbyte = ^byte; + + var + i : Integer; + + begin + for i:=0 to FSize-1 do + if (pbyte(FBits)[i div 8] and (1 shl (i mod 8)))=0 then + begin + OpenBit:=i; + exit; + end; + SetSize(FSize+1); + OpenBit:=FSize-1; + end; + +{****************************************************************************} +{* TStream *} +{****************************************************************************} + + function TStream.GetPosition: Longint; + + begin + GetPosition:=Seek(0,soFromCurrent); + end; + + procedure TStream.SetPosition(Pos: Longint); + + begin + Seek(soFromBeginning,Pos); + end; + + function TStream.GetSize: Longint; + + var + p : longint; + + begin + p:=GetPosition; + GetSize:=Seek(soFromEnd,0); + Seek(soFromBeginning,p); + end; + + procedure TStream.SetSize(NewSize: Longint); + + begin + SetPosition(NewSize); + end; + + procedure TStream.ReadBuffer(var Buffer; Count: Longint); + + begin + if Read(Buffer,Count)0 do + begin + if (Count>sizeof(buffer)) then + i:=sizeof(Buffer) + else + i:=Count; + i:=Source.Read(buffer,i); + i:=Write(buffer,i); + dec(count,i); + CopyFrom:=CopyFrom+i; + if i=0 then + exit; + end; + end; + + function TStream.ReadComponent(Instance: TComponent): TComponent; + + var + Reader : TReader; + + begin + Reader.Create(Self,1024); + if assigned(Instance) then + ReadComponent:=Reader.ReadRootComponent(Instance) + else + begin + {!!!!!} + end; + Reader.Destroy; + end; + + function TStream.ReadComponentRes(Instance: TComponent): TComponent; + + begin + {!!!!!} + end; + + procedure TStream.WriteComponent(Instance: TComponent); + + var + Writer : TWriter; + + begin + Writer.Create(Self,1024); + Writer.WriteRootComponent(Instance); + Writer.Destroy; + end; + + procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent); + + var + startpos,s : longint; + + begin +(* +{$ifdef Win16Res} + { Numeric resource type } + WriteByte($ff); + { Application defined data } + WriteWord($0a); + { write the name as asciiz } + WriteData(ResName[1],length(ResName)); + WriteByte(0); + { Movable, Pure and Discardable } + WriteWord($1030); + { size isn't known yet } + WriteDWord(0); + startpos:=GetPosition; + WriteComponent(Instance); + { calculate size } + s:=GetPosition-startpos; + { back patch size } + SetPosition(startpos-4); + WriteDWord(s); +{$endif Win16Res} +*) + end; + + procedure TStream.WriteDescendent(Instance, Ancestor: TComponent); + + begin + {!!!!!} + end; + + procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent); + + begin + {!!!!!} + end; + + procedure TStream.ReadResHeader; + + begin +{$ifdef Win16Res} + try + { application specific resource ? } + if ReadByte<>$ff then + raise EInvalidImage; + if ReadWord<>$000a then + raise EInvalidImage; + { read name } + while ReadByte<>0 do + ; + { check the access specifier } + if ReadWord<>$1030 then + raise EInvalidImage; + { ignore the size } + ReadDWord; + except +{///// + on EInvalidImage do + raise; + else + raise(EInvalidImage); +} + end; +{$endif Win16Res} + end; + + function TStream.ReadByte : Byte; + + var + b : Byte; + + begin + ReadBuffer(b,1); + ReadByte:=b; + end; + + function TStream.ReadWord : Word; + + var + w : Word; + + begin + ReadBuffer(w,2); + ReadWord:=w; + end; + + function TStream.ReadDWord : Cardinal; + + var + d : Cardinal; + + begin + ReadBuffer(d,4); + ReadDWord:=d; + end; + + procedure TStream.WriteByte(b : Byte); + + begin + WriteBuffer(b,1); + end; + + procedure TStream.WriteWord(w : Word); + + begin + WriteBuffer(w,2); + end; + + procedure TStream.WriteDWord(d : Cardinal); + + begin + WriteBuffer(d,4); + end; + +{****************************************************************************} +{* TList *} +{****************************************************************************} + +{ TList = class(TObject) + private + FList: PPointerList; + FCount: Integer; + FCapacity: Integer; +} + +function TList.Get(Index: Integer): Pointer; + +begin +end; + + + +procedure TList.Grow; + +begin +end; + + + +procedure TList.Put(Index: Integer; Item: Pointer); + +begin +end; + + + +procedure TList.SetCapacity(NewCapacity: Integer); + +begin +end; + + + +procedure TList.SetCount(NewCount: Integer); + +begin +end; + + + +destructor TList.Destroy; + +begin + Clear; + inherited Destroy; +end; + + +Function TList.Add(Item: Pointer): Integer; + +begin + Self.Insert (Count,Item); +end; + + + +Procedure TList.Clear; + +begin +end; + + + +Procedure TList.Delete(Index: Integer); + + + +begin +end; + + +class procedure Error(const Msg: string; Data: Integer); + +begin +end; + +procedure TList.Exchange(Index1, Index2: Integer); + + +begin +end; + + + +function TList.Expand: TList; + + +begin +end; + + +function TList.First: Pointer; + +begin +end; + + + +function TList.IndexOf(Item: Pointer): Integer; + +begin +end; + + + +procedure TList.Insert(Index: Integer; Item: Pointer); + +begin +end; + + + +function TList.Last: Pointer; + +begin +end; + + +procedure TList.Move(CurIndex, NewIndex: Integer); + +begin +end; + + +function TList.Remove(Item: Pointer): Integer; + +begin +end; + + + +procedure TList.Pack; +begin +end; + + + +procedure TList.Sort(Compare: TListSortCompare); + +begin +end; + +{ + $Log$ + Revision 1.1 1998-05-04 12:16:01 florian + + Initial revisions after making a new directory structure + +} \ No newline at end of file diff --git a/fcl/classes.pp b/fcl/inc/classesh.inc similarity index 79% rename from fcl/classes.pp rename to fcl/inc/classesh.inc index d0d2c021f4..b1b11d5cba 100644 --- a/fcl/classes.pp +++ b/fcl/inc/classesh.inc @@ -1,7 +1,7 @@ { $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1998 by the Free Pascal development team + This file is part of the Free Component Library (FCL) + Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -11,18 +11,6 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} -{ exceptions aren't implemented yet } -{$define NoExceptions} - -{ determine the type of the resource/form file } -{$define Win16Res} -unit Classes; - -interface - -uses - objpas; - type { extra types to compile with FPC } Exception = class(TObject); @@ -1053,527 +1041,9 @@ procedure ObjectTextToResource(Input, Output: TStream); function LineStart(Buffer, BufPos: PChar): PChar; -implementation - -{****************************************************************************} -{* TBits *} -{****************************************************************************} - - procedure TBits.Error; - - begin -{$ifdef NoExceptions} - ; -{$else} - Raise(EBitsError); -{$endif} - end; - - procedure TBits.SetSize(Value: Integer); - - var - hp : pointer; - cvalue,csize : Integer; - - begin - { ajust value to n*8 } - cvalue:=Value; - if cvalue mod 8<>0 then - cvalue:=cvalue+(8-(cvalue mod 8)); - - { store pointer to release it later } - hp:=FBits; - - { ajust size to n*8 } - csize:=FSize; - if csize mod 8<>0 then - csize:=csize+(8-(csize mod 8)); - - if FSize>0 then - begin - { get new memory } - GetMem(FBits,cvalue div 8); - { clear the whole array } - FillChar(FBits^,cvalue div 8,0); - { copy old data } - Move(hp^,FBits^,csize div 8); - end - else - FBits:=nil; - - if assigned(hp) then - FreeMem(hp,csize div 8); - - FSize:=Value; - end; - - procedure TBits.SetBit(Index: Integer; Value: Boolean); - - type - pbyte = ^byte; - - begin - if (Index>=FSize) or (Index<0) then - Error - else - begin - if Value then - pbyte(FBits)[Index div 8]:=pbyte(FBits)[Index div 8] or - (1 shl (Index mod 8)) - else - pbyte(FBits)[Index div 8]:=pbyte(FBits)[Index div 8] and - not(1 shl (Index mod 8)); - end; - end; - - function TBits.GetBit(Index: Integer): Boolean; - - type - pbyte = ^byte; - - begin - if (Index>=FSize) or (Index<0) then - Error - else - GetBit:=(pbyte(FBits)[Index div 8] and (1 shl (Index mod 8)))<>0; - end; - - destructor TBits.Destroy; - - var - csize : Integer; - - begin - { ajust size to n*8 } - csize:=FSize; - if csize mod 8<>0 then - csize:=csize+(8-(csize mod 8)); - if assigned(FBits) then - FreeMem(FBits,csize); - inherited Destroy; - end; - - function TBits.OpenBit: Integer; - - type - pbyte = ^byte; - - var - i : Integer; - - begin - for i:=0 to FSize-1 do - if (pbyte(FBits)[i div 8] and (1 shl (i mod 8)))=0 then - begin - OpenBit:=i; - exit; - end; - SetSize(FSize+1); - OpenBit:=FSize-1; - end; - -{****************************************************************************} -{* TStream *} -{****************************************************************************} - - function TStream.GetPosition: Longint; - - begin - GetPosition:=Seek(0,soFromCurrent); - end; - - procedure TStream.SetPosition(Pos: Longint); - - begin - Seek(soFromBeginning,Pos); - end; - - function TStream.GetSize: Longint; - - var - p : longint; - - begin - p:=GetPosition; - GetSize:=Seek(soFromEnd,0); - Seek(soFromBeginning,p); - end; - - procedure TStream.SetSize(NewSize: Longint); - - begin - SetPosition(NewSize); - end; - - procedure TStream.ReadBuffer(var Buffer; Count: Longint); - - begin - if Read(Buffer,Count)0 do - begin - if (Count>sizeof(buffer)) then - i:=sizeof(Buffer) - else - i:=Count; - i:=Source.Read(buffer,i); - i:=Write(buffer,i); - dec(count,i); - CopyFrom:=CopyFrom+i; - if i=0 then - exit; - end; - end; - - function TStream.ReadComponent(Instance: TComponent): TComponent; - - var - Reader : TReader; - - begin - Reader.Create(Self,1024); - if assigned(Instance) then - ReadComponent:=Reader.ReadRootComponent(Instance) - else - begin - {!!!!!} - end; - Reader.Destroy; - end; - - function TStream.ReadComponentRes(Instance: TComponent): TComponent; - - begin - {!!!!!} - end; - - procedure TStream.WriteComponent(Instance: TComponent); - - var - Writer : TWriter; - - begin - Writer.Create(Self,1024); - Writer.WriteRootComponent(Instance); - Writer.Destroy; - end; - - procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent); - - var - startpos,s : longint; - - begin -(* -{$ifdef Win16Res} - { Numeric resource type } - WriteByte($ff); - { Application defined data } - WriteWord($0a); - { write the name as asciiz } - WriteData(ResName[1],length(ResName)); - WriteByte(0); - { Movable, Pure and Discardable } - WriteWord($1030); - { size isn't known yet } - WriteDWord(0); - startpos:=GetPosition; - WriteComponent(Instance); - { calculate size } - s:=GetPosition-startpos; - { back patch size } - SetPosition(startpos-4); - WriteDWord(s); -{$endif Win16Res} -*) - end; - - procedure TStream.WriteDescendent(Instance, Ancestor: TComponent); - - begin - {!!!!!} - end; - - procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent); - - begin - {!!!!!} - end; - - procedure TStream.ReadResHeader; - - begin -{$ifdef Win16Res} - try - { application specific resource ? } - if ReadByte<>$ff then - raise EInvalidImage; - if ReadWord<>$000a then - raise EInvalidImage; - { read name } - while ReadByte<>0 do - ; - { check the access specifier } - if ReadWord<>$1030 then - raise EInvalidImage; - { ignore the size } - ReadDWord; - except -{///// - on EInvalidImage do - raise; - else - raise(EInvalidImage); -} - end; -{$endif Win16Res} - end; - - function TStream.ReadByte : Byte; - - var - b : Byte; - - begin - ReadBuffer(b,1); - ReadByte:=b; - end; - - function TStream.ReadWord : Word; - - var - w : Word; - - begin - ReadBuffer(w,2); - ReadWord:=w; - end; - - function TStream.ReadDWord : Cardinal; - - var - d : Cardinal; - - begin - ReadBuffer(d,4); - ReadDWord:=d; - end; - - procedure TStream.WriteByte(b : Byte); - - begin - WriteBuffer(b,1); - end; - - procedure TStream.WriteWord(w : Word); - - begin - WriteBuffer(w,2); - end; - - procedure TStream.WriteDWord(d : Cardinal); - - begin - WriteBuffer(d,4); - end; - -{****************************************************************************} -{* TList *} -{****************************************************************************} - -{ TList = class(TObject) - private - FList: PPointerList; - FCount: Integer; - FCapacity: Integer; -} - -function TList.Get(Index: Integer): Pointer; - -begin -end; - - - -procedure TList.Grow; - -begin -end; - - - -procedure TList.Put(Index: Integer; Item: Pointer); - -begin -end; - - - -procedure TList.SetCapacity(NewCapacity: Integer); - -begin -end; - - - -procedure TList.SetCount(NewCount: Integer); - -begin -end; - - - -destructor TList.Destroy; - -begin - Clear; - inherited Destroy; -end; - - -Function TList.Add(Item: Pointer): Integer; - -begin - Self.Insert (Count,Item); -end; - - - -Procedure TList.Clear; - -begin -end; - - - -Procedure TList.Delete(Index: Integer); - - - -begin -end; - - -class procedure Error(const Msg: string; Data: Integer); - -begin -end; - -procedure TList.Exchange(Index1, Index2: Integer); - - -begin -end; - - - -function TList.Expand: TList; - - -begin -end; - - -function TList.First: Pointer; - -begin -end; - - - -function TList.IndexOf(Item: Pointer): Integer; - -begin -end; - - - -procedure TList.Insert(Index: Integer; Item: Pointer); - -begin -end; - - - -function TList.Last: Pointer; - -begin -end; - - -procedure TList.Move(CurIndex, NewIndex: Integer); - -begin -end; - - -function TList.Remove(Item: Pointer): Integer; - -begin -end; - - - -procedure TList.Pack; -begin -end; - - - -procedure TList.Sort(Compare: TListSortCompare); - -begin -end; - -end. { $Log$ - Revision 1.8 1998-05-04 11:20:13 florian - + Write* and Read* methods to TStream added - * small problems solved + Revision 1.1 1998-05-04 12:16:01 florian + + Initial revisions after making a new directory structure - Revision 1.7 1998/05/04 09:39:51 michael - + Started implementation of TList - - Revision 1.6 1998/05/01 22:17:19 florian - + TBits implemented - + TStream partial implemented - - 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 - - Revision 1.3 1998/04/27 12:55:57 florian - + uses objpas added - - Revision 1.2 1998/04/27 09:09:49 michael - + Added log at the end - -} +} \ No newline at end of file diff --git a/fcl/linux/classes.pp b/fcl/linux/classes.pp new file mode 100644 index 0000000000..fa9edf83e8 --- /dev/null +++ b/fcl/linux/classes.pp @@ -0,0 +1,101 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ exceptions aren't implemented yet in the compiler } +{$define NoExceptions} + +{ determine the type of the resource/form file } +{$define Win16Res} +unit Classes; + +interface + +uses + objpas,dos; + +{$i classesh.inc} + +implementation + +{$i classes.inc} + +{****************************************************************************} +{* THandleStream *} +{****************************************************************************} + + procedure THandleStream.SetSize(NewSize: Longint); + + begin + inherited SetSize(NewSize); + {!!!!!} + end; + + constructor THandleStream.Create(AHandle: Integer); + + begin + inherited Create; + FHandle:=AHandle; + end; + + function THandleStream.Read(var Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Write(const Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Seek(Offset: Longint; Origin: Word): Longint; + + var + regs : registers; + + begin + regs.ebx:=FHandle; + regs.ecx:=pos shr 16; + regs.edx:=Offset and $ffff; + regs.eax:=$4200+Origin; + Intr($21,regs); + if (regs.realflags and carryflag) <> 0 then + InOutRes:=lo(regs.realeax); + end; + +{****************************************************************************} +{* TFileStream *} +{****************************************************************************} + + constructor TFileStream.Create(const FileName: string; Mode: Word); + + begin + {!!!!!} + end; + + destructor TFileStream.Destroy; + + begin + {!!!!!} + end; + +end. + +{ + $Log$ + Revision 1.1 1998-05-04 12:16:01 florian + + Initial revisions after making a new directory structure + +} \ No newline at end of file diff --git a/fcl/os2/classes.pp b/fcl/os2/classes.pp new file mode 100644 index 0000000000..fa9edf83e8 --- /dev/null +++ b/fcl/os2/classes.pp @@ -0,0 +1,101 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ exceptions aren't implemented yet in the compiler } +{$define NoExceptions} + +{ determine the type of the resource/form file } +{$define Win16Res} +unit Classes; + +interface + +uses + objpas,dos; + +{$i classesh.inc} + +implementation + +{$i classes.inc} + +{****************************************************************************} +{* THandleStream *} +{****************************************************************************} + + procedure THandleStream.SetSize(NewSize: Longint); + + begin + inherited SetSize(NewSize); + {!!!!!} + end; + + constructor THandleStream.Create(AHandle: Integer); + + begin + inherited Create; + FHandle:=AHandle; + end; + + function THandleStream.Read(var Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Write(const Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Seek(Offset: Longint; Origin: Word): Longint; + + var + regs : registers; + + begin + regs.ebx:=FHandle; + regs.ecx:=pos shr 16; + regs.edx:=Offset and $ffff; + regs.eax:=$4200+Origin; + Intr($21,regs); + if (regs.realflags and carryflag) <> 0 then + InOutRes:=lo(regs.realeax); + end; + +{****************************************************************************} +{* TFileStream *} +{****************************************************************************} + + constructor TFileStream.Create(const FileName: string; Mode: Word); + + begin + {!!!!!} + end; + + destructor TFileStream.Destroy; + + begin + {!!!!!} + end; + +end. + +{ + $Log$ + Revision 1.1 1998-05-04 12:16:01 florian + + Initial revisions after making a new directory structure + +} \ No newline at end of file diff --git a/fcl/win32/classes.pp b/fcl/win32/classes.pp new file mode 100644 index 0000000000..fa9edf83e8 --- /dev/null +++ b/fcl/win32/classes.pp @@ -0,0 +1,101 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{ exceptions aren't implemented yet in the compiler } +{$define NoExceptions} + +{ determine the type of the resource/form file } +{$define Win16Res} +unit Classes; + +interface + +uses + objpas,dos; + +{$i classesh.inc} + +implementation + +{$i classes.inc} + +{****************************************************************************} +{* THandleStream *} +{****************************************************************************} + + procedure THandleStream.SetSize(NewSize: Longint); + + begin + inherited SetSize(NewSize); + {!!!!!} + end; + + constructor THandleStream.Create(AHandle: Integer); + + begin + inherited Create; + FHandle:=AHandle; + end; + + function THandleStream.Read(var Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Write(const Buffer; Count: Longint): Longint; + + begin + {!!!!!} + end; + + function THandleStream.Seek(Offset: Longint; Origin: Word): Longint; + + var + regs : registers; + + begin + regs.ebx:=FHandle; + regs.ecx:=pos shr 16; + regs.edx:=Offset and $ffff; + regs.eax:=$4200+Origin; + Intr($21,regs); + if (regs.realflags and carryflag) <> 0 then + InOutRes:=lo(regs.realeax); + end; + +{****************************************************************************} +{* TFileStream *} +{****************************************************************************} + + constructor TFileStream.Create(const FileName: string; Mode: Word); + + begin + {!!!!!} + end; + + destructor TFileStream.Destroy; + + begin + {!!!!!} + end; + +end. + +{ + $Log$ + Revision 1.1 1998-05-04 12:16:01 florian + + Initial revisions after making a new directory structure + +} \ No newline at end of file