Shareware Overload/ShartewareOverload.cdr/progm/tptools.zip/ALLINST.ZIP/SINST.PAS

Pascal/Delphi Source File | 1987-12-21 | 8KB | 246 lines

{                          SINST.PAS
                       Editor Toolbox 4.0
             Copyright (c) 1985, 87 by Borland International, Inc.            }

{$I-}
{$R-}
{$V-}
{$S-}

unit SInst;
{-Fast screen writing routines for installation programs}

interface

uses
  Crt,                      {screen routines - standard unit}
  Dos;                      {dos calls - standard unit}

const
  Defnorows = 25;             {Default number of rows/physical screen}
  Defnocols = 80;             {Default number of cols/physical screen}
  HiddenCursor = $2000;       {scan lines for a hidden cursor}

type
  ScreenBuffer = array[0..1999] of Word; {Structure of video memory}

  WindowRec =
  record
    TopRow, LeftCol, Width, Height : Byte;
    Contents : array[0..1999] of Integer;
  end;

  WindowPtr = ^WindowRec;

var
  ScreenAdr : Word;           {Base address of video memory}
  PhyScrCols : Integer;       {Columns per screen row}
  RetraceMode : Boolean;      {Check for snow on color cards?}
  NormalCursor : Word;          {Scan lines for normal blinking cursor}
  PhyscrRows : Word;          {No. lines/physical screen}
  InitScreenMode : Byte;      {Video mode on entry to the program}
  LoColor,                    {LOw video}
  TiColor,                    {TItle / high video}
  ChColor,                    {CHanged keystrokes}
  EdColor,                    {keystroke being EDited / reverse video}
  CfColor : Byte;             {ConFlicting keystrokes}

  procedure EdFastWrite(St : String; Row, Col, Attr : Word);
    {-Writes St at Row,Col in Attr (video attribute) without snow}

  procedure EdChangeAttribute(Number, Row, Col, Attr : Word);
    {-Changes Number video attributes to Attr starting at Row,Col}

  procedure EdMoveFromScreen(var Source, Dest; Length : Word);
    {-Moves Length words from Source (video memory) to Dest without snow}

  procedure EdMoveToScreen(var Source, Dest; Length : Word);
    {-Moves Length words from Source to Dest (video memory) without snow}

  procedure EdSetCursor(ScanLines : Word);
   {-Change the scan lines of the hardware cursor}

  procedure RestoreScreen;
    {-Clean up screen at end of program}

  procedure SetColor(TheColor : Byte);
    {-set both textcolor and textbackground}

  procedure MakeBox(Left, Top, Right, Bottom, Attr : Byte);
    {-Draw a box on the screen}

  procedure SaveWindow(var WP : WindowPtr; Left, Top, Right, Bottom : Byte; Alloc : Boolean);
    {-Save a window}

  procedure RestoreWindow(var WP : WindowPtr; DeAlloc : Boolean);
    {-Restore a previously saved window and dispose of memory allocated to it}

  {==========================================================================}

implementation

  {$L SINST}

  procedure EdFastWrite(St : String; Row, Col, Attr : Word); external;
  procedure EdChangeAttribute(Number, Row, Col, Attr : Word); external;
  procedure EdMoveFromScreen(var Source, Dest; Length : Word); external;
  procedure EdMoveToScreen(var Source, Dest; Length : Word); external;
  procedure EdSetCursor(ScanLines : Word); external;

  procedure RestoreScreen;
    {-Clean up screen at end of program}
  begin                       {RestoreScreen}
    NormVideo;
    ClrScr;
  end;                        {RestoreScreen}

  procedure SetColor(TheColor : Byte);
    {-Set both textcolor and textbackground}
  begin
    TextColor(TheColor and $F);
    TextBackground(TheColor shr 4);
  end;                        {SetColor}

  procedure MakeBox(Left, Top, Right, Bottom, Attr : Byte);
    {-Draw a box on the screen}
  var
    Row : Byte;
    Span : String[80];
    SLen : Byte absolute Span;
  const
    Upright : string[1] = #179;
  begin                       {MakeBox}
    SLen := Pred(Right-Left);
    FillChar(Span[1], SLen, #196);
    {Top}
    EdFastWrite( #218+Span+#191, Top, Left, Attr);
    {Bottom}
    EdFastWrite(#192+Span+#217, Bottom, Left, Attr);
    {Middle}
    for Row := Succ(Top) to Pred(Bottom) do begin
      EdFastWrite(Upright, Row, Left, Attr);
      EdFastWrite(UpRight, Row, Right, Attr);
    end;
  end;                        {MakeBox}

  procedure SaveWindow(var WP : WindowPtr; Left, Top, Right, Bottom : Byte; Alloc : Boolean);
    {-Save a window}
  var
    Ofst : Word;
    W, H, I : Integer;
  begin                       {SaveWindow}
    W := Succ(Right-Left);
    H := Succ(Bottom-Top);
    if Alloc then
      GetMem(WP, (W*H) shl 1 + 4);
    with WP^ do begin
      Width := W;
      Height := H;
      TopRow := Top;
      LeftCol := Left;
      for I := 0 to Pred(H) do begin
        Ofst := ( ((Pred(Top)+I) * 80) + Pred(Left) ) shl 1;
        EdMoveFromScreen(Mem[ScreenAdr:Ofst], Contents[I*W], W);
      end;
    end;
  end;                        {SaveWindow}

   procedure RestoreWindow(var WP : WindowPtr; DeAlloc : Boolean);
     {-Restore a previously saved window and dispose of memory allocated to it}
   var
     I : Integer;
     Ofst : Word;
   begin                      {RestoreWindow}
     with WP^ do begin
       for I := 0 to Pred(Height) do begin
         Ofst := ( ((Pred(TopRow)+I) * 80) + Pred(LeftCol) ) shl 1;
         EdMoveToScreen(Contents[I*Width], Mem[ScreenAdr:Ofst], Width);
       end;
       if DeAlloc then begin
         Freemem(WP, (Width*Height) shl 1 + 4);
         WP := Nil;
       end;
     end;
   end;                       {RestoreWindow}

  procedure EdGetScreenMode;
    {-determine screen address and colors}
  var
    regs:Registers;

    procedure ChooseColorSet(Mono : Boolean);
    begin
      if Mono then begin
        LoColor := $07;
        TiColor := $0F;
        ChColor := $0F;
        EdColor := $70;
        CfColor := $70;
      end
      else begin
        LoColor := $07;
        TiColor := $0E;
        ChColor := $0F;
        EdColor := $1E;
        CfColor := $4F;
      end;
    end;

    function EdEgaPresent : Boolean;
      {-Return True if an EGA card is installed and selected}
    var
      regs:Registers;

    begin                     {EdEgaPresent}
      with Regs do begin
        Ah := $12;
        Bl := $10;
        Cx := $FFFF;
        Intr($10, Regs);
        EdEgaPresent := (Cx <> $FFFF);
      end;
    end;                      {EdEgaPresent}

  begin                       {EdGetScreenMode}

    PhyscrCols := Defnocols;  {Number of columns on the screen}
    PhyscrRows := Defnorows;

    with Regs do begin
      {Get current screen mode}
      Ax := $0F00;
      Intr($10, Regs);
      InitScreenMode := Al;

      {Set screen mode to appropriate 80 column mode if necessary}
      case InitScreenMode of
        0..1 : begin
                 {Switch from BW40 to BW80 or CO40 to CO80}
                 Ah := 0;
                 InitScreenMode := InitScreenMode + 2;
                 Al := InitScreenMode;
                 Intr($10, Regs);
               end;
      end;
    end;

    Retracemode := (InitScreenMode <> 7);

    if Retracemode then begin
      {Color card}
      Screenadr := $B800;
      NormalCursor := $0607;
      Retracemode := not EdEgaPresent;
      ChooseColorSet(InitScreenMode <> 3)
    end else begin
      {Monochrome}
      Screenadr := $B000;
      NormalCursor := $0B0C;
      ChooseColorSet(True);
    end;
  end;                        {EdGetScreenMode}

begin
  EdGetScreenMode;
end.