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

+ Initial revisions after making a new directory structure

Browse Source
This commit is contained in:
florian 1998-05-04 12:16:01 +00:00
parent f0daa16b41
commit 4c98ff802b
6 changed files with 924 additions and 535 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
fcl/dos/go32v2/classes.pp Normal file
View File

@ -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
}

515
fcl/inc/classes.inc Normal file
View File

@ -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)<Count then
{$ifdef NoExceptions}
;
{$else}
Raise(EReadError);
{$endif}
end;
procedure TStream.WriteBuffer(const Buffer; Count: Longint);
begin
if Write(Buffer,Count)<Count then
{$ifdef NoExceptions}
;
{$else}
Raise(EWriteError);
{$endif}
end;
function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;
var
i : longint;
buffer : array[0..1023] of byte;
begin
CopyFrom:=0;
while 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
}

538
fcl/classes.pp → fcl/inc/classesh.inc
View File

@ -1,7 +1,7 @@
{ {
$Id$ $Id$
This file is part of the Free Pascal run time library. This file is part of the Free Component Library (FCL)
Copyright (c) 1998 by the Free Pascal development team Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -11,18 +11,6 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 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 type
{ extra types to compile with FPC } { extra types to compile with FPC }
Exception = class(TObject); Exception = class(TObject);
@ -1053,527 +1041,9 @@ procedure ObjectTextToResource(Input, Output: TStream);
function LineStart(Buffer, BufPos: PChar): PChar; 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)<Count then
{$ifdef NoExceptions}
;
{$else}
Raise(EReadError);
{$endif}
end;
procedure TStream.WriteBuffer(const Buffer; Count: Longint);
begin
if Write(Buffer,Count)<Count then
{$ifdef NoExceptions}
;
{$else}
Raise(EWriteError);
{$endif}
end;
function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;
var
i : longint;
buffer : array[0..1023] of byte;
begin
CopyFrom:=0;
while 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$ $Log$
Revision 1.8 1998-05-04 11:20:13 florian Revision 1.1 1998-05-04 12:16:01 florian
+ Write* and Read* methods to TStream added + Initial revisions after making a new directory structure
* small problems solved
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
} }

101
fcl/linux/classes.pp Normal file
View File

@ -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
}

101
fcl/os2/classes.pp Normal file
View File

@ -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
}

101
fcl/win32/classes.pp Normal file
View File

@ -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
}