home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STAY42.ZIP / STAYWIN.INC < prev    next >
Encoding:
Text File  |  1986-11-08  |  6.3 KB  |  200 lines
  1. { This section of code is a modification of Lane Ferris' StayWndo.xxx
  2.   procedures which will allow Lane's memory resident features to save
  3.   and restore windows as well as to save and restore the orginal video
  4.   mode.
  5.  
  6.        Advantages:  - When used to replace StayWndo.xxx will restore
  7.                       the orginal DOS video mode and screen prior to
  8.                       the TSR code being activated. This includes
  9.                       graphics, 40col, monochrome, etc.
  10.  
  11.        Disadvantages -Does not allow for dimensioning of windows,
  12.                       it would be very difficult, if not impossible
  13.                       to save a graphics screen and have a textmode
  14.                       (or apparent texmode) overlay it. As such the
  15.                       mkwin procedure here only requires you send it
  16.                       a foreground and background color, no dimensions
  17.                       or borders as does the orginal mkwin.
  18.  
  19.                      -Only allows for one active window at a time,
  20.                       however I suppose if you need more, you could
  21.                       also include the orginal mkwin procedure with
  22.                       some slight mods and procedure name changes and
  23.                       you could then have multiple windows. (I don't
  24.                       need this for my applications so I haven't
  25.                       really investigated the possibility)
  26.  
  27. Good luck, I would appreciate any comments or suggestions.
  28.         -- Bill Dino [76317,1205]
  29.  
  30. }
  31.  
  32.  
  33. Const
  34.  
  35.       InitDone :boolean = false ;      { Initialization switch   }
  36.  
  37.       On     = True ;
  38.       Off    = False ;
  39.       VideoEnable = $08;               { Video Signal Enable Bit }
  40.  
  41. Type
  42.      Imagetype  = array [1..16383] of char;  { Screen Image in the heap    }
  43.      Monotype   = array [1..4096] of char;   { save smaller for mono       }
  44.      Screens    = record              { Save Screen Information     }
  45.                    Image:     Imagetype;  { Saved screen Image }
  46.                    monoimage: monotype;
  47.                    x,y:       integer;    { Saved cursor position }
  48.                    mode:      integer;    { Saved original mode }
  49.                   end;
  50.  
  51.  
  52.  Var
  53.  
  54.  
  55.   Monobuffer  :Monotype  absolute $B000:$0000; {Monochrome Adapter Memory}
  56.   Colorbuffer :Imagetype absolute $B800:$0000; {Color Adapter Memory     }
  57.   CrtAdapter  :integer   absolute $0040:$0063; { Current Display Adapter }
  58.   VideoMode   :byte      absolute $0040:$0065; { Video Port Mode byte    }
  59.   Video_Buffer:integer;                        { Record the current Video}
  60.   x,y         :integer;
  61.   originalscreen: screens;
  62.  
  63. {--------------------------------------------------------------------}
  64. {  set the video mode to the that passed in the <MODE> parameter     }
  65. {--------------------------------------------------------------------}
  66.  
  67. { mode 0 -- color graphics,40 col, b&w
  68.   mode 1 -- color graphics,40 col, color
  69.   mode 2 -- color graphics,80 col, b&w
  70.   mode 3 -- color graphics,80 col, color
  71.   mode 4 -- color graphics,graphics mode, 320 x 200, color
  72.   mode 5 -- color graphics,graphics mode, 320 x 200, b&w
  73.   mode 6 -- color graphics,graphics mode, 640 x 200, b&w
  74.   mode 7 -- monochrome adapter
  75. }
  76.  
  77. procedure setmode(mode:integer);
  78.  
  79.  
  80. type
  81.  packs= record
  82.          ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  83.         end;
  84.  
  85.  
  86. var
  87.  
  88.   results:packs;
  89.  
  90. begin
  91.   fillchar(results,sizeof(results),0);
  92.   results.ax:=$0000+mode;          { service code 00 sets the current mode }
  93.   intr($10,results);
  94. end;
  95.  
  96. {--------------------------------------------------------------------}
  97. {     check the current video mode and report ok if not in graphics  }
  98. {--------------------------------------------------------------------}
  99.  
  100.  
  101. procedure check_video_mode(var goodmode:boolean;var currentmode:integer);
  102.  
  103.  
  104. type
  105.  packs= record
  106.          ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  107.         end;
  108.  
  109.  
  110. var
  111.  
  112.   results:packs;
  113.  
  114. begin
  115.   fillchar(results,sizeof(results),0);
  116.   results.ax:=$0f00;          { service code 15 reads the current mode }
  117.   intr($10,results);
  118.   currentmode:=lo(results.ax);  { the lo byte returns the video mode }
  119.   case currentmode of
  120.     0..7 : goodmode:=true;
  121.     else goodmode:=false;
  122.   end;
  123. end;
  124.  
  125.  
  126. {------------------------------------------------------------------}
  127. {          Turn the Video On/Off to avoid Read/Write snow          }
  128. {------------------------------------------------------------------}
  129. Procedure Video (Switch:boolean);
  130.    Begin
  131.       If (Switch = Off) then
  132.       Port[CrtAdapter+4] := (VideoMode - VideoEnable)
  133.       else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  134.    End;
  135.  
  136. {------------------------------------------------------------------}
  137. {       MkWin   Make a Window                                      }
  138. {------------------------------------------------------------------}
  139. procedure MkWin( FG, BG :integer);
  140.  
  141. var
  142. goodmode:boolean;
  143. old_mode:integer;
  144.  
  145.  
  146. begin
  147.   check_video_mode(goodmode,old_mode);
  148.   video(off);
  149.   with originalscreen do
  150.     begin
  151.       case old_mode of
  152.         0..3 : begin
  153.                 image:=colorbuffer;
  154.                 x:=wherex;
  155.                 y:=wherey;
  156.                end;
  157.         4..6 : image:=colorbuffer;
  158.            7:  begin
  159.                 monoimage:=monobuffer;
  160.                 x:=wherex;
  161.                 y:=wherey;
  162.                 fg:=white;
  163.                 bg:=black;
  164.                end;
  165.       end; {case}
  166.       mode:=old_mode         {store the old mode in the original screen type}
  167.   end; {with}
  168.  
  169.  
  170.   if old_mode<>7 then  setmode(3);
  171.   video(on);
  172.   clrscr;
  173.   textcolor(fg);
  174.   textbackground(bg);
  175. end;
  176.  
  177. {------------------------------------------------------------------}
  178. {                          Remove Window                           }
  179. {------------------------------------------------------------------}
  180.  
  181. Procedure RmWin;
  182.  
  183. begin
  184.   clrscr;
  185.   video(off);
  186.   with originalscreen do
  187.     begin
  188.      setmode(mode);
  189.      video(off);
  190.      if mode=7 then monobuffer:=monoimage else colorbuffer:=image;
  191.      case originalscreen.mode of
  192.        0..3,7:  gotoxy(originalscreen.x,originalscreen.y);
  193.      end;
  194.      video(on);
  195.    end;  {with}
  196. end;
  197. {------------------------------------------------------------------}
  198. .y);
  199.      end;
  200.