Turbo Toolbox/Turbo_Toolbox.iso/1990/08/grdlagen/simwin.pas

Pascal/Delphi Source File | 1990-05-02 | 13.2 KB | 422 lines

(* ------------------------------------------------------ *)
(*                     SIMWIN.PAS                         *)
(*     Diese Unit stellt das Objekt "SimpleWindow" zur    *)
(*     Verfügung, das die grundlegenden Routinen für      *)
(*     ein Fenster beinhaltet.                            *)
(*          (c) 1990 R.Reichert & TOOLBOX                 *)
(* ------------------------------------------------------ *)
UNIT SimWin;

INTERFACE

TYPE
  ScreenType   = ARRAY [1..25, 1..80] OF WORD;
                                        { Bildschirmpuffer }
  TitlePos     = (Left, Center, Right);
                          { Positon von Kopf- und Fußzeile }
  SimpleWindow = OBJECT
                   { --------- Instanzvariablen ---------- }
                   x1, y1, x2, y2,      { Koordinaten      }
                   xl, yl,              { x- und y-Längen  }
                   FrameArt,            { Art des Rahmens  }
                   FrameColor,          { dessen Farbe     }
                   BackColor,           { Hintergrundfarbe }
                   TopLColor,       { Kopf- und Fußzeilen- }
                   BottomLColor : BYTE;        { farbe     }
                   TopLine,         { Kopf- und Fußzeile   }
                   BottomLine   : STRING [80];
                   TopLPos,             { Positionen       }
                   BottomLPos   : TitlePos;{ Rahmenzeichen }
                   FrameChrs    : STRING [8];
                   Visible,             { Window sichtbar? }
                   FrameVisible,        { Rahmen sichtbar? }
                   SaveBack,          { Backgr. speichern? }
                   BackSaved,        { Backgr. gespeichert }
                                 { Window-Inhalt löschen ? }
                   ClearWin     : BOOLEAN;
                                  { Puffer für Hintergrund }
                   BackGround   : POINTER;

                   { ---------- Methoden ----------------- }
                   CONSTRUCTOR Init (Data : SimpleWindow);
                   { Übernimmt die neuen "Data"            }

                   PROCEDURE Open; VIRTUAL;
                   { Öffnet ein Window mit akt. Daten      }

                   PROCEDURE DrawFrame; VIRTUAL;
                   { Zeichnet den Rahmen                   }

                   PROCEDURE WriteTitles; VIRTUAL;
                   { Gibt Titel aus                        }

                   PROCEDURE StoreBack(a1,b1,a2,b2 : BYTE);
                   { Speichert den Hintergrund             }

                   PROCEDURE RestoreBack
                                       (a1,b1,a2,b2 : BYTE);
                   { Restauriert den Hintergrund           }

                   PROCEDURE CheckData; VIRTUAL;
                   { Prüft die Instanzen auf               }
                   { ihre Gültigkeit                       }

                   PROCEDURE ReOpen(NewData : SimpleWindow);
                   { Schließt akt. Window und              }
                   { öffnet es neu mit NewData             }

                   PROCEDURE ChangeFrame(Nr : BYTE);
                   { Ändert den Rahmen, wobei Nr           }
                   { die Rahmenart (FrameArt) angibt       }

                   PROCEDURE Hide;
                   { "Versteckt" das Fenster               }

                   PROCEDURE Show;
                   { Holt Fenster wieder hervor            }

                   PROCEDURE Close; VIRTUAL;
                   { Schließt das Fenster                  }

                   DESTRUCTOR Done; VIRTUAL;
                   { Schließt das Fenster, falls noch      }
                   { nicht geschehen                       }

                 END;

  { Dieses Objekt stellt einige Bildschirmroutinen zur     }
  { Verfügung. Sie verändern SCREEN! Für nähere            }
  { Erklärungen siehe toolbox 12/89, S.28ff                }

  ScreenObj = OBJECT
                PROCEDURE WriteChr(x, y, attr : BYTE;
                                   ch         : CHAR);
                { Gibt ch mit Attr an x, y aus             }

                PROCEDURE WriteStr(x, y, attr : BYTE;
                                   s          : STRING);
                { analog zu WriteChr, nur mit s            }

                PROCEDURE ClearWindow
                              (x1, y1, x2, y2, Attr : BYTE);
                { löscht Ausschnitt mit Farbe Attr         }
              END;

{ -------------------------------------------------------- }
{      Konstanten-Definitionen für Windows                 }
{ -------------------------------------------------------- }

CONST
               { Die verschiedenen Rahmen, siehe Abbildung }
  FrameNo = 5;
  Frames : ARRAY [1..FrameNo] OF STRING [8] = ('┌┐└┘──││',
                                               '╔╗╚╝══║║',
                                               '╒╕╘╛══││',
                                               '╓╖╙╜──║║',
                                               '┌╖╘╝─═│║');
           { Ein Standardfenster - gut zum Experimentieren }
  SimpleWinData : SimpleWindow =
    (x1 :  1;  y1 :  1;
     x2 : 10;  y2 : 10;
     xl :  9;  yl :  9;
     FrameArt     :  4;
     FrameColor   : 15 + 7*16;
     BackColor    :  7;
     TopLColor    : 15;
     BottomLColor :  9;
     TopLine      : ' TopLine ';
     BottomLine   : ' HeadLine ';
     TopLPos      : Center;
     BottomLPos   : Right;
     FrameChrs    : '';
     Visible      : FALSE;
     FrameVisible : TRUE;
     SaveBack     : TRUE;
     BackSaved    : FALSE;
     ClearWin     : TRUE;
     BackGround   : NIL);      { am besten nicht ändern! }

  { Als Hilfe zur Programmentwicklung: mögliche Fehler   }
  { lassen sich anzeigen                                 }
  WinShowErrors   : BOOLEAN = TRUE;

  WinNoErr    = 0;
  WinWrKoord  = 1;
  WinNoMem    = 2;
  WinTitleErr = 3;
  WinMoErr    = 4;
  WinZoErr    = 5;
  WinWrMM     = 6;

  WinErrMsgs : ARRAY [WinWrKoord..WinWrMM]
               OF STRING [80] =
      ('Falsche Koordinaten (x1 = x2 oder y1 = y2) !',
       'Nicht genug Speicher, um Fenster zu öffnen !',
       'Kopf- oder Fußzeile zu lang !',
       'Falsche Angaben für Move !',
       'Falsche Angaben für Zoom !',
       'Falsche "Grenzen" !');
VAR
  Screen   : ^ScreenType;
  WinError : BYTE;
  ScrProc  : ScreenObj;          { Für die Bildschirmproz. }


  PROCEDURE ErrMsg(Nr : BYTE);
  { Gibt ev. Fehler aus, beendet Programm via "Halt"       }


IMPLEMENTATION

  PROCEDURE ErrMsg(Nr : BYTE);
  BEGIN
    IF WinShowErrors THEN BEGIN
      ScrProc.WriteStr
            (40-Length(WinErrMsgs[Nr]) DIV 2, 25, $70,
             WinErrMsgs[Nr]);
      WinError := Nr;
      IF WinError <> WinTitleErr THEN Halt
                                 ELSE WinError := 0;
    END;
  END;

  { ------------------------------------------------------ }
  {        Implementierung von ScreenObj.                  }
  { Keine Bereichsüberprüfung wegen Geschwindigkeit !      }
  { ------------------------------------------------------ }

  PROCEDURE ScreenObj.WriteChr(x, y, attr : BYTE;
                               ch         : CHAR);
  BEGIN
    Screen^[y, x] := Ord(ch) + Attr SHL 8
  END;

  PROCEDURE ScreenObj.WriteStr(x, y, attr : BYTE;
                               s          : STRING);
  VAR
    i : BYTE;
  BEGIN
    FOR i := 1 TO Length(s) DO
      Screen^[y, x+Pred(i)] := Ord(s[i]) + Attr SHL 8
  END;

  PROCEDURE ScreenObj.ClearWindow
                              (x1, y1, x2, y2, Attr : BYTE);
  VAR
    j, i : BYTE;
    dx   : BYTE;
  BEGIN
    dx := 2 * Succ(x2-x1);
               { Falls der Hintergrund schwarz sein soll, }
               { geht das hier um 100% schneller...       }
    IF Attr = 0 THEN
      FOR i := y1 TO y2 DO FillChar (Screen^[i, x1], dx, 0)
    ELSE
      FOR i := y1 TO y2 DO
        FOR j := x1 TO x2 DO
          Screen^[i, j] := Ord ('█') + Attr SHL 8;
  END;

  { ------------------------------------------------------ }
  {  Implementierung der Methoden von SimpleWindow         }
  { ------------------------------------------------------ }

  CONSTRUCTOR SimpleWindow.Init(Data : SimpleWindow);
  BEGIN
    BackGround := NIL;
    BackSaved  := FALSE;
    Visible    := FALSE;
    Self       := Data;
  END;

  PROCEDURE SimpleWindow.Open;
  BEGIN
    CheckData;
    IF SaveBack THEN
      StoreBack (x1, y1, x1+xl, y1+yl)
    ELSE
      BackSaved := FALSE;
    IF ClearWin THEN
      ScrProc.ClearWindow (x1, y1, x2, y2, BackColor);
    IF FrameVisible THEN BEGIN
      DrawFrame;
      WriteTitles;
    END;
    Visible := TRUE;
  END;

  PROCEDURE SimpleWindow.DrawFrame;
  VAR
    i : BYTE;
  BEGIN
    WITH ScrProc DO BEGIN
      WriteChr(x1, y1, FrameColor, FrameChrs[1]);
      WriteChr(x2, y1, FrameColor, FrameChrs[2]);
      WriteChr(x1, y2, FrameColor, FrameChrs[3]);
      WriteChr(x2, y2, FrameColor, FrameChrs[4]);
      FOR i := Succ(x1) TO Pred(x2) DO BEGIN
        WriteChr(i, y1, FrameColor, FrameChrs[5]);
        WriteChr(i, y2, FrameColor, FrameChrs[6]);
      END;
      FOR i := Succ(y1) TO Pred(y2) DO BEGIN
        WriteChr(x1, i, FrameColor, FrameChrs[7]);
        WriteChr(x2, i, FrameColor, FrameChrs[8]);
      END;
    END;
  END;

  PROCEDURE SimpleWindow.WriteTitles;
  VAR
    x : BYTE;

    PROCEDURE GetPos(str : STRING; Pos: TitlePos;
                     VAR x : BYTE);
    BEGIN
      CASE Pos OF
        Left   : x := Succ(x1);
        Center : x := (x1 + (x2 - x1) DIV 2) -
                       Length(str) DIV 2;
        Right  : x := Pred(x2) - Length(str);
      END;
    END;

  BEGIN
    IF Length(TopLine) > x2 - x1 - 2 THEN
      ErrMsg(WinTitleErr)
               { Prozedur noch nicht beenden, Fußzeile muß }
               { auch geprüft werden !                     }
    ELSE BEGIN
      GetPos(TopLine, TopLPos, x);
      ScrProc.WriteStr(x, y1, TopLColor, TopLine);
    END;
    IF Length(BottomLine) > x2 - x1 - 2 THEN BEGIN
      ErrMsg(WinTitleErr);
      Exit;
    END;
    GetPos(BottomLine, BottomLPos, x);
    ScrProc.WriteStr(x, y2, BottomLColor, BottomLine);
  END;

  PROCEDURE SimpleWindow.StoreBack(a1, b1, a2, b2 : BYTE);
  VAR
    s : INTEGER;

    PROCEDURE SaveScreen(VAR p);
    VAR
      dx, i   : INTEGER;
      TempMem : ScreenType ABSOLUTE p;
    BEGIN
      dx := 2 * Succ(a2-a1);
      FOR i := b1 TO b2 DO
        Move(Screen ^[i, a1], TempMem[i, a1], dx)
    END;

  BEGIN
    s := 2 * Succ(a2-a1) * Succ(b2-b1);
    IF MemAvail < s THEN ErrMsg(WinNoMem);
    GetMem(Background, s);
    SaveScreen(BackGround^);
    BackSaved := TRUE
  END;

  PROCEDURE SimpleWindow.RestoreBack(a1, b1, a2, b2 : BYTE);
  VAR
    s : INTEGER;

    PROCEDURE LoadScreen(VAR p);
    VAR
      dx, i   : INTEGER;
      TempMem : ScreenType ABSOLUTE p;
    BEGIN
      dx := 2 * Succ(a2-a1);
      FOR i := b1 TO b2 DO
        Move(TempMem[i, a1], Screen ^[i, a1], dx);
    END;

  BEGIN
    s := 2 * Succ(a2-a1) * Succ(b2-b1);
    LoadScreen(BackGround^);
    FreeMem(BackGround, s);
  END;

  PROCEDURE SimpleWindow.CheckData;

    PROCEDURE Swap(VAR i, j : BYTE);
    VAR
      h : BYTE;
    BEGIN
      h := i;  i := j;  j := h;
    END;

  BEGIN
    WinError := WinNoErr;
    IF (FrameArt < 1) OR (FrameArt > FrameNo) THEN
      FrameArt := 1;
    FrameChrs := Frames[FrameArt];
    IF (x1 < 1) THEN x1 := 1;  IF (x1 > 80) THEN x1 := 80;
    IF (x2 < 1) THEN x2 := 1;  IF (x2 > 80) THEN x2 := 80;
    IF (y1 < 1) THEN y1 := 1;  IF (y1 > 25) THEN y1 := 25;
    IF (y2 < 1) THEN y2 := 1;  IF (y2 > 25) THEN y2 := 25;
    IF x1 > x2 THEN Swap(x1, x2);
    IF y1 > y2 THEN Swap(y1, y2);
    IF (x1 = x2) OR (y1 = y2) THEN ErrMsg(WinWrKoord);
    xl := x2 - x1;
    yl := y2 - y1
  END;

  PROCEDURE SimpleWindow.ReOpen(NewData: SimpleWindow);
  BEGIN
    Close;
    Self := NewData;
    Open;
  END;

  PROCEDURE SimpleWindow.ChangeFrame(Nr : BYTE);
  BEGIN
    IF Visible AND FrameVisible THEN BEGIN
      IF (Nr < 1) OR (Nr > FrameNo) THEN Nr := 1;
      FrameArt := Nr;
      FrameChrs := Frames[FrameArt];
      DrawFrame;
      WriteTitles;
    END;
  END;

  PROCEDURE SimpleWindow.Hide;
  BEGIN
    IF Visible THEN RestoreBack(x1, y1, x1+xl, y1+yl);
    Visible := FALSE
  END;

  PROCEDURE SimpleWindow.Show;
  BEGIN
    IF NOT Visible THEN Open;
    Visible := TRUE
  END;

  PROCEDURE SimpleWindow.Close;
  BEGIN
    IF BackSaved AND Visible THEN
      RestoreBack (x1, y1, x1+xl, y1+yl);
    Visible := FALSE;
  END;

  DESTRUCTOR SimpleWindow.Done;
  BEGIN
    Close;
  END;

{ -------------------------------------------------------- }
{        Initialisierungsteil der Unit                     }
{ -------------------------------------------------------- }
BEGIN
  WinError := WinNoErr;                 { noch kein Fehler }
                   { Screen auf Bildschirmspeicher setzen  }
  IF Mem[$40:$49] = 7 THEN                   { monochrom ? }
    Screen := Ptr($B000, $0000)
  ELSE
    Screen := Ptr($B800, $0000)
END.
(* ------------------------------------------------------ *)
(*              Ende von SIMWIN.PAS                       *)