home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 08 / grdlagen / standwin.pas < prev    next >
Pascal/Delphi Source File  |  1990-07-05  |  9KB  |  265 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    STANDWIN.PAS                        *)
  3. (*      Diese Unit implementiert ein Fensterobjekt.       *)
  4. (*         Vorausgesetzt wird die Unit "SimWin",          *)
  5. (*        von deren Objekt "SimpleWindow" das hier        *)
  6. (*      implementierte Objekt "StandardWindow" erbt.      *)
  7. (*            (c) 1990 R.Reichert & TOOLBOX               *)
  8. (* ------------------------------------------------------ *)
  9. UNIT StandWin;
  10.  
  11. INTERFACE
  12.  
  13. USES SimWin;
  14.  
  15. (* ------------------------------------------------------ *)
  16. (* Ein Standardfenster muß laut SAA Schatten haben, es    *)
  17. (* muß vergrößert und verkleinert werden können.          *)
  18. (* Diese Forderungen sind in "StandardWindow" realisiert. *)
  19. (* ------------------------------------------------------ *)
  20.  
  21. TYPE
  22.                         (* Ein Zeiger auf StandardWindow: *)
  23.   StandardWindowPtr = ^StandardWindow;
  24.   StandardWindow    = OBJECT (SimpleWindow)
  25.                           (* ------neue Variablen-------- *)
  26.                          xmin, ymin,    (* Bewegungs- und *)
  27.                          xmax, ymax,    (* Zoomgrenzen    *)
  28.                          ShaXl, ShaYl,  (* Schattenlängen *)
  29.                          ShaTSpace,     (* -leerräume     *)
  30.                          ShaLSpace      : INTEGER;
  31.                          ShaChr         : CHAR;
  32.                          ShaColor       : BYTE;
  33.                          MoveAllowed,   (* Bew. erlaubt ? *)
  34.                          ZoomAllowed,   (* Zoom    "    ? *)
  35.                          ShaTranspar,   (* Transparent ?  *)
  36.                          ShaVisible     : BOOLEAN;
  37.                           (* -Neue oder neu implementierte
  38.                               Methoden------------------- *)
  39.                          CONSTRUCTOR Init
  40.                                      (Data: Standardwindow);
  41.                          PROCEDURE Open;       VIRTUAL;
  42.                          PROCEDURE CheckData;  VIRTUAL;
  43.                          PROCEDURE DrawShadow; VIRTUAL;
  44.                          PROCEDURE ReOpen
  45.                                   (NewData: StandardWindow);
  46.                          PROCEDURE NewMinMax
  47.                         (Nxmin, Nymin, Nxmax, Nymax : BYTE);
  48.                            (* Setzt neue Bewegungsgrenzen *)
  49.                          PROCEDURE MoveWinRel
  50.                                      (Xrel,Yrel : SHORTINT);
  51.                            (* Rel. Bewegung, xrel und yrel
  52.                                 beziehen sich auf x1,y1 ! *)
  53.                          PROCEDURE ZoomWinRel
  54.                                      (XRel,YRel : SHORTINT);
  55.                            (* Rel. Vergrößern, xrel und
  56.                               yrel beziehen sich hier auf
  57.                               x2,y2; x1,y1 bleibt an der
  58.                               selben Stelle               *)
  59.                          PROCEDURE MoveWinAbs
  60.                                 (xabs,yabs : BYTE); VIRTUAL;
  61.                            (* Abs. bewegen, dh:
  62.                               x1=xabs, y1=yabs und x2,y2
  63.                               dementsprechend             *)
  64.                          PROCEDURE ZoomWinAbs
  65.                                 (xabs,yabs : BYTE); VIRTUAL;
  66.                            (* Abs. vergrößern, d.h.:
  67.                               x2=xabs, y2=yabs, x1 und y1
  68.                               bleiben unverändert.        *)
  69.                       END;
  70.  
  71.   ScreenObj         = OBJECT (SimWin.ScreenObj)
  72.                         PROCEDURE WriteAttr
  73.                                           (x,y,attr : BYTE);
  74.                       (* Ändert das Attribut *NUR* an x,y *)
  75.                         PROCEDURE FillAttr
  76.                                   (x1,y1,x2,y2,Attr : BYTE);
  77.                       (* Ändert Attribut in dem angegebenen
  78.                          Bereich x1-x2, y1-y2 *)
  79.                         PROCEDURE FillChr
  80.                        (x1,y1,x2,y2,attr : BYTE; Ch : CHAR);
  81.                       (* Füllt den angegebenen Bereich mit
  82.                          Zeichen ch und Attribut Attr *)
  83.                       END;
  84. CONST
  85.                 (* Wiederum ein Experimentier-Fensterchen *)
  86.   StandWinData : StandardWindow =
  87.     ( x1: 1; y1: 1; x2: 30; y2: 10; xl : 29; yl: 9;
  88.  
  89.       FrameArt  :  4;           FrameColor   : 15+7*16;
  90.       BackColor :  0;
  91.       TopLColor : 15;           BottomLColor : 15;
  92.       TopLine   : ' TopLine ';  BottomLine   : ' HeadLine ';
  93.       TopLPos   : Center;       BottomLPos   : Right;
  94.       FrameChrs : '';
  95.       Visible   : TRUE;         FrameVisible : TRUE;
  96.       SaveBack  : TRUE;         BackSaved    : FALSE;
  97.       ClearWin  : TRUE;
  98.       BackGround: NIL;
  99.       xmin : 1;   ymin: 1;   xmax: 80;   ymax: 25;
  100.       ShaXl     : 2;            ShaYl        :  1;
  101.       ShaTSpace : 2;            ShaLSpace    :  2;
  102.       ShaChr    : '░';          ShaColor     : 15;
  103.  
  104.       MoveAllowed : TRUE;       ZoomAllowed : TRUE;
  105.       ShaTranspar : TRUE;       ShaVisible  : TRUE);
  106. VAR
  107.   (* Öffentlich: Screen-Routinen und der Zeiger auf
  108.                  den Bildschirmspeicher                   *)
  109.   ScrProc : ScreenObj;
  110.   Screen  : ^ScreenType;
  111.  
  112. IMPLEMENTATION
  113.  
  114. (* ------------------------------------------------------ *)
  115. (* Screen-Routinen => keine Bereichsüberprüfung           *)
  116. (* Für nähere Erklärungen siehe toolbox 12'89, S.28       *)
  117. (* ------------------------------------------------------ *)
  118.  
  119.   PROCEDURE ScreenObj.WriteAttr(x, y, attr : BYTE);
  120.   BEGIN
  121.     Screen^[y,x] := Lo(Screen^[y,x]) + Attr SHL 8;
  122.   END;
  123.  
  124.   PROCEDURE ScreenObj.FillAttr(x1, y1, x2, y2, Attr : BYTE);
  125.   VAR
  126.     j, i : BYTE;
  127.   BEGIN
  128.     FOR i := y1 TO y2 DO
  129.       FOR j := x1 TO x2 DO
  130.         WriteAttr(j, i, Attr);
  131.   END;
  132.  
  133.   PROCEDURE ScreenObj.FillChr(x1, y1, x2, y2, Attr : BYTE;
  134.                               Ch : CHAR);
  135.   VAR
  136.     j, i : BYTE;
  137.   BEGIN
  138.     FOR i := y1 TO y2 DO
  139.       FOR j := x1 TO x2 DO
  140.         WriteChr(j, i, Attr, ch);
  141.   END;
  142.  
  143.   (* ---------------------------------------------------- *)
  144.   (* Implementieren der Methoden von StandardWindow       *)
  145.   (* ---------------------------------------------------- *)
  146.  
  147.   CONSTRUCTOR StandardWindow.Init(Data : StandardWindow);
  148.   BEGIN
  149.     Background := NIL;
  150.     BackSaved  := FALSE;
  151.     Visible    := FALSE;
  152.     Self       := Data
  153.   END;
  154.  
  155.   PROCEDURE StandardWindow.Open;
  156.   BEGIN
  157.     SimpleWindow.Open;
  158.          (* Fenster zuerst öffnen - und Hintergrund
  159.             sichern, *bevor* der Schatten gezeichnet wird.*)
  160.     DrawShadow;
  161.   END;
  162.  
  163.   PROCEDURE StandardWindow.CheckData;
  164.   BEGIN
  165.     SimpleWindow.CheckData;
  166.     xl := x2 - x1 +ShaXl;
  167.     yl := y2 - y1 +ShaYl;
  168.     IF NOT ShaVisible THEN BEGIN
  169.       ShaXl := 0;
  170.       ShaYl := 0
  171.     END;
  172.     IF xmin <  1 THEN xmin :=  1;
  173.     IF ymin <  1 THEN ymin :=  1;
  174.     IF xmax > 80 THEN xmax := 80;
  175.     IF ymax > 25 THEN ymax := 25;
  176.     IF xmin > x1 THEN xmin := x1;
  177.     IF ymin > y1 THEN ymin := y1;
  178.     IF xmax < x2 THEN xmax := x2;
  179.     IF ymax < y2 THEN ymax := y2
  180.   END;
  181.  
  182.   PROCEDURE StandardWindow.DrawShadow;
  183.   VAR
  184.     i : INTEGER;
  185.   BEGIN
  186.     IF NOT ShaVisible THEN Exit;
  187.     WITH ScrProc DO
  188.       IF ShaTranspar THEN BEGIN
  189.         FillAttr(Succ(x2), y1 + ShaTSpace,
  190.                  x2 + ShaXl, y2 + ShaYl, ShaColor);
  191.         FillAttr(x1 + ShaLSpace, Succ(y2),
  192.                  x2, y2 + ShaYl, ShaColor)
  193.       END ELSE BEGIN
  194.         FillChr(Succ(x2), y1 + ShaTSpace,
  195.                 x2 + ShaXl, y2 + ShaYl, ShaColor, ShaChr);
  196.         FillChr(x1 + ShaLSpace, Succ(y2),
  197.                 x2, y2 + ShaYl, ShaColor, ShaChr);
  198.       END;
  199.   END;
  200.  
  201.   PROCEDURE StandardWindow.ReOpen(NewData: StandardWindow);
  202.   BEGIN
  203.     Close;
  204.     Self := NewData;
  205.     Open;
  206.   END;
  207.  
  208.   PROCEDURE StandardWindow.NewMinMax
  209.                         (Nxmin, Nymin, Nxmax, Nymax : BYTE);
  210.   BEGIN
  211.     IF (Nxmin<1) OR (Nxmax>80) OR
  212.        (Nymin<1) OR (Nymax>25) OR
  213.        (Nxmin>Nxmax) OR (Nymin>Nymax) THEN
  214.       ErrMsg(WinWrMM);
  215.     xmin := NXmin;
  216.     ymin := Nymin;
  217.     xmax := Nxmax;
  218.     ymax := Nymax
  219.   END;
  220.  
  221.   PROCEDURE StandardWindow.MoveWinRel(xrel,yrel : SHORTINT);
  222.   BEGIN
  223.     MoveWinAbs(Abs(x1+xrel), Abs(y1+yrel));
  224.   END;
  225.  
  226.   PROCEDURE StandardWindow.ZoomWinRel(xrel,yrel : SHORTINT);
  227.   BEGIN
  228.     ZoomWinAbs(Abs(x2+xrel), Abs(y2+yrel));
  229.   END;
  230.  
  231.   PROCEDURE StandardWindow.MoveWinAbs(xabs, yabs : BYTE);
  232.   BEGIN
  233.     IF NOT MoveAllowed OR NOT Visible THEN Exit;
  234.     IF (xabs < xmin) OR (xabs + Xl > xmax) OR
  235.        (yabs < ymin) OR (yabs + yl > ymax) THEN
  236.       ErrMsg(WinMoErr);
  237.     Close;
  238.     x2 := xabs + x2 - x1;
  239.     y2 := yabs + y2 - y1;
  240.     x1 := xabs;
  241.     y1 := yabs;
  242.     Open;
  243.   END;
  244.  
  245.   PROCEDURE StandardWindow.ZoomWinAbs(xabs, yabs : BYTE);
  246.   BEGIN
  247.     IF NOT ZoomAllowed OR NOT Visible THEN Exit;
  248.     IF (xabs + ShaXl > xmax) OR (yabs + ShaYl > ymax) THEN
  249.       ErrMsg(WinZoErr);
  250.     Close;
  251.     x2 := xabs;
  252.     y2 := yabs;
  253.     Open;
  254.   END;
  255.  
  256. BEGIN
  257.               (* den Zeiger auf Bildschirmspeicher setzen *)
  258.   IF Mem[$40:$49] = 7 THEN                 (* monochrom ? *)
  259.     Screen := Ptr($B000, $0000)
  260.   ELSE
  261.     Screen := Ptr($B800, $0000);
  262. END.
  263. (* ------------------------------------------------------ *)
  264. (*               Ende von STANDWIN.PAS                    *)
  265.