caasi@sdsu.UUCP (07/13/88)
The following is source code for doing windows under Turbo Pascal 4.0 in a unit file and a main program for demonstrating its use. No flames to me as I am not the author. Disclaimer: My employer's views do not reflect mine. ================== windows2 TP4 unit (cut here) ====================== unit windows2; interface uses crt, dos, turbo3; { Turbo Pascal removable window system } { Requirements: IBM PC or close compatible. } { Screen must be in text mode, on page 1, } { either mono or color card. } { Call INITWIN before calling MKWIN or RMWIN. } const maxwin = 5; { maximum number of windows open at once } type imagetype = array [1..4096] of char; windimtype = record x1,y1,x2,y2: integer end; var win: { Global variable package } record dim: windimtype; { Current window dimensions } depth: integer; stack: array[1..maxwin] of record image: imagetype; { saved screen image } dim: windimtype; { saved window dimensions } x,y: integer { saved cursor position } end end; crtmode: byte absolute $0040:$0049; crtwidth: byte absolute $0040:$004A; monobuffer: imagetype absolute $B000:$0000; colorbuffer: imagetype absolute $B800:$0000; procedure InitWin; { Records initial window dimensions } procedure BoxWin(x1,y1,x2,y2: integer); procedure MkWin(x1,y1,x2,y2: integer); procedure rmwin; implementation procedure InitWin; { Records initial window dimensions } begin with win.dim do begin x1 := 1; y1 := 1; x2 := crtwidth; y2 := 25 end; win.depth := 0 end; { Draw a box, fill it with blanks, and make it the current } { window. Dimensions given are for the box; actual window is } { one unit smaller in each direction. } { This routine can be used separately from the rest of the } { removable window package. } procedure BoxWin(x1,y1,x2,y2: integer); var x,y: integer; begin window(1,1,80,25); {Top} GotoXY(x1,y1); write(chr(213)); for x := x1+1 to x2-1 do write(chr(205)); write(chr(184)); for y := y1+1 to y2-1 do {Sides} begin GotoXY(x1,y); write(chr(179),' ':x2-x1-1,chr(179)) end; GotoXY(x1,y2); {Bottom} write(chr(212)); for x := x1+1 to x2-1 do write(chr(205)); write(chr(190)); window(x1+1,y1+1,x2-1,y2-1); { Make it the current window } GotoXY(1,1) end; { Create a movable window } procedure MkWin(x1,y1,x2,y2: integer); begin with win do depth := depth+1; { increment stack pointer } if win.depth > maxwin then begin writeln(^G,' Windows nested too deep '); halt end; { Save contents of screen } if crtmode = 7 then win.stack[win.depth].image := monobuffer else win.stack[win.depth].image := colorbuffer; win.stack[win.depth].dim := win.dim; win.stack[win.depth].x := wherex; win.stack[win.depth].y := wherey; { Create the window } boxwin(x1,y1,x2,y2); win.dim.x1 := x1+1; win.dim.y1 := y1+1; { Allow for margins } win.dim.x2 := x2-1; win.dim.y2 := y2-1; end; { Remove the most recently created removable window } { Restore screen contents, window dimensions, and } { position of cursor. } procedure rmwin; begin if crtmode = 7 then monobuffer := win.stack[win.depth].image else colorbuffer := win.stack[win.depth].image; with win do begin dim := stack[depth].dim; window(dim.x1,dim.y1,dim.x2,dim.y2); GotoXY(stack[depth].x,stack[depth].y); depth := depth -1 end end; begin end. ================== Main pascal demo program (cut here) ===================== program windowtest; uses windows2, crt; { Test program for removable window package } var i: integer; begin initwin; writeln('Now and every time the action stops,'); writeln('press ENTER to continue'); readln; clrscr; for i := 1 to 25 do writeln(' This is the original screen.'); mkwin(3,3,50,18); for i := 1 to 15 do writeln('This is the first window....'); readln; mkwin(10,5,70,20); for i := 1 to 15 do writeln('Second window....'); readln; mkwin(15,15,45,23); writeln('Third window...'); readln; mkwin(55,10,79,25); writeln('Fourth window....'); readln; rmwin; { remove fourth window } readln; rmwin; { remove third window } writeln; writeln('We are back in the second window...'); readln; rmwin; { remove second window } writeln; writeln('This is the first window again!'); readln; rmwin; { remove first window } readln; end.