home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 07 / titel / simwin.pas next >
Pascal/Delphi Source File  |  1990-05-01  |  14KB  |  422 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     SIMWIN.PAS                         *)
  3. (*     Diese Unit stellt das Objekt "SimpleWindow" zur    *)
  4. (*     Verfügung, das die grundlegenden Routinen für      *)
  5. (*     ein Fenster beinhaltet.                            *)
  6. (*          (c) 1990 R.Reichert & TOOLBOX                 *)
  7. (* ------------------------------------------------------ *)
  8. UNIT SimWin;
  9.  
  10. INTERFACE
  11.  
  12. TYPE
  13.   ScreenType   = ARRAY [1..25, 1..80] OF WORD;
  14.                                         { Bildschirmpuffer }
  15.   TitlePos     = (Left, Center, Right);
  16.                           { Positon von Kopf- und Fußzeile }
  17.   SimpleWindow = OBJECT
  18.                    { --------- Instanzvariablen ---------- }
  19.                    x1, y1, x2, y2,      { Koordinaten      }
  20.                    xl, yl,              { x- und y-Längen  }
  21.                    FrameArt,            { Art des Rahmens  }
  22.                    FrameColor,          { dessen Farbe     }
  23.                    BackColor,           { Hintergrundfarbe }
  24.                    TopLColor,       { Kopf- und Fußzeilen- }
  25.                    BottomLColor : BYTE;        { farbe     }
  26.                    TopLine,         { Kopf- und Fußzeile   }
  27.                    BottomLine   : STRING [80];
  28.                    TopLPos,             { Positionen       }
  29.                    BottomLPos   : TitlePos;{ Rahmenzeichen }
  30.                    FrameChrs    : STRING [8];
  31.                    Visible,             { Window sichtbar? }
  32.                    FrameVisible,        { Rahmen sichtbar? }
  33.                    SaveBack,          { Backgr. speichern? }
  34.                    BackSaved,        { Backgr. gespeichert }
  35.                                  { Window-Inhalt löschen ? }
  36.                    ClearWin     : BOOLEAN;
  37.                                   { Puffer für Hintergrund }
  38.                    BackGround   : POINTER;
  39.  
  40.                    { ---------- Methoden ----------------- }
  41.                    CONSTRUCTOR Init (Data : SimpleWindow);
  42.                    { Übernimmt die neuen "Data"            }
  43.  
  44.                    PROCEDURE Open; VIRTUAL;
  45.                    { Öffnet ein Window mit akt. Daten      }
  46.  
  47.                    PROCEDURE DrawFrame; VIRTUAL;
  48.                    { Zeichnet den Rahmen                   }
  49.  
  50.                    PROCEDURE WriteTitles; VIRTUAL;
  51.                    { Gibt Titel aus                        }
  52.  
  53.                    PROCEDURE StoreBack(a1,b1,a2,b2 : BYTE);
  54.                    { Speichert den Hintergrund             }
  55.  
  56.                    PROCEDURE RestoreBack
  57.                                        (a1,b1,a2,b2 : BYTE);
  58.                    { Restauriert den Hintergrund           }
  59.  
  60.                    PROCEDURE CheckData; VIRTUAL;
  61.                    { Prüft die Instanzen auf               }
  62.                    { ihre Gültigkeit                       }
  63.  
  64.                    PROCEDURE ReOpen(NewData : SimpleWindow);
  65.                    { Schließt akt. Window und              }
  66.                    { öffnet es neu mit NewData             }
  67.  
  68.                    PROCEDURE ChangeFrame(Nr : BYTE);
  69.                    { Ändert den Rahmen, wobei Nr           }
  70.                    { die Rahmenart (FrameArt) angibt       }
  71.  
  72.                    PROCEDURE Hide;
  73.                    { "Versteckt" das Fenster               }
  74.  
  75.                    PROCEDURE Show;
  76.                    { Holt Fenster wieder hervor            }
  77.  
  78.                    PROCEDURE Close; VIRTUAL;
  79.                    { Schließt das Fenster                  }
  80.  
  81.                    DESTRUCTOR Done; VIRTUAL;
  82.                    { Schließt das Fenster, falls noch      }
  83.                    { nicht geschehen                       }
  84.  
  85.                  END;
  86.  
  87.   { Dieses Objekt stellt einige Bildschirmroutinen zur     }
  88.   { Verfügung. Sie verändern SCREEN! Für nähere            }
  89.   { Erklärungen siehe toolbox 12/89, S.28ff                }
  90.  
  91.   ScreenObj = OBJECT
  92.                 PROCEDURE WriteChr(x, y, attr : BYTE;
  93.                                    ch         : CHAR);
  94.                 { Gibt ch mit Attr an x, y aus             }
  95.  
  96.                 PROCEDURE WriteStr(x, y, attr : BYTE;
  97.                                    s          : STRING);
  98.                 { analog zu WriteChr, nur mit s            }
  99.  
  100.                 PROCEDURE ClearWindow
  101.                               (x1, y1, x2, y2, Attr : BYTE);
  102.                 { löscht Ausschnitt mit Farbe Attr         }
  103.               END;
  104.  
  105. { -------------------------------------------------------- }
  106. {      Konstanten-Definitionen für Windows                 }
  107. { -------------------------------------------------------- }
  108.  
  109. CONST
  110.                { Die verschiedenen Rahmen, siehe Abbildung }
  111.   FrameNo = 5;
  112.   Frames : ARRAY [1..FrameNo] OF STRING [8] = ('┌┐└┘──││',
  113.                                                '╔╗╚╝══║║',
  114.                                                '╒╕╘╛══││',
  115.                                                '╓╖╙╜──║║',
  116.                                                '┌╖╘╝─═│║');
  117.            { Ein Standardfenster - gut zum Experimentieren }
  118.   SimpleWinData : SimpleWindow =
  119.     (x1 :  1;  y1 :  1;
  120.      x2 : 10;  y2 : 10;
  121.      xl :  9;  yl :  9;
  122.      FrameArt     :  4;
  123.      FrameColor   : 15 + 7*16;
  124.      BackColor    :  7;
  125.      TopLColor    : 15;
  126.      BottomLColor :  9;
  127.      TopLine      : ' TopLine ';
  128.      BottomLine   : ' HeadLine ';
  129.      TopLPos      : Center;
  130.      BottomLPos   : Right;
  131.      FrameChrs    : '';
  132.      Visible      : FALSE;
  133.      FrameVisible : TRUE;
  134.      SaveBack     : TRUE;
  135.      BackSaved    : FALSE;
  136.      ClearWin     : TRUE;
  137.      BackGround   : NIL);      { am besten nicht ändern! }
  138.  
  139.   { Als Hilfe zur Programmentwicklung: mögliche Fehler   }
  140.   { lassen sich anzeigen                                 }
  141.   WinShowErrors   : BOOLEAN = TRUE;
  142.  
  143.   WinNoErr    = 0;
  144.   WinWrKoord  = 1;
  145.   WinNoMem    = 2;
  146.   WinTitleErr = 3;
  147.   WinMoErr    = 4;
  148.   WinZoErr    = 5;
  149.   WinWrMM     = 6;
  150.  
  151.   WinErrMsgs : ARRAY [WinWrKoord..WinWrMM]
  152.                OF STRING [80] =
  153.       ('Falsche Koordinaten (x1 = x2 oder y1 = y2) !',
  154.        'Nicht genug Speicher, um Fenster zu öffnen !',
  155.        'Kopf- oder Fußzeile zu lang !',
  156.        'Falsche Angaben für Move !',
  157.        'Falsche Angaben für Zoom !',
  158.        'Falsche "Grenzen" !');
  159. VAR
  160.   Screen   : ^ScreenType;
  161.   WinError : BYTE;
  162.   ScrProc  : ScreenObj;          { Für die Bildschirmproz. }
  163.  
  164.  
  165.   PROCEDURE ErrMsg(Nr : BYTE);
  166.   { Gibt ev. Fehler aus, beendet Programm via "Halt"       }
  167.  
  168.  
  169. IMPLEMENTATION
  170.  
  171.   PROCEDURE ErrMsg(Nr : BYTE);
  172.   BEGIN
  173.     IF WinShowErrors THEN BEGIN
  174.       ScrProc.WriteStr
  175.             (40-Length(WinErrMsgs[Nr]) DIV 2, 25, $70,
  176.              WinErrMsgs[Nr]);
  177.       WinError := Nr;
  178.       IF WinError <> WinTitleErr THEN Halt
  179.                                  ELSE WinError := 0;
  180.     END;
  181.   END;
  182.  
  183.   { ------------------------------------------------------ }
  184.   {        Implementierung von ScreenObj.                  }
  185.   { Keine Bereichsüberprüfung wegen Geschwindigkeit !      }
  186.   { ------------------------------------------------------ }
  187.  
  188.   PROCEDURE ScreenObj.WriteChr(x, y, attr : BYTE;
  189.                                ch         : CHAR);
  190.   BEGIN
  191.     Screen^[y, x] := Ord(ch) + Attr SHL 8
  192.   END;
  193.  
  194.   PROCEDURE ScreenObj.WriteStr(x, y, attr : BYTE;
  195.                                s          : STRING);
  196.   VAR
  197.     i : BYTE;
  198.   BEGIN
  199.     FOR i := 1 TO Length(s) DO
  200.       Screen^[y, x+Pred(i)] := Ord(s[i]) + Attr SHL 8
  201.   END;
  202.  
  203.   PROCEDURE ScreenObj.ClearWindow
  204.                               (x1, y1, x2, y2, Attr : BYTE);
  205.   VAR
  206.     j, i : BYTE;
  207.     dx   : BYTE;
  208.   BEGIN
  209.     dx := 2 * Succ(x2-x1);
  210.                { Falls der Hintergrund schwarz sein soll, }
  211.                { geht das hier um 100% schneller...       }
  212.     IF Attr = 0 THEN
  213.       FOR i := y1 TO y2 DO FillChar (Screen^[i, x1], dx, 0)
  214.     ELSE
  215.       FOR i := y1 TO y2 DO
  216.         FOR j := x1 TO x2 DO
  217.           Screen^[i, j] := Ord ('█') + Attr SHL 8;
  218.   END;
  219.  
  220.   { ------------------------------------------------------ }
  221.   {  Implementierung der Methoden von SimpleWindow         }
  222.   { ------------------------------------------------------ }
  223.  
  224.   CONSTRUCTOR SimpleWindow.Init(Data : SimpleWindow);
  225.   BEGIN
  226.     BackGround := NIL;
  227.     BackSaved  := FALSE;
  228.     Visible    := FALSE;
  229.     Self       := Data;
  230.   END;
  231.  
  232.   PROCEDURE SimpleWindow.Open;
  233.   BEGIN
  234.     CheckData;
  235.     IF SaveBack THEN
  236.       StoreBack (x1, y1, x1+xl, y1+yl)
  237.     ELSE
  238.       BackSaved := FALSE;
  239.     IF ClearWin THEN
  240.       ScrProc.ClearWindow (x1, y1, x2, y2, BackColor);
  241.     IF FrameVisible THEN BEGIN
  242.       DrawFrame;
  243.       WriteTitles;
  244.     END;
  245.     Visible := TRUE;
  246.   END;
  247.  
  248.   PROCEDURE SimpleWindow.DrawFrame;
  249.   VAR
  250.     i : BYTE;
  251.   BEGIN
  252.     WITH ScrProc DO BEGIN
  253.       WriteChr(x1, y1, FrameColor, FrameChrs[1]);
  254.       WriteChr(x2, y1, FrameColor, FrameChrs[2]);
  255.       WriteChr(x1, y2, FrameColor, FrameChrs[3]);
  256.       WriteChr(x2, y2, FrameColor, FrameChrs[4]);
  257.       FOR i := Succ(x1) TO Pred(x2) DO BEGIN
  258.         WriteChr(i, y1, FrameColor, FrameChrs[5]);
  259.         WriteChr(i, y2, FrameColor, FrameChrs[6]);
  260.       END;
  261.       FOR i := Succ(y1) TO Pred(y2) DO BEGIN
  262.         WriteChr(x1, i, FrameColor, FrameChrs[7]);
  263.         WriteChr(x2, i, FrameColor, FrameChrs[8]);
  264.       END;
  265.     END;
  266.   END;
  267.  
  268.   PROCEDURE SimpleWindow.WriteTitles;
  269.   VAR
  270.     x : BYTE;
  271.  
  272.     PROCEDURE GetPos(str : STRING; Pos: TitlePos;
  273.                      VAR x : BYTE);
  274.     BEGIN
  275.       CASE Pos OF
  276.         Left   : x := Succ(x1);
  277.         Center : x := (x1 + (x2 - x1) DIV 2) -
  278.                        Length(str) DIV 2;
  279.         Right  : x := Pred(x2) - Length(str);
  280.       END;
  281.     END;
  282.  
  283.   BEGIN
  284.     IF Length(TopLine) > x2 - x1 - 2 THEN
  285.       ErrMsg(WinTitleErr)
  286.                { Prozedur noch nicht beenden, Fußzeile muß }
  287.                { auch geprüft werden !                     }
  288.     ELSE BEGIN
  289.       GetPos(TopLine, TopLPos, x);
  290.       ScrProc.WriteStr(x, y1, TopLColor, TopLine);
  291.     END;
  292.     IF Length(BottomLine) > x2 - x1 - 2 THEN BEGIN
  293.       ErrMsg(WinTitleErr);
  294.       Exit;
  295.     END;
  296.     GetPos(BottomLine, BottomLPos, x);
  297.     ScrProc.WriteStr(x, y2, BottomLColor, BottomLine);
  298.   END;
  299.  
  300.   PROCEDURE SimpleWindow.StoreBack(a1, b1, a2, b2 : BYTE);
  301.   VAR
  302.     s : INTEGER;
  303.  
  304.     PROCEDURE SaveScreen(VAR p);
  305.     VAR
  306.       dx, i   : INTEGER;
  307.       TempMem : ScreenType ABSOLUTE p;
  308.     BEGIN
  309.       dx := 2 * Succ(a2-a1);
  310.       FOR i := b1 TO b2 DO
  311.         Move(Screen ^[i, a1], TempMem[i, a1], dx)
  312.     END;
  313.  
  314.   BEGIN
  315.     s := 2 * Succ(a2-a1) * Succ(b2-b1);
  316.     IF MemAvail < s THEN ErrMsg(WinNoMem);
  317.     GetMem(Background, s);
  318.     SaveScreen(BackGround^);
  319.     BackSaved := TRUE
  320.   END;
  321.  
  322.   PROCEDURE SimpleWindow.RestoreBack(a1, b1, a2, b2 : BYTE);
  323.   VAR
  324.     s : INTEGER;
  325.  
  326.     PROCEDURE LoadScreen(VAR p);
  327.     VAR
  328.       dx, i   : INTEGER;
  329.       TempMem : ScreenType ABSOLUTE p;
  330.     BEGIN
  331.       dx := 2 * Succ(a2-a1);
  332.       FOR i := b1 TO b2 DO
  333.         Move(TempMem[i, a1], Screen ^[i, a1], dx);
  334.     END;
  335.  
  336.   BEGIN
  337.     s := 2 * Succ(a2-a1) * Succ(b2-b1);
  338.     LoadScreen(BackGround^);
  339.     FreeMem(BackGround, s);
  340.   END;
  341.  
  342.   PROCEDURE SimpleWindow.CheckData;
  343.  
  344.     PROCEDURE Swap(VAR i, j : BYTE);
  345.     VAR
  346.       h : BYTE;
  347.     BEGIN
  348.       h := i;  i := j;  j := h;
  349.     END;
  350.  
  351.   BEGIN
  352.     WinError := WinNoErr;
  353.     IF (FrameArt < 1) OR (FrameArt > FrameNo) THEN
  354.       FrameArt := 1;
  355.     FrameChrs := Frames[FrameArt];
  356.     IF (x1 < 1) THEN x1 := 1;  IF (x1 > 80) THEN x1 := 80;
  357.     IF (x2 < 1) THEN x2 := 1;  IF (x2 > 80) THEN x2 := 80;
  358.     IF (y1 < 1) THEN y1 := 1;  IF (y1 > 25) THEN y1 := 25;
  359.     IF (y2 < 1) THEN y2 := 1;  IF (y2 > 25) THEN y2 := 25;
  360.     IF x1 > x2 THEN Swap(x1, x2);
  361.     IF y1 > y2 THEN Swap(y1, y2);
  362.     IF (x1 = x2) OR (y1 = y2) THEN ErrMsg(WinWrKoord);
  363.     xl := x2 - x1;
  364.     yl := y2 - y1
  365.   END;
  366.  
  367.   PROCEDURE SimpleWindow.ReOpen(NewData: SimpleWindow);
  368.   BEGIN
  369.     Close;
  370.     Self := NewData;
  371.     Open;
  372.   END;
  373.  
  374.   PROCEDURE SimpleWindow.ChangeFrame(Nr : BYTE);
  375.   BEGIN
  376.     IF Visible AND FrameVisible THEN BEGIN
  377.       IF (Nr < 1) OR (Nr > FrameNo) THEN Nr := 1;
  378.       FrameArt := Nr;
  379.       FrameChrs := Frames[FrameArt];
  380.       DrawFrame;
  381.       WriteTitles;
  382.     END;
  383.   END;
  384.  
  385.   PROCEDURE SimpleWindow.Hide;
  386.   BEGIN
  387.     IF Visible THEN RestoreBack(x1, y1, x1+xl, y1+yl);
  388.     Visible := FALSE
  389.   END;
  390.  
  391.   PROCEDURE SimpleWindow.Show;
  392.   BEGIN
  393.     IF NOT Visible THEN Open;
  394.     Visible := TRUE
  395.   END;
  396.  
  397.   PROCEDURE SimpleWindow.Close;
  398.   BEGIN
  399.     IF BackSaved AND Visible THEN
  400.       RestoreBack (x1, y1, x1+xl, y1+yl);
  401.     Visible := FALSE;
  402.   END;
  403.  
  404.   DESTRUCTOR SimpleWindow.Done;
  405.   BEGIN
  406.     Close;
  407.   END;
  408.  
  409. { -------------------------------------------------------- }
  410. {        Initialisierungsteil der Unit                     }
  411. { -------------------------------------------------------- }
  412. BEGIN
  413.   WinError := WinNoErr;                 { noch kein Fehler }
  414.                    { Screen auf Bildschirmspeicher setzen  }
  415.   IF Mem[$40:$49] = 7 THEN                   { monochrom ? }
  416.     Screen := Ptr($B000, $0000)
  417.   ELSE
  418.     Screen := Ptr($B800, $0000)
  419. END.
  420. (* ------------------------------------------------------ *)
  421. (*              Ende von SIMWIN.PAS                       *)
  422.