home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / tricks / prntarea.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-12  |  6.0 KB  |  187 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      PRNTAREA.PAS                      *)
  3. (*                                                        *)
  4. (* Residentes Utility, mit dem man einen beliebigen       *)
  5. (* Bildschirmausschnitt auf dem Drucker ausgeben kann.    *)
  6. (* Mit RETURN kann der Editmodus umgeschaltet werden.     *)
  7. (* Dieser Modus erlaubt es, den zu druckenden Bereich     *)
  8. (* anhand der Cursortasten frei zu editieren.             *)
  9. (*       (C) 1990 Michael Plewe & TOOLBOX                 *)
  10. (* ------------------------------------------------------ *)
  11. PROGRAM PrintScrArea;
  12. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  13. {$M 1024,0,0}
  14.  
  15. USES  TSR, Crt, BiosPrnt;    { Unit TSR aus PASCAL 6/7 '88 }
  16.  
  17. CONST
  18.   Copyright  : STRING[32] =
  19.                          '(C) 1990 Michael Plewe & TOOLBOX';
  20.   Version    : STRING[16] = 'PrintScrArea 1.0';
  21.   Hotkey     = $7000;
  22.   HotKeyName = 'Alt-F9';
  23.   HGA        = $B000;
  24.   CGA        = $B800;
  25.   EditFrame  : BOOLEAN = FALSE;
  26.   up   = #72;  down  = #80;
  27.   left = #75;  right = #77;
  28.   RET  = #13;  ESC   = #27;
  29.   KennByte1  = 19;
  30.   KennByte2  = 12;
  31.   KennByte3  = 11;
  32.   X1 : BYTE  = 39;  Y1 : BYTE = 12;
  33.   X2 : BYTE  = 40;  Y2 : BYTE = 13;
  34.   X  : BYTE  = 40;  Y  : BYTE = 12;
  35.  
  36. TYPE
  37.   ScreenMem = ARRAY [1..25, 1..80] OF RECORD
  38.                                         ch   : CHAR;
  39.                                         attr : BYTE;
  40.                                       END;
  41. VAR
  42.   Screen    : ^ScreenMem;
  43.   ScrBuf    : ScreenMem;
  44.   VideoMode : BYTE ABSOLUTE $0040:$0049;
  45.   Key       : CHAR;
  46.   i, j      : BYTE;
  47.  
  48.   PROCEDURE ScrWrite(x, y, color : BYTE; chr : CHAR);
  49.   BEGIN
  50.     Screen^[y,x].ch   := chr;
  51.     Screen^[y,x].attr := color;
  52.   END;
  53.  
  54.   PROCEDURE ShowFrame(X1, Y1, X2, Y2 : BYTE);
  55.   BEGIN
  56.     ScrWrite(X1, Y1, white, #218);
  57.     FOR i := Succ(X1) TO Pred(X2) DO
  58.       ScrWrite(i, Y1, white, #196);
  59.     ScrWrite(X2, Y1, white, #191);
  60.     FOR i := Succ(Y1) TO Pred(Y2) DO BEGIN
  61.       ScrWrite(X1, i, white, #179);
  62.       ScrWrite(X2, i, white, #179);
  63.     END;
  64.     ScrWrite(X1, Y2, white, #192);
  65.     FOR i := Succ(X1) TO Pred(X2) DO
  66.       ScrWrite(i, Y2, white, #196);
  67.     ScrWrite(X2, Y2, white, #217);
  68.   END;
  69.  
  70.   PROCEDURE GetScreen;
  71.   BEGIN
  72.     Move(Screen^, ScrBuf, 4000);
  73.   END;
  74.  
  75.   PROCEDURE PutScreen;
  76.   BEGIN
  77.     Move(ScrBuf, Screen^, 4000);
  78.   END;
  79.  
  80. {$F+}
  81.   PROCEDURE PrintScr;
  82.   VAR
  83.     OldAttr, Xpos, Ypos : BYTE;
  84.   BEGIN
  85.     IF VideoMode = 7 THEN Screen := Ptr(HGA, 0)
  86.                      ELSE Screen := Ptr(CGA, 0);
  87.     Xpos := WhereX;  Ypos := WhereY;
  88.     OldAttr := TextAttr;
  89.     GetScreen;
  90.     GotoXY(X, Y);
  91.     ShowFrame(X1, Y1, X2, Y2);
  92.     REPEAT
  93.       IF EditFrame THEN
  94.         ScrWrite(X1, Y1, black + lightgray * 16, 'E');
  95.       Key := ReadKey;
  96.       PutScreen;
  97.       CASE Key OF
  98.         #0 : BEGIN
  99.                Key := ReadKey;
  100.                IF EditFrame THEN
  101.                  CASE Key OF
  102.                    up     : IF Y > 1 THEN
  103.                               IF Y = Y1 THEN
  104.                                 Dec(Y1)
  105.                               ELSE
  106.                                 IF Y = Y2 THEN
  107.                                   IF Pred(Y2) > Y1 THEN
  108.                                     Dec(Y2);
  109.                    down   : IF Y < 25 THEN
  110.                               IF Y = Y2 THEN
  111.                                 Inc(Y2)
  112.                               ELSE
  113.                                 IF Y = Y1 THEN
  114.                                   IF Succ(Y1) < Y2 THEN
  115.                                     Inc(Y1);
  116.                    left   : IF X > 1 THEN
  117.                               IF X = X1 THEN
  118.                                 Dec(X1)
  119.                               ELSE
  120.                                 IF X = X2 THEN
  121.                                   IF Pred(X2) > X1 THEN
  122.                                     Dec(X2);
  123.                     right : IF X < 80 THEN
  124.                               IF X = X2 THEN
  125.                                 Inc(X2)
  126.                               ELSE
  127.                                 IF X = X1 THEN
  128.                                   IF Succ(X1) < X2 THEN
  129.                                     Inc(X1);
  130.                END;
  131.                CASE Key OF
  132.                  up    : IF Y > 1  THEN Dec(Y);
  133.                  down  : IF Y < 25 THEN Inc(Y);
  134.                  left  : IF X > 1  THEN Dec(X);
  135.                  right : IF X < 80 THEN Inc(X);
  136.                END;
  137.              END;
  138.         ^P : BEGIN        { Drucken des Fensterausschnitts }
  139.                FOR j := Y1 TO Y2 DO BEGIN
  140.                  FOR i := X1 TO X2 DO
  141.                    PrintChr(Screen^[j,i].ch);
  142.                  PrintChr(#10);
  143.                  PrintChr(#13);
  144.                END;
  145.              END;
  146.         ^I : BEGIN      { Fensterkoordinaten initialisieren }
  147.                X1 := Pred(X);  Y1 := Pred(Y);
  148.                X2 := X;        Y2 := Y;
  149.              END;
  150.         RET: IF EditFrame THEN EditFrame := FALSE
  151.                           ELSE EditFrame := TRUE;
  152.       END;
  153.       ShowFrame(X1, Y1, X2, Y2);
  154.       GotoXY(X,Y);
  155.     UNTIL Key = ESC;
  156.     PutScreen;
  157.     TextAttr := OldAttr;
  158.     GotoXY(Xpos, Ypos);
  159.   END;
  160. {$F-}
  161.  
  162. BEGIN
  163.   IF (MemW[0:$3F4] = KennByte1) AND
  164.      (MemW[0:$3F6] = KennByte2) AND
  165.      (MemW[0:$3F8] = KennByte3) THEN BEGIN
  166.     WriteLn(^G^M^J, Copyright,
  167.             ^M^J,Version,' ist bereits installiert worden,',
  168.             ^M^J'aktivieren mit ', HotKeyName,'.');
  169.     Halt;
  170.   END;
  171.   IF NOT PrinterOK(0) THEN REPEAT
  172.     WriteLn(^G'Der Drucker ist nicht bereit,');
  173.     WriteLn('bitte einschalten und TASTE drücken ...');
  174.     Key := ReadKey;
  175.     WriteLn;
  176.   UNTIL (Key = ESC) OR PrinterOK(0);
  177.   MemW[0:$3F4] := KennByte1;
  178.   MemW[0:$3F6] := KennByte2;
  179.   MemW[0:$3F8] := KennByte3;
  180.   writeln(^M^J,Copyright,
  181.           ^M^J,Version,' wurde installiert,',
  182.           ^M^J'aktivieren mit ', HotKeyName,'.');
  183.   MakeResident(@PrintScr, HotKey);
  184. END.
  185. (* ------------------------------------------------------ *)
  186. (*             Ende von PRNTAREA.PAS                      *)
  187.