[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]

    Uses Crt;

    Type

       BufferType = Array[0..3999] of Byte; { screen size      }
       PtrBufferType = ^BufferType;         { For dynamic use  }

    Var
      Screen: BufferType Absolute $B800:$0; { direct access to }
                                            { Text screen      }

    Function CharS(Len:Byte; C: Char): String;
    Var
      S: String;
    begin                       { This Function returns a String of }
      FillChar(S, Len+1, C);    { Length Len and of Chars C.        }
      S[0] := Chr(Len);
      CharS := S;
    end;

    Function Center(X1, X2: Byte; S: String): Byte;
    Var
      L, Max: Integer;
    begin                           { This Function is used to center     }
      Max := (X2 - (X1-1)) div 2;   { a String between two X coordinates. }
      L := Length(S);
      if Odd(L) then Inc(L);
      Center := X1 + (Max - (L div 2));
    end;

    Procedure DrawBox(X1, Y1, X2, Y2: Integer; Attr: Byte; Title: String);
    Var
      L, Y, X: Integer;
      S: String;

    begin
      X := X2 - (X1-1);      { find box width  }
      Y := Y2 - (Y1-1);      { find box height }
      { draw box }
      S := Concat('É', CharS(X-2, 'Í'), '»');
      GotoXY(X1, Y1);
      TextAttr := Attr;
      Write(S);
      Title := Concat('µ ', Title,' Æ');
      GotoXY(Center(X1, X2, Title), Y1);
      Write(Title);
      For L := 2 to (Y-1) do
        begin
          GotoXY(X1, Y1+L-1);
          Write('º', CharS(X-2, ' '), 'º');
        end;
      GotoXY(X1, Y2);
       Write('È', CharS(X-2, 'Í'), '¼');

    end;

    Procedure SaveBox(X1, Y1, X2, Y2: Integer; Var BufPtr: PtrBufferType);
    Var
      Poff, Soff, Y, XW, YW, Size: Integer;

    begin
      XW := X2 - (X1 -1);   { find box width  }
      YW := Y2 - (Y1 -1);   { find box height }
      Size := (XW*2 ) * YW; { size needed to store background }
      GetMem(BufPtr, Size); { allocate memory to buffer }
      For Y := 1 to YW do   { copy line by line to buffer }
        begin
          Soff := (((Y1-1) + (Y-1)) * 160) + ((X1-1)*2);
          Poff := ((XW * 2) * (Y-1));
          Move(Screen[Soff], BufPtr^[Poff], (XW * 2)); { Write to buffer }
        end;
    end;

    (*************** end of PART 1 of 2. *****************************)
    (****** PART 2 of 2 ********************************)
    Procedure RestoreBox(X1, Y1, X2, Y2: Integer; Var BufPtr: PtrBufferType);
    Var
      Poff, Soff, X, Y, XW, YW, Size: Integer;
      F: File;

    begin
      XW := X2 - (X1-1); { once again...find box width }
      YW := Y2 - (Y1-1); { find height }
      Size := (XW *2) * YW; { memory size to deallocate from buffer }
      For Y := 1 to YW do   { move back, line by line }
        begin
          Soff := (( (Y1-1) + (Y-1)) * 160) + ((X1-1)*2);
          Poff := ((XW*2) * (Y-1));
          Move(BufPtr^[Poff], Screen[Soff],  (XW*2));
        end;
      FreeMem(BufPtr, Size);
    end;

    Procedure Shadow(X1, Y1, X2, Y2: Byte);
    Var
      Equip: Byte Absolute $40:$10;
      Vert, Height, offset: Integer;

    begin
      if (Equip and 48) = 48 then Exit;

      For Vert := (Y1+1) to (Y2+1) do
        For Height := (X2+1) to (X2+2) do
          begin
            offset := (Vert - 1) * 160 + (Height-1) * 2 + 1;
            Screen[offset] := 8;
          end;
      Vert := Y2 + 1;
      For Height := (X1+2) to (X2+2) do
        begin
          offset := (Vert-1) * 160 + (Height-1) * 2 + 1;
          Screen[offset] := 8;
        end;
    end;

    Procedure Hello;
    Var
      BufPtr: PtrBufferType;
    begin
      { note, that if you use shadow, save an xtra 2 columns
        and 1 line to accomadate what Shadow does }
       {             V   V   }
      SaveBox(7, 7, 73, 15, BufPtr);
      DrawBox(7, 7, 71, 13, $4F, 'Hello');
      Shadow(7, 7, 71, 13);
      GotoXY(9, 9);
      Write('Hello Terry! I hope this is what you were asking For.');
      GotoXY(9, 11);
      Write('Press Enter');
      While ReadKey <> #13 do;
      RestoreBox(7, 7, 73, 14, BufPtr);
    end;

    Procedure Disclaimer;
    Var
      BufPtr: PtrBufferType;
    begin
      SaveBox(5, 5, 77, 21, BufPtr);
      DrawBox(5, 5, 75, 20, $1F, 'DISCLAIMER');
      Shadow(5, 5, 75, 20);
      Window(7, 7, 73, 19);
      Writeln('  Seeing as I came up With these Procedures For');
      Writeln('my own future Programs (I just recently wrote these)');
      Writeln('please don''t Forget who wrote them originally if you');
      Writeln('decide to use them in your own.  Maybe a ''thanks to Eric Miller');
      Writeln('For Window routines'' somewhere in your doCs?');
      Writeln;
      Writeln('  Also, if anyone can streamline this source, well, I''d');
      Writeln('I''d like to see it...not that too much can be done.');
      Writeln;
      Writeln('                    Eric Miller');
      Window(1,1,80,25);
      Hello;
      TextAttr := $1F;
      GotoXY(9, 18);
      Writeln('Press Enter...');
      While ReadKey <> #13 do;
      RestoreBox(5, 5, 77, 21, BufPtr);
    end;

    begin
      TextAttr := $3F;
      ClrScr;
      Disclaimer;
    end.
    (***** end of PART 1 of 2 ******************************)

[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]