[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]

{
You could easily add a doubble precision to the object HugeMatrix in my unit
Huge, which handles arrays larger than 64 KB.
From: perivar@ibg.uit.no (Per Ivar Steinsund)
}

Unit Huge;

(***********************************************)
(* Unit for making dynamic arrays and matrix.  *)
(* The elementsize has a limit of 64 kB, but   *)
(* the total size of each array/matrix is only *)
(* limited by available memory.                *)
(*                                             *)
(* Per Ivar Steinsund (1994)                   *)
(*                                             *)
(* Example of use:                             *)
(*                                             *)
(* var J:longint;                              *)
(*     Arr:PHugeRealArray;                     *)
(*                                             *)
(* begin                                       *)
(*    Arr:=new(PHugeRealArray,Init(0,200000,   *)
(*             SizeOf(Real),true));            *)
(*    if Arr^.Data<>nil then                   *)
(*       for J:=0 to 200000 do Arr^.I(J)^:=J/5;*)
(*    Arr^.Done;                               *)
(* end;                                        *)
(*                                             *)
(***********************************************)

interface

uses  Objects,WinAPI,OMemory,WinTypes;

Const
    SegSize=$FFFF;

Type
    Adr=record
       Off,Seg:Word;
    end;

    PHugeArray=^THugeArray;
    THugeArray=Object(TObject)
       Data:Pointer;
       MinX,MaxX:LongInt;
       ElementSize,ElementsPerSeg:LongInt;
       constructor Init(Min,Max:LongInt; Size:Word; Message:boolean);
       function ChangeSize(Min,Max:LongInt; Message:boolean):boolean;
       function I(X:LongInt):Pointer;
       destructor done; virtual;
       procedure GrabMem(var NewData:Pointer; Range:LongInt;
Change,Message:boolean);
       function GetPtr(Pos:LongInt):Pointer;
    end;

    PReal=^Real;

    PHugeRealArray=^THugeRealArray;
    THugeRealArray=Object(THugeArray)
       function I(X:LongInt):PReal;
    end;

    PHugeMatrix=^THugeMatrix;
    THugeMatrix=Object(THugeArray)
       MinY,MaxY,RangeY:LongInt;
       constructor Init(Min1,Max1,Min2,Max2:LongInt; Size:Word;
Message:boolean);
       function ChangeSize(Min1,Max1,Min2,Max2:LongInt;
Message:boolean):boolean;
       function I(X,Y:LongInt):Pointer;
    end;

    PHugeWordMatrix=^THugeWordMatrix;
    THugeWordMatrix=Object(THugeMatrix)
       function I(X,Y:LongInt):PWord;
    end;

implementation

    constructor THugeArray.Init(Min,Max:LongInt; Size:Word; Message:boolean);

    begin
       MinX:=Min;
       MaxX:=Max;
       ElementSize:=Size;
       GrabMem(Data,MaxX-MinX+1,false,Message);
    end;

    destructor THugeArray.done;

    begin
       GlobalFreePtr(Data);
    end;

    function THugeArray.I(X:LongInt):Pointer;

    begin
       I:=GetPtr(X-MinX);
{$IFOPT R+}
       if (X<MinX) or (X>MaxX) then
          if id_No=MessageBox(0,'Error in huge array, continue?','Index out of
range!',
                              mb_YesNo or mb_IconQuestion) then
          begin
             Done;
             Halt;
          end;
{$ENDIF}
    end;

    function THugeArray.ChangeSize(Min,Max:LongInt; Message:boolean):boolean;

    var NewData:Pointer;

    begin
       MinX:=Min;
       MaxX:=Max;
       GrabMem(NewData,MaxX-MinX+1,true,Message);
       if NewData<>nil then
       begin
          ChangeSize:=true;
          Data:=NewData;
       end
       else ChangeSize:=false;
    end;

    procedure THugeArray.GrabMem(var NewData:Pointer; Range:LongInt;
Change,Message:boolean);

    var MemSize:LongInt;

    begin
       MemSize:=Range*ElementSize;
       if not Change then ElementsPerSeg:=SegSize div ElementSize;
       if (MemSize>SegSize) and (SegSize mod ElementSize<>0) then
          MemSize:=(Range div ElementsPerSeg)*SegSize+ElementSize*(Range mod
ElementsPerSeg);
       if Change then NewData:=GlobalReAllocPtr(Data,MemSize,Gmem_Moveable or
Gmem_NoDiscard)
                 else NewData:=GlobalAllocPtr(Gmem_Moveable or
Gmem_NoDiscard,MemSize);
       if (NewData=nil) and Message then
          MessageBox(0,'It is not possible to allocate enough memory.',
                     'Error',mb_OK or mb_IconInformation);
    end;

    function THugeArray.GetPtr(Pos:LongInt):Pointer;

    begin
       GetPtr:=Ptr(Adr(Data).Seg+(Pos div ElementsPerSeg)*SelectorInc,
                   Adr(Data).Off+(Pos mod ElementsPerSeg)*ElementSize);
    end;

    function THugeRealArray.I(X:LongInt):PReal;

    begin
       I:=inherited I(X);
    end;

    constructor THugeMatrix.Init(Min1,Max1,Min2,Max2:LongInt; Size:Word;
Message:boolean);

    begin
       MinX:=Min1;
       MaxX:=Max1;
       MinY:=Min2;
       MaxY:=Max2;
       RangeY:=1+MaxY-MinY;
       ElementSize:=Size;
       GrabMem(Data,(MaxX-MinX+1)*(MaxY-MinY+1),false,Message);
    end;

    function THugeMatrix.ChangeSize(Min1,Max1,Min2,Max2:LongInt;
Message:boolean):boolean;

    var NewData:Pointer;

    begin
       MinX:=Min1;
       MaxX:=Max1;
       MinY:=Min2;
       MaxY:=Max2;
       RangeY:=1+MaxY-MinY;
       GrabMem(NewData,(MaxX-MinX+1)*(MaxY-MinY+1),true,Message);
       if NewData<>nil then
       begin
          ChangeSize:=true;
          Data:=NewData;
       end
       else ChangeSize:=false;
    end;

    function THugeMatrix.I(X,Y:LongInt):Pointer;

    begin
       I:=GetPtr(Y-MinY+RangeY*(X-MinX));
{$IFOPT R+}
       if (X<MinX) or (X>MaxX) or (Y<MinY) or (Y>MaxY) then
          if id_No=MessageBox(0,'Error in huge matrix, continue?','Index out of
range!',
                              mb_YesNo or mb_IconQuestion) then
          begin
             Done;
             Halt;
          end;
{$ENDIF}
    end;

    function THugeWordMatrix.I(X,Y:LongInt):PWord;

    begin
       I:=inherited I(X,Y);
    end;

end.

[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]