freepascal.compiler/rtl/objpas/types.pp

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 2002 by Florian Klaempfl,
    member of the Free Pascal development team.

    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.

 **********************************************************************}
{$MODE OBJFPC}
unit types;

  interface

{$ifdef Win32}
    uses
       Windows;
{$endif Win32}

{$ifndef ver1_0}
const
  RT_RCDATA = PChar(10);

type
  DWORD = LongWord;

  PLongint = System.PLongint;
  PInteger = System.PInteger;
  PSmallInt = System.PSmallInt;
  PDouble = System.PDouble;
  PByte = System.PByte;

  TIntegerDynArray = array of Integer;
  TCardinalDynArray = array of Cardinal;
  TWordDynArray = array of Word;
  TSmallIntDynArray = array of SmallInt;
  TByteDynArray = array of Byte;
  TShortIntDynArray = array of ShortInt;
  TInt64DynArray = array of Int64;
  TQWordDynArray = array of QWord;
  TLongWordDynArray = array of LongWord;
  TSingleDynArray = array of Single;
  TDoubleDynArray = array of Double;
  TBooleanDynArray = array of Boolean;
  TStringDynArray = array of AnsiString;
  TWideStringDynArray   = array of WideString;

{$ifdef Win32}
  TPoint = Windows.TPoint;
{$else}
  TPoint = packed record
    X : Longint;
    Y : Longint;
  end;
{$endif}
  PPoint = ^TPoint;
  tagPOINT = TPoint;

{$ifdef Win32}
  TRect = Windows.TRect;
{$else}
  TRect = packed record
    case Integer of
      0: (Left,Top,Right,Bottom : Longint);
      1: (TopLeft,BottomRight : TPoint);
    end;
{$endif}
  PRect = ^TRect;

  TSize = packed record
     cx : Longint;
     cy : Longint;
  end;
  PSize = ^TSize;
  tagSIZE = TSize;
  SIZE = TSize;

  TSmallPoint = packed record
     x : SmallInt;
     y : SmallInt;
  end;
  PSmallPoint = ^TSmallPoint;

type
  TOleChar = WideChar;
  POleStr = PWideChar;
  PPOleStr = ^POleStr;

{$ifndef win32}
const

  STGTY_STORAGE   = 1;
  STGTY_STREAM    = 2;
  STGTY_LOCKBYTES = 3;
  STGTY_PROPERTY  = 4;

  STREAM_SEEK_SET = 0;
  STREAM_SEEK_CUR = 1;
  STREAM_SEEK_END = 2;

  LOCK_WRITE     = 1;
  LOCK_EXCLUSIVE = 2;
  LOCK_ONLYONCE  = 4;

  E_FAIL = HRESULT($80004005);
  
  STG_E_INVALIDFUNCTION       = HRESULT($80030001);
  STG_E_FILENOTFOUND          = HRESULT($80030002);
  STG_E_PATHNOTFOUND          = HRESULT($80030003);
  STG_E_TOOMANYOPENFILES      = HRESULT($80030004);
  STG_E_ACCESSDENIED          = HRESULT($80030005);
  STG_E_INVALIDHANDLE         = HRESULT($80030006);
  STG_E_INSUFFICIENTMEMORY    = HRESULT($80030008);
  STG_E_INVALIDPOINTER        = HRESULT($80030009);
  STG_E_NOMOREFILES           = HRESULT($80030012);
  STG_E_DISKISWRITEPROTECTED  = HRESULT($80030013);
  STG_E_SEEKERROR             = HRESULT($80030019);
  STG_E_WRITEFAULT            = HRESULT($8003001D);
  STG_E_READFAULT             = HRESULT($8003001E);
  STG_E_SHAREVIOLATION        = HRESULT($80030020);
  STG_E_LOCKVIOLATION         = HRESULT($80030021);
  STG_E_FILEALREADYEXISTS     = HRESULT($80030050);
  STG_E_INVALIDPARAMETER      = HRESULT($80030057);
  STG_E_MEDIUMFULL            = HRESULT($80030070);
  STG_E_PROPSETMISMATCHED     = HRESULT($800300F0);
  STG_E_ABNORMALAPIEXIT       = HRESULT($800300FA);
  STG_E_INVALIDHEADER         = HRESULT($800300FB);
  STG_E_INVALIDNAME           = HRESULT($800300FC);
  STG_E_UNKNOWN               = HRESULT($800300FD);
  STG_E_UNIMPLEMENTEDFUNCTION = HRESULT($800300FE);
  STG_E_INVALIDFLAG           = HRESULT($800300FF);
  STG_E_INUSE                 = HRESULT($80030100);
  STG_E_NOTCURRENT            = HRESULT($80030101);
  STG_E_REVERTED              = HRESULT($80030102);
  STG_E_CANTSAVE              = HRESULT($80030103);
  STG_E_OLDFORMAT             = HRESULT($80030104);
  STG_E_OLDDLL                = HRESULT($80030105);
  STG_E_SHAREREQUIRED         = HRESULT($80030106);
  STG_E_EXTANTMARSHALLINGS    = HRESULT($80030108);
  STG_E_DOCFILECORRUPT        = HRESULT($80030109);
  STG_E_BADBASEADDRESS        = HRESULT($80030110);
  STG_E_INCOMPLETE            = HRESULT($80030201);
  STG_E_TERMINATED            = HRESULT($80030202);

  STG_S_CONVERTED             = $00030200;
  STG_S_BLOCK                 = $00030201;
  STG_S_RETRYNOW              = $00030202;
  STG_S_MONITORING            = $00030203;

  GUID_NULL: TGUID  = '{00000000-0000-0000-0000-000000000000}';

type
  PCLSID = PGUID;
  TCLSID = TGUID;

  LARGE_INT = Int64;
  Largeint = LARGE_INT;
  PDWord = ^DWord;

  PDisplay = Pointer;
  PEvent = Pointer;

  TXrmOptionDescRec = record
  end;
  XrmOptionDescRec = TXrmOptionDescRec;
  PXrmOptionDescRec = ^TXrmOptionDescRec;

  Widget = Pointer;
  WidgetClass = Pointer;
  ArgList = Pointer;
  Region = Pointer;

  _FILETIME = packed record
     dwLowDateTime : DWORD;
     dwHighDateTime : DWORD;
  end;
  TFileTime = _FILETIME;
  FILETIME = _FILETIME;
  PFileTime = ^TFileTime;

  tagSTATSTG = packed record
     pwcsName : POleStr;
     dwType : Longint;
     cbSize : Largeint;
     mtime : TFileTime;
     ctime : TFileTime;
     atime : TFileTime;
     grfMode : Longint;
     grfLocksSupported : Longint;
     clsid : TCLSID;
     grfStateBits : Longint;
     reserved : Longint;
  end;
  TStatStg = tagSTATSTG;
  STATSTG = TStatStg;
  PStatStg = ^TStatStg;

{$ifdef HASINTF}
  IClassFactory = Interface(IUnknown) ['{00000001-0000-0000-C000-000000000046}']
     Function CreateInstance(Const unkOuter : IUnknown;Const riid : TGUID;Out vObject) : HResult;StdCall;
     Function LockServer(fLock : LongBool) : HResult;StdCall;
  End;

  ISequentialStream = interface(IUnknown) ['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
     function Read(pv : Pointer;cb : DWord;pcbRead : PDWord) : HRESULT;stdcall;
     function Write(pv : Pointer;cb : DWord;pcbWritten : PDWord) : HRESULT;stdcall;
  end;

  IStream = interface(ISequentialStream) ['{0000000C-0000-0000-C000-000000000046}']
     function Seek(dlibMove : LargeInt; dwOrigin : Longint;
       out libNewPosition : LargeInt) : HResult;stdcall;
     function SetSize(libNewSize : LargeInt) : HRESULT;stdcall;
     function CopyTo(stm: IStream;cb : LargeInt;out cbRead : LargeInt;
       out cbWritten : LargeInt) : HRESULT;stdcall;
     function Commit(grfCommitFlags : Longint) : HRESULT;stdcall;
     function Revert : HRESULT;stdcall;
     function LockRegion(libOffset : LargeInt;cb : LargeInt;
       dwLockType : Longint) : HRESULT;stdcall;
     function UnlockRegion(libOffset : LargeInt;cb : LargeInt;
       dwLockType : Longint) : HRESULT;stdcall;
     Function Stat(out statstg : TStatStg;grfStatFlag : Longint) : HRESULT;stdcall;
     function Clone(out stm : IStream) : HRESULT;stdcall;
  end;
{$endif HASINTF}
{$endif win32}

function EqualRect(const r1,r2 : TRect) : Boolean;
function Rect(Left,Top,Right,Bottom : Integer) : TRect;
function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect;
function Point(x,y : Integer) : TPoint;
function PtInRect(const Rect : TRect; const p : TPoint) : Boolean;
function IntersectRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
function UnionRect(var Rect : TRect; const R1,R2 : TRect) : Boolean;
function IsRectEmpty(const Rect : TRect) : Boolean;
function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
function CenterPoint(const Rect: TRect): TPoint;

{$endif ver1_0}

implementation

{$ifndef ver1_0}

function EqualRect(const r1,r2 : TRect) : Boolean;

begin
  EqualRect:=(r1.left=r2.left) and (r1.right=r2.right) and (r1.top=r2.top) and (r1.bottom=r2.bottom);
end;


function Rect(Left,Top,Right,Bottom : Integer) : TRect;

begin
  Rect.Left:=Left;
  Rect.Top:=Top;
  Rect.Right:=Right;
  Rect.Bottom:=Bottom;
end;


function Bounds(ALeft,ATop,AWidth,AHeight : Integer) : TRect;

begin
  Bounds.Left:=ALeft;
  Bounds.Top:=ATop;
  Bounds.Right:=ALeft+AWidth;
  Bounds.Bottom:=ATop+AHeight;
end;


function Point(x,y : Integer) : TPoint;

begin
  Point.x:=x;
  Point.y:=y;
end;

function PtInRect(const Rect : TRect;const p : TPoint) : Boolean;

begin
  PtInRect:=(p.y>=Rect.Top) and 
            (p.y<Rect.Bottom) and 
            (p.x>=Rect.Left) and 
            (p.x<Rect.Right);
end;


function IntersectRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;

begin
  Rect:=R1;
  with R2 do
    begin
    if Left>R1.Left then
      Rect.Left:=Left;
    if Top>R1.Top then
      Rect.Top:=Top;
    if Right<R1.Right then
      Rect.Right:=Right;
    if Bottom<R1.Bottom then
      Rect.Bottom:=Bottom;
    end;
  if IsRectEmpty(Rect) then
    begin
    FillChar(Rect,SizeOf(Rect),0);
    IntersectRect:=false;
    end
  else
    IntersectRect:=true;
end;

function UnionRect(var Rect : TRect;const R1,R2 : TRect) : Boolean;
begin
  Rect:=R1;
  with R2 do
    begin
    if Left<R1.Left then
      Rect.Left:=Left;
    if Top<R1.Top then
      Rect.Top:=Top;
    if Right>R1.Right then
      Rect.Right:=Right;
    if Bottom>R1.Bottom then
      Rect.Bottom:=Bottom;
    end;
  if IsRectEmpty(Rect) then
    begin
    FillChar(Rect,SizeOf(Rect),0);
    UnionRect:=false;
    end
  else
    UnionRect:=true;
end;

function IsRectEmpty(const Rect : TRect) : Boolean;
begin
  IsRectEmpty:=(Rect.Right<=Rect.Left) or (Rect.Bottom<=Rect.Top);
end;

function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
begin
  if assigned(@Rect) then
    begin
    with Rect do
      begin
      inc(Left,dx);
      inc(Top,dy);
      inc(Right,dx);
      inc(Bottom,dy);
      end;
    OffsetRect:=true;
    end
  else
    OffsetRect:=false;
end;

function CenterPoint(const Rect: TRect): TPoint;

begin
  With Rect do
    begin
    Result.X:=(Left+Right) div 2;
    Result.Y:=(Top+Bottom) div 2;
    end;
end;


{$endif ver1_0}

end.
{
  $Log$
  Revision 1.6  2004-01-10 19:00:20  michael
  + Compatibility checks and code reformatting

  Revision 1.5  2003/10/05 19:10:03  florian
    * fixed some delphi compatibilty issues

  Revision 1.4  2003/04/24 11:09:36  florian
    * check included, if the compiler supports interfaces

  Revision 1.3  2003/01/02 22:22:12  peter
    * reuse Windows types to fix incompatible parameters

  Revision 1.2  2002/07/27 07:28:10  florian
    * fixed errror on non win32 targets with 1.0.x when doing a make cycle

  Revision 1.1  2002/07/23 20:39:54  florian
    + types unit added
}