home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_scrf / sti_scrf.pas next >
Encoding:
Pascal/Delphi Source File  |  1990-12-11  |  4.6 KB  |  138 lines
  1. Unit STI_SCRF;                              {Screen handling fucntions      }
  2.  
  3. Interface
  4.  
  5. Uses Crt;                                   {standard TP 5.0 unit           }
  6.  
  7. Const
  8.   NOBORDER              = '';
  9.   SPACES                = '         ';
  10.   SINGLELINE            = #$98#$9A#$99#$9B#$95#$95#$96#$96;
  11.   ROUNDCORNERSINGLE     = #$9C#$9E#$9D#$9F#$95#$95#$96#$96;
  12.   BIGBLOCK              = #$87#$87#$87#$87#$87#$87#$87#$87;
  13.   THICKTOPTHINSIDES     = #$83#$9A#$83#$9B#$83#$95#$96#$96;
  14.   THICKDIAGONALCORNER   = #$E4#$E6#$E5#$E7#$87#$87#$87#$87;
  15.  
  16.  
  17. Type
  18.   TVRAM     = array[0..$f9e] of word;       {text screen array              }
  19.   WindowSave = record                       {saved screen record            }
  20.                 TScr    : TVRAM;            {the text                       }
  21.                 TAttr   : TVRAM;            {the attributes                 }
  22.               end;
  23.   WindowPtr = ^WindowSave;                  {pointer to saved screen        }
  24.  
  25. Var
  26.   Vram          : TVRAM absolute $A000:$0;  {video ram position             }
  27.   Attr          : TVRAM absolute $A200:$0;  {text attribute postion         }
  28.  
  29. procedure HiddenCursor;                     {procedure to hide the cursor   }
  30. procedure NormalCursor;                     {procedure to display the cursor}
  31. procedure Frame(x1,y1,x2,y2,TCol,Attr:byte; Border : string);
  32. procedure DisposeWindow(Var Save : WindowSave);
  33. procedure MakeWindow(Var Save : WindowSave; X1,Y1,X2,Y2,Tcol,Fcol,TTCol : byte;
  34.                      Border,Title : string);
  35.  
  36. Implementation
  37.  
  38. {---------------------------------------------------------------------------}
  39.  
  40. procedure HiddenCursor;                     {procedure to hide the cursor   }
  41.  
  42. begin
  43.   port[$62]  := $4b;                        {play around with the ports     }
  44.   port[$60]  := $0f;
  45.   port[$60]  := $0f;
  46.   port[$60]  := $fb;
  47. end;
  48.  
  49. {---------------------------------------------------------------------------}
  50.  
  51. procedure NormalCursor;                     {procedure to display the cursor}
  52.  
  53. begin
  54.   port[$0062]  := $4b;                      {play around with the ports     }
  55.   port[$0060]  := $8f;
  56.   port[$0060]  := $00;
  57.   port[$0060]  := $fb;
  58. end;
  59.  
  60. {---------------------------------------------------------------------------}
  61.  
  62. procedure Frame(x1,y1,x2,y2,TCol,Attr:byte; Border : string);
  63.  
  64. Var
  65.   Loop : byte;
  66.  
  67. begin
  68.   TextColor(Tcol);
  69.   Window(x1,y1,x2,y2);
  70.   ClrScr;
  71.   TextColor(Attr);
  72.   Kanji := FALSE;
  73.   Window(1,1,80,25);
  74.   for Loop := x1 to x2 do
  75.     begin
  76.       GotoXY(Loop,y1);
  77.       Write(Border[5]);
  78.       GotoXY(Loop,y2);
  79.       Write(Border[6]);
  80.     end;
  81.   for Loop := y1 to y2 do
  82.     begin
  83.       GotoXY(x1,Loop);
  84.       Write(Border[7]);
  85.       GotoXY(x2,Loop);
  86.       Write(Border[8]);
  87.     end;
  88.   GotoXY(x1,y1); write(Border[1]);
  89.   GotoXY(x2,y1); write(Border[3]);
  90.   GotoXY(x1,y2); write(Border[2]);
  91.   GotoXY(x2,y2); write(Border[4]);
  92.   Kanji := TRUE;
  93. end;
  94.  
  95. {---------------------------------------------------------------------------}
  96.  
  97. procedure DisposeWindow(Var Save : WindowSave);
  98.  
  99. begin
  100.   move(Save.TScr,Vram ,sizeof(Vram));      {save the text                  }
  101.   move(Save.TAttr,Attr,sizeof(Attr));      {save the attributes            }
  102. end;
  103.  
  104. {---------------------------------------------------------------------------}
  105.  
  106. procedure MakeWindow(Var Save : WindowSave; X1,Y1,X2,Y2,Tcol,Fcol,TTCol : byte;
  107.                      Border,Title : string);
  108.  
  109. begin
  110.   move(Vram,Save.TScr ,sizeof(Vram));       { save the text                 }
  111.   move(Attr,Save.TAttr,sizeof(Attr));       { save the attributes           }
  112.   if Border <> '' then                      {  check for border             }
  113.     Frame(X1,Y1,X2,Y2,TCol,Fcol,Border)     { draw the border               }
  114.   else
  115.     begin
  116.       Window(X1,Y1,X2,Y2);                  { reset the window              }
  117.       TextColor(Tcol);                      { reset the color               }
  118.       ClrScr;                               { wipe the window               }
  119.       TextColor(White);                     { set to defaults               }
  120.       TextReverse(NoReverse);               { default                       }
  121.       Window(1,1,80,25);                    { default                       }
  122.     end;
  123.   if (Title <> '') and (Border <> '') then
  124.     begin
  125.       if length(Title) > (X2-X1)-2 then
  126.         Title := copy(Title,1,(X2-X1)-2);
  127.       GotoXY(X1+ (((X2-X1) div 2) - (length(Title) div 2)),Y1);
  128.       TextColor(Tcol);
  129.       TextReverse(Reverse);
  130.       Write(Title);
  131.       TextReverse(NoReverse);
  132.     end;
  133. end;
  134.  
  135. {---------------------------------------------------------------------------}
  136.  
  137. begin
  138. end.