C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/EDITWIN/O_TBUF.PAS

Pascal/Delphi Source File | 1992-07-01 | 6KB | 184 lines

{==============================================================}
{                                                              }
{           Saved as: O_TBUF.PAS                               }
{            Purpose: Provide text buffer that can be          }
{                     treated as array of strings, with        }
{                     random access to elements through        }
{                     array index, manipulate strings in       }
{                     buffer                                   }
{             Author: Pat Anderson                             }
{           Language: TP 6.0                                   }
{      Last modified: 06/20/92                                 }
{                                                              }
{==============================================================}

unit O_Tbuf;

{--------------------------------------------------------------}
                        INTERFACE
{--------------------------------------------------------------}

type
  PTextArray = ^TTextArray;
  TTextArray = ARRAY [1..1] OF pointer;

  PTextBuffer = ^TTextBuffer;
  TTextBuffer = object
    TextArray : PTextArray;
    MaxLines : integer;
    TotalLines : integer;
    constructor Init (Lines : integer);
    function StringToArray (PascalStr : string; Index : integer) : boolean;
    function StringFromArray (Index : integer) : string;
    function InsertLine (PascalStr : string; Index : integer) : boolean;
    procedure DeleteLineFromArray (Index : integer);
    procedure SetTotalLines (NumberOfLines : integer);
    function GetTotalLines : integer;
    procedure ClearTextArray;
    destructor Done;
  end;

function StringToHeap (PascalStr : string) : pointer;
function StringFromHeap (HeapStr : pointer) : string;
procedure DisposeString (var PHeapStr : pointer);

{--------------------------------------------------------------}
                        IMPLEMENTATION
{--------------------------------------------------------------}

function StringToHeap (PascalStr : string) : pointer;
{function that copies a Pascal string to the heap, creating
 a dynamic string ("heapstring"), and returns pointer to it}
 var
    SpaceNeeded : byte;
    HeapStr : pointer;
  begin
    SpaceNeeded := Length (PascalStr) + 1;  {1 is for length byte itself}
    if MaxAvail < SpaceNeeded then          {check if sufficient memory}
      StringToHeap := nil                   {if not, return nil pointer}
    else                                    {if enough memory}
      begin
        GetMem (HeapStr, SpaceNeeded);      {allocate storage for heapstring}
        string (HeapStr^) := PascalStr;     {assign Pascal string to heapstring}
        StringToHeap := HeapStr;            {return pointer to heapstring}
      end;
  end; {of StringToHeap function}

function StringFromHeap (HeapStr : pointer) : string;
{function that retrieves dynamic string created with and
 StringToHeap function and returns it as a Pascal string}
  var
    PascalStr : string;
  begin
    if HeapStr = nil then                {if pointer is nil}
      StringFromHeap := ''               { return NULL string}
    else
      StringFromHeap := string (HeapStr^);
  end; {of StringFromHeap function}

procedure DisposeString (var PHeapStr : pointer);
{procedure to deallocate space for a dynamic string created with
 the StringToHeap function}
  var
    BytesToFree : byte;
  begin
    if PHeapStr = nil then
      Exit
    else
      begin
        BytesToFree := byte (PHeapStr^) + 1;
        FreeMem (PHeapStr, BytesToFree);
        PHeapStr := nil;
      end;
  end; {of DisposeString procedure}

constructor TTextBuffer.Init;
  var
    count : integer;
  begin
    MaxLines := Lines;
    New (TextArray);
    GetMem (TextArray^[1], MaxLines * SizeOf (pointer));
    for count := 1 TO MaxLines do
      TextArray^[Count] := nil;
    TotalLines := 0;
  end; { of Init }

function TTextBuffer.StringToArray (PascalStr : string; Index : integer) : boolean;
  begin
    StringToArray := true;
    if TextArray^[Index] <> nil then
      DisposeString (TextArray^[Index])
    else
      Inc (TotalLines);
    TextArray^[Index] := StringToHeap (PascalStr);
    if TextArray^[Index] = nil then
      StringToArray := false
  end; { procedure StringToArray }

function TTextBuffer.StringFromArray (Index : integer) : string;
{ Retrieve the string pointed to by the given array index
  array, for assignment to Turbo Pascal string }
  begin
    StringFromArray := StringFromHeap (TextArray^[Index]);
  end; { function StringFromArray }

function TTextBuffer.InsertLine (PascalStr : string; Index : integer) : boolean;
{ Insert a string into array at specified index, move following
  elements to next higher index }
  var
    count : integer;
  begin
    InsertLine := true;
    for Count := TotalLines + 1 doWNTO Index + 1 do       { Open up space }
      TextArray^[Count] := TextArray^[Count - 1];
    TextArray^[Index] := StringToHeap (PascalStr);
    if TextArray^[Index] = nil then
      InsertLine := false
    else
      Inc (TotalLines);
  end; { procedure InsertLine }

procedure TTextBuffer.DeleteLineFromArray (Index : integer);
{ Delete string pointed to by given array index }
  var
    count : integer;
  begin
    if TotalLines = 0 then
      Exit;
    DisposeString (TextArray^[Index]);        { Dispose of string }
    for Count := Index TO TotalLines do       { Close up  space   }
      TextArray^[Count] := TextArray^[Count + 1];
    Dec (TotalLines);
  end; { procedure DeleteLine }

procedure TTextBuffer.SetTotalLines (NumberOfLines : integer);
  begin
    TotalLines := NumberOfLines;
  end;

function TTextBuffer.GetTotalLines : integer;
  begin
    GetTotalLines := TotalLines;
  end;

procedure TTextBuffer.ClearTextArray;
  var
    Count : integer;
  begin
    for Count := 1 to MaxLines do
      if TextArray^[Count] <> nil then begin
        DisposeString (TextArray^[Count]);
        TextArray^[Count] := nil;
      end;
  end;

destructor TTextBuffer.Done;
  var
    count : integer;
  begin
    ClearTextArray;
    Dispose (TextArray);
  end;
end.