home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / tricks / scroll.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-10  |  5.3 KB  |  139 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      SCROLL.PAS                        *)
  3. (*     Scrollen von Bildschirmfenstern im Text- und im    *)
  4. (*          Grafikmodus in beliebige Richtungen           *)
  5. (*            (c) 1989  H.Mende  &  TOOLBOX               *)
  6. (* ------------------------------------------------------ *)
  7. UNIT Scroll;
  8.  
  9. INTERFACE
  10.  
  11. USES Crt, Graph;
  12.  
  13. TYPE
  14.   ScrollDirType = (UP, DOWN, LEFT, RIGHT);
  15. VAR
  16.   ScrSeg        : WORD;
  17.  
  18.   PROCEDURE ScrollViewPort(direction : ScrollDirType;
  19.                            anz       : BYTE);
  20.   { -"ANZAHL"-maliges Rollen des aktiven Grafikfensters in }
  21.   { die durch die Variable "DIRECTION" definierte Richtung }
  22.  
  23.   PROCEDURE ScrollWindow(direction : ScrollDirType;
  24.                          anz, x1, y1, x2, y2 : BYTE);
  25.   { ScrollWindow(Direction,Anzahl,Links,Oben,Rechts,Unten) }
  26.   { - Wie ScrollViewPort, allerdings im Textmodus. Hier    }
  27.   { müssen die Eck-Koordinaten des Textfensters mit        }
  28.   { übergeben werden.                                      }
  29.  
  30. IMPLEMENTATION
  31.  
  32. CONST
  33.   GDriver : INTEGER = Detect;
  34. VAR
  35.   GMode   : INTEGER;
  36.  
  37.   PROCEDURE ScrollViewPort;
  38.   TYPE
  39.     BFType = ARRAY [0..8002] OF WORD;             { Buffer }
  40.   VAR
  41.     vs     : ViewPortType;     { Grafikfenster-Koordinaten }
  42.     bf     : ^BFType;          { Zeiger auf Buffer         }
  43.   BEGIN
  44.     New(bf);              { Buffer auf dem Heap einrichten }
  45.     GetViewSettings(vs);  { x/y-Koordinaten des            }
  46.                           { Grafikfensters ermitteln       }
  47.     WITH vs DO BEGIN
  48.       CASE direction OF
  49.         UP     : BEGIN                  { nach oben rollen }
  50.                    GetImage(0, anz, x2-x1, y2-y1, bf^);
  51.                    PutImage(0, 0, bf^, NormalPut);
  52.                    SetViewPort(x1, y2-anz, x2, y2, TRUE);
  53.                 END;
  54.         DOWN  : BEGIN                  { nach unten rollen }
  55.                   GetImage(0, 0, x2-x1, y2-y1-anz, bf^);
  56.                   PutImage(0, anz, bf^, NormalPut);
  57.                   SetViewPort(x1, y1, x2, y1+anz, TRUE);
  58.                 END;
  59.         LEFT  : BEGIN                  { nach links rollen }
  60.                   GetImage(anz, 0, x2-x1, y2-y1, bf^);
  61.                   PutImage(0, 0, bf^, NormalPut);
  62.                   SetViewPort(x2-anz, y1, x2, y2, TRUE);
  63.                 END;
  64.         RIGHT : BEGIN                 { nach rechts rollen }
  65.                   GetImage(0, 0, x2-x1-anz, y2-y1, bf^);
  66.                   PutImage(anz, 0, bf^, NormalPut);
  67.                   SetViewPort(x1, y1, x1+anz, y2, TRUE);
  68.                 END;
  69.       END; { case }
  70.       ClearViewPort;                    { Zeilen auffüllen }
  71.       SetViewPort(x1, y1, x2, y2, clip);
  72.                         { Grafikfenster auf Originalgröße  }
  73.       Dispose(bf);      { Buffer wieder vom Heap entfernen }
  74.     END;
  75.   END;
  76.  
  77.   PROCEDURE ScrollWindow;
  78.   VAR
  79.     loop   : BYTE;
  80.     anzahl : INTEGER;
  81.     xn, xm : POINTER;
  82.   BEGIN
  83.     Dec(x1);  Dec(x2);
  84.     Dec(y1);  Dec(y2);
  85.     FOR anzahl := 1 TO anz DO
  86.       CASE direction OF
  87.         UP    : BEGIN
  88.                                 { Bildspeicher verschieben }
  89.                   FOR loop := y1 TO Pred(y2) DO BEGIN
  90.                     xn := Ptr(ScrSeg, (loop+1)*160 + x1*2);
  91.                     xm := Ptr(ScrSeg, loop*160 + x1*2);
  92.                     Move(xn^, xm^, 2*Succ(x2-x1));
  93.                   END;
  94.                   { entstandene neue Zeile mit TextAttr    }
  95.                   { auffüllen                              }
  96.                   FOR loop := x1 TO x2 DO
  97.                     MemW[ScrSeg:y2 * 160 + loop * 2] :=
  98.                                         32 + TextAttr SHL 8;
  99.                 END;
  100.         DOWN  : BEGIN
  101.                   FOR loop := Pred(y2) DOWNTO y1 DO BEGIN
  102.                     xn := Ptr(ScrSeg, (loop+1)*160 + x1*2);
  103.                     xm := Ptr(ScrSeg, loop*160 + x1*2);
  104.                     Move(xm^, xn^, 2*Succ(x2-x1));
  105.                   END;
  106.                   FOR loop := x1 TO x2 DO
  107.                       MemW[ScrSeg:y1 * 160 + loop * 2] :=
  108.                                         32 + TextAttr SHL 8;
  109.                 END;
  110.         LEFT  : BEGIN
  111.                   FOR loop := y1 TO y2 DO BEGIN
  112.                     xn := Ptr(ScrSeg,loop*160 + Succ(x1)*2);
  113.                     xm := Ptr(ScrSeg,loop*160 + x1*2);
  114.                     Move(xn^, xm^, 2*(x2-x1));
  115.                   END;
  116.                   FOR loop := y1 TO y2 DO
  117.                     MemW[ScrSeg:loop * 160 + x2 * 2] :=
  118.                                         32 + TextAttr SHL 8;
  119.                 END;
  120.         RIGHT : BEGIN
  121.                   FOR loop := y1 TO y2 DO BEGIN
  122.                     xn := Ptr(ScrSeg,loop*160 + Succ(x1)*2);
  123.                     xm := Ptr(ScrSeg,loop*160 + x1*2);
  124.                     Move(xm^, xn^, 2*(x2-x1));
  125.                   END;
  126.                   FOR loop := y1 TO y2 DO
  127.                     MemW[ScrSeg:loop * 160 + x1 * 2] :=
  128.                                         32 + TextAttr SHL 8;
  129.                 END;
  130.       END; { case / for}
  131.     END; { von ScrollWindow }
  132.  
  133. BEGIN
  134.   DetectGraph(GDriver, GMode);
  135.   IF GDriver IN [CGA, EGA, VGA] THEN ScrSeg := $B800
  136.                                 ELSE ScrSeg := $B000;
  137. END.
  138. (* ------------------------------------------------------ *)
  139. (*               Ende von SCROLL.PAS                      *)