Turbo Toolbox/Turbo_Toolbox.iso/dtx9302/tvision/tvpas/xviews.pas

Pascal/Delphi Source File | 1992-11-10 | 17.2 KB | 678 lines

(* ------------------------------------------------------ *)
(*                      XVIEWS.PAS                        *)
(*                                                        *)
(*              Erweiterte Fensterobjekte                 *)
(*       (C) 1992 by Christian Ohr & DMV-Verlag           *)
(* ------------------------------------------------------ *)
{$R-,S-,I-,B-,D-,L-,V-,A+,F+,O+,X+}


UNIT XViews;


INTERFACE


USES Objects, Views, Drivers, Menus, XMenus, App;

CONST
  cmSysMenu     = 140;
  cmShrink      = 141;
  cmWhoIsWindow = 142;
  cmWinMenu     = 143;

  wfShrink    = $10;
  sfShrunk    = $1000;

  cBlueMenuWindow = cBlueWindow + #2#3#4#5#6#7;
  cCyanMenuWindow = cCyanWindow + #2#3#4#5#6#7;
  cGrayMenuWindow = cGrayWindow + #2#3#4#5#6#7;


TYPE
  (* Das Rahmenobjekt für tShrinkWindow. Es stellt        *)
  (* zusätzlich einen Shrink-Button zur Verfügung. Wird   *)
  (* er gedrückt, wird ein entsprechendes Ereignis zum    *)
  (* Fenster geschickt                                    *)

  pShrinkFrame = ^tShrinkFrame;
  tShrinkFrame = OBJECT(tFrame)
    PROCEDURE Draw; VIRTUAL;
    PROCEDURE HandleEvent(VAR Event: tEvent); VIRTUAL;
  END;


  (* Das Rahmenobjekt für tXWindow. Wird das Schließfeld  *)
  (* betätigt, setzt es den Befehl cmSysMenu ab.          *)

  pXFrame = ^tXFrame;
  tXFrame = OBJECT(tShrinkFrame)
    PROCEDURE Draw; VIRTUAL;
    PROCEDURE HandleEvent(VAR Event: tEvent); VIRTUAL;
  END;


  (* Ein Fenster, das auf die Botschaft cmWhoIsWindow     *)
  (* seine Adresse bekannt gibt und sich somit auch als   *)
  (* Fenstertyp identifiziert. Wichtig f. die Window-List *)
  (* in XDIALOGS. Kann sich außerdem selbst numerieren.   *)

  pIDWindow = ^tIDWindow;
  tIDWindow = OBJECT(tWindow)
    CONSTRUCTOR Init (VAR Bounds: tRect; ATitle: tTitleStr;
                      ANumber: INTEGER);
    DESTRUCTOR Done; VIRTUAL;
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE HandleEvent(VAR Event: tEvent); VIRTUAL;
  END;


  (* Diese Fensterart besitzt seine eigene Menü- und      *)
  (* Statuszeile. Diese werden über InitMenuBar bzw.      *)
  (* InitStatusLine initialisiert. Der Befehl cmWinMenu   *)
  (* aktiviert die fensterinterne Menüzeile               *)

  pMenuWindow = ^tMenuWindow;
  tMenuWindow = OBJECT(tIDWindow)
    WinMenuBar: pMenuBar;
    WinStatusLine: pStatusLine;
    CONSTRUCTOR Init (VAR Bounds: tRect; ATitle: tTitleStr;
                      ANumber: INTEGER);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE Close; VIRTUAL;
    FUNCTION GetPalette: pPalette; VIRTUAL;
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    PROCEDURE InitMenuBar; VIRTUAL;
    PROCEDURE InitStatusLine; VIRTUAL;
    PROCEDURE SetState (AState: WORD; Enable: BOOLEAN);
                       VIRTUAL;
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  END;


  (* Ein Fenster v. Typ tShrinkWindow kann a. Symbolgröße *)
  (* zusammenschrumpfen, falls das Bit wfShrink in Flags  *)
  (* gesetzt ist (default)                                *)

  pShrinkWindow = ^tShrinkWindow;
  tShrinkWindow = OBJECT(tMenuWindow)
    SaveFlags: BYTE;
    SaveOptions: WORD;
    SaveBounds: tRect;
    CONSTRUCTOR Init(VAR Bounds: tRect; ATitle: tTitleStr;
                     ANumber: INTEGER);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE ChangeBounds (VAR Bounds: tRect); VIRTUAL;
    FUNCTION GetPalette: pPalette; VIRTUAL;
    PROCEDURE HandleEvent(VAR Event: tEvent); VIRTUAL;
    PROCEDURE InitFrame; VIRTUAL;
    PROCEDURE SetState (AState: WORD; Enable: BOOLEAN);
                       VIRTUAL;
    PROCEDURE Shrink(Enable: BOOLEAN); VIRTUAL;
    PROCEDURE SizeLimits (VAR Min, Max: tPoint); VIRTUAL;
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  END;


  (* Ein Fenster, das den Schließknopf doppelt belegt.    *)
  (* Wird er mit der linken Maustaste angeklickt bzw.wird *)
  (* Ctrl-F3 gedrückt, öffnet sich ein Systemmenü. Mit d. *)
  (* rechten Maustaste bzw. Alt-F3 schließt es sich wie   *)
  (* gewohnt.                                             *)

  pXWindow = ^tXWindow;
  tXWindow = OBJECT(tShrinkWindow)
    SysMenu: pMenu;
    CONSTRUCTOR Init(VAR Bounds: tRect; ATitle: tTitleStr;
                     ANumber: INTEGER; ASysMenu: pMenu);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    PROCEDURE InitFrame; VIRTUAL;
  END;



CONST
  rShrinkFrame: tStreamRec = (
    ObjType: 1400;
    VmtLink: Ofs(TypeOf(tShrinkFrame)^);
    Load:    @tShrinkFrame.Load;
    Store:   @tShrinkFrame.Store
  );
  rXFrame: tStreamRec = (
    ObjType: 1401;
    VmtLink: Ofs(TypeOf(tXFrame)^);
    Load:    @tXFrame.Load;
    Store:   @tXFrame.Store
  );
  rIDWindow: tStreamRec = (
    ObjType: 1402;
    VmtLink: Ofs(TypeOf(tIDWindow)^);
    Load:    @tIDWindow.Load;
    Store:   @tIDWindow.Store
  );
  rMenuWindow: tStreamRec = (
    ObjType: 1403;
    VmtLink: Ofs(TypeOf(tMenuWindow)^);
    Load:    @tMenuWindow.Load;
    Store:   @tMenuWindow.Store
  );
  rShrinkWindow: tStreamRec = (
    ObjType: 1404;
    VmtLink: Ofs(TypeOf(tShrinkWindow)^);
    Load:    @tShrinkWindow.Load;
    Store:   @tShrinkWindow.Store
  );
  rXWindow: tStreamRec = (
    ObjType: 1405;
    VmtLink: Ofs(TypeOf(tXWindow)^);
    Load:    @tXWindow.Load;
    Store:   @tXWindow.Store
  );


FUNCTION  wnAutoNumber: INTEGER;
PROCEDURE InitStdSysMenu;
PROCEDURE RegisterXViews;


VAR
  StdSysMenu: pMenu;


IMPLEMENTATION


CONST
  WinNumberFlag : INTEGER = 0;



(* ------------------------------------------------------ *)
(*                     tShrinkFrame                       *)
(* ------------------------------------------------------ *)


PROCEDURE tShrinkFrame.Draw;
VAR
  Color: BYTE;
  C: CHAR;
BEGIN
  tFrame.Draw;
  IF Owner^.GetState(sfSelected) AND
     (pWindow(Owner)^.Flags AND wfShrink <> 0) THEN BEGIN
    IF GetState(sfDragging) THEN
      Color := 5 ELSE
      Color := 3;
    IF pWindow(Owner)^.GetState(sfShrunk) THEN
      C := #24 ELSE BEGIN
      C := #25;
      IF (pWindow(Owner)^.Number > 0) AND
         (Owner^.Size.X > MinWinSize.X + 6) THEN
        WriteChar(Size.X - 10, 0, Chr(pWindow(Owner)^.Number
                  + 48), Color, 1);
    END;
    WriteChar(Size.X - 8,  0, '[', Color, 1);
    WriteChar(Size.X - 7,  0, C, 5, 1);
    WriteChar(Size.X - 6,  0, ']', Color, 1);
  END;
END;


PROCEDURE tShrinkFrame.HandleEvent (VAR Event: tEvent);

  FUNCTION ShrinkButtonPosition: BOOLEAN;
  VAR
    P: tPoint;
  BEGIN
    MakeLocal(Event.Where, P);
    ShrinkButtonPosition :=
      (P.Y = 0) AND (P.X > Size.X-9) AND (P.X < Size.X - 5)
       AND (Event.Buttons = mbLeftButton)
       AND (pShrinkWindow(Owner)^.Flags AND wfShrink <> 0);
  END;

BEGIN
  IF (Event.What = evMouseDown) AND
      ShrinkButtonPosition THEN BEGIN
    Event.What := evCommand;
    Event.Command := cmShrink;
    PutEvent(Event);
    ClearEvent(Event);
  END;
  tFrame.HandleEvent(Event);
END;



(* ------------------------------------------------------ *)
(*                        tXFrame                         *)
(* ------------------------------------------------------ *)


PROCEDURE tXFrame.Draw;
BEGIN
  tShrinkFrame.Draw;
  IF Owner^.GetState(sfSelected) THEN
    WriteChar(3, 0, #31, 5, 1);
END;


PROCEDURE tXFrame.HandleEvent (VAR Event: tEvent);

  FUNCTION CloseButtonPosition: BOOLEAN;
  VAR
    P: tPoint;
  BEGIN
    MakeLocal(Event.Where, P);
    CloseButtonPosition :=
      (P.Y = 0) AND (P.X > 1) AND (P.X < 5)
       AND (Event.Buttons = mbLeftButton)
       AND (pXWindow(Owner)^.SysMenu <> NIL);
  END;

BEGIN
  IF (Event.What = evMouseDown) AND
      CloseButtonPosition THEN BEGIN
    Event.What := evCommand;
    Event.Command := cmSysMenu;
    PutEvent(Event);
    ClearEvent(Event);
  END;
  tShrinkFrame.HandleEvent(Event);
END;


(* ------------------------------------------------------ *)
(*                      tIDWindow                         *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tIDWindow.Init(VAR Bounds: tRect; ATitle:
                           tTitleStr; ANumber: INTEGER);
BEGIN
  IF (ANumber > 0) AND (ANumber < 10) THEN
    IF WinNumberFlag AND (1 SHL ANumber) = 0 THEN
      WinNumberFlag := WinNumberFlag OR (1 SHL ANumber) ELSE
      ANumber := wnNoNumber;
  tWindow.Init(Bounds, ATitle, ANumber);
END;


DESTRUCTOR tIDWindow.Done;
BEGIN
  IF Number <> wnNoNumber THEN
    WinNumberFlag := WinNumberFlag AND NOT (1 SHL Number);
  tWindow.Done;
END;


CONSTRUCTOR tIDWindow.Load (VAR S: tStream);
BEGIN
  tWindow.Load(S);
  IF (Number > 0) AND (Number < 10) THEN
    WinNumberFlag := WinNumberFlag OR (1 SHL Number);
END;


PROCEDURE tIDWindow.HandleEvent(VAR Event: tEvent);
BEGIN
  IF (Event.What = evBroadcast) AND
     (Event.Command = cmWhoIsWindow) THEN ClearEvent(Event);
  tWindow.HandleEvent(Event);
END;



(* ------------------------------------------------------ *)
(*                     tMenuWindow                        *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tMenuWindow.Init (VAR Bounds: tRect; ATitle:
                              tTitleStr; ANumber: INTEGER);
BEGIN
  tIDWindow.Init(Bounds, ATitle, ANumber);
  InitMenuBar;
  InitStatusLine;
  IF WinMenuBar <> NIL THEN
    Insert(WinMenuBar);
  IF WinStatusLine <> NIL THEN
    Insert(WinStatusLine);
  MinWinSize.X := 32;
  MinWinSize.Y :=  9;
END;


CONSTRUCTOR tMenuWindow.Load (VAR S: tStream);
BEGIN
  tIDWindow.Load(S);
  GetSubViewPtr(S, WinMenuBar);
  GetSubViewPtr(S, WinStatusLine);
END;


PROCEDURE tMenuWindow.Close;
BEGIN
  Message(Desktop, evBroadcast, cmOwnerCloses, @Self);
  tIDWindow.Close;
END;


FUNCTION tMenuWindow.GetPalette: PPalette;
CONST
  P: STRING[Length(cBlueMenuWindow)] = cBlueMenuWindow;
BEGIN
  GetPalette := @P;
END;


PROCEDURE tMenuWindow.HandleEvent (VAR Event: tEvent);
BEGIN
  tIDWindow.HandleEvent(Event);
  IF (Event.What = evCommand) AND
     (Event.Command = cmWinMenu) AND
     (WinMenuBar <> NIL) THEN BEGIN
    Message(WinMenuBar, evCommand, cmMenu, @Self);
    ClearEvent(Event);
  END;
END;


PROCEDURE tMenuWindow.InitMenuBar;
BEGIN
  WinMenuBar := NIL;
END;


PROCEDURE tMenuWindow.InitStatusLine;
BEGIN
  WinStatusLine := NIL;
END;


PROCEDURE tMenuWindow.SetState (AState: WORD;
                                Enable: BOOLEAN);
BEGIN
  tIDWindow.SetState(AState, Enable);
  IF AState = sfSelected THEN BEGIN
    IF WinMenuBar <> NIL THEN
      IF GetState(sfSelected) THEN
        WinMenuBar^.Show ELSE
        WinMenuBar^.Hide;
    IF WinStatusLine <> NIL THEN
      IF GetState(sfSelected) THEN
        WinStatusLine^.Show ELSE
        WinStatusLine^.Hide;
  END;
END;


PROCEDURE tMenuWindow.Store (VAR S: tStream);
BEGIN
  tIDWindow.Store(S);
  PutSubViewPtr(S, WinMenuBar);
  PutSubViewPtr(S, WinStatusLine);
END;



(* ------------------------------------------------------ *)
(*                    tShrinkWindow                       *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tShrinkWindow.Init(VAR Bounds: tRect; ATitle:
                               tTitleStr; ANumber: INTEGER);
BEGIN
  tMenuWindow.Init(Bounds, ATitle, ANumber);
  Flags := Flags OR wfShrink;
END;


CONSTRUCTOR tShrinkWindow.Load (VAR S: tStream);
BEGIN
  tMenuWindow.Load(S);
  S.Read(SaveFlags, SizeOf(BYTE));
  S.Read(SaveOptions, SizeOf(WORD));
  S.Read(SaveBounds, SizeOf(tRect));
END;


PROCEDURE tShrinkWindow.ChangeBounds (VAR Bounds: tRect);
VAR
  NewSize : tPoint;
  Min, Max: tPoint;
BEGIN
  (* Entspricht so in etwa 'Locate'. Notwendig, da        *)
  (* tGroup.ChangeBounds nicht Locate, sondern wieder die *)
  (* ChangeBounds-Methode der Subviews aufruft. Somit wür-*)
  (* den symbolisierte Fenster ihre Größe ändern, wenn    *)
  (* die Anzahl der Bildschirmzeilen verändert wird.      *)

  SizeLimits(Min, Max);
  NewSize.X := Bounds.B.X - Bounds.A.X;
  NewSize.Y := Bounds.B.Y - Bounds.A.Y;
  IF NewSize.X < Min.X THEN
    Bounds.B.X := Bounds.A.X + Min.X ELSE
    IF NewSize.X > Max.X THEN
      Bounds.B.X := Bounds.A.X + Max.X;
  IF NewSize.Y < Min.Y THEN
    Bounds.B.Y := Bounds.A.Y + Min.Y ELSE
    IF NewSize.Y > Max.Y THEN
      Bounds.B.Y := Bounds.A.Y + Max.Y;
  tMenuWindow.ChangeBounds(Bounds);
END;


FUNCTION tShrinkWindow.GetPalette: PPalette;
CONST
  cShrunkWin : STRING[Length(cCyanMenuWindow)]
             = cCyanMenuWindow;
BEGIN
  IF GetState(sfShrunk) THEN
    GetPalette := @cShrunkWin ELSE
    GetPalette := tMenuWindow.GetPalette;
END;


PROCEDURE tShrinkWindow.HandleEvent(VAR Event: tEvent);
BEGIN
  tMenuWindow.HandleEvent(Event);
  IF (Event.What = evCommand) AND (Event.Command = cmShrink)
     AND CommandEnabled(cmShrink)
     AND (Flags AND wfShrink <> 0) THEN
    Shrink(NOT GetState(sfShrunk)) ELSE Exit;
  ClearEvent(Event);
END;


PROCEDURE tShrinkWindow.InitFrame;
VAR
  R: tRect;
BEGIN
  GetExtent(R);
  Frame := New(pShrinkFrame, Init(R));
END;


PROCEDURE tShrinkWindow.SetState (AState: WORD;
                                Enable: BOOLEAN);

  PROCEDURE HideAll (P: pView); FAR;
  BEGIN
    IF (P <> pView(Frame)) THEN P^.Hide;
  END;

  PROCEDURE ShowAll (P: pView); FAR;
  BEGIN
    IF (P <> pView(Frame)) THEN P^.Show;
  END;

BEGIN
  IF GetState(sfShrunk) THEN BEGIN
    tIDWindow.SetState(AState, Enable);
    IF GetState(sfShrunk) THEN
      ForEach(@HideAll) ELSE
      ForEach(@ShowAll);
  END ELSE BEGIN
    tMenuWindow.SetState(AState, Enable);
    IF GetState(sfShrunk) THEN
      ForEach(@HideAll);
  END;
  IF (AState = sfSelected) AND Enable THEN
    IF Flags AND wfShrink <> 0 THEN
      EnableCommands([cmShrink]) ELSE
      DisableCommands([cmShrink]);
END;


PROCEDURE tShrinkWindow.Shrink (Enable: BOOLEAN);
VAR
  R: tRect;
  Min, Max: tPoint;
BEGIN
  SetState(sfShrunk, Enable);
  IF Enable THEN BEGIN
    SaveFlags := Flags;
    SaveOptions := Options;
    GetBounds(R);
    SaveBounds.Copy(R);
    Flags := Flags AND NOT (wfGrow + wfZoom);
    Options := Options AND NOT ofTileable;
    SizeLimits(Min, Max);
    Owner^.GetExtent(R);
    MoveTo(R.B.X - Min.X, R.B.Y - Succ(Number) * Min.Y);
    GrowTo(Min.X, Min.Y);
    Owner^.SelectNext(FALSE);
  END ELSE BEGIN
    Flags := SaveFlags;
    IF Flags and wfZoom <> 0 THEN
      EnableCommands([cmZoom]) ELSE
      DisableCommands([cmZoom]);
    Options := SaveOptions;
    Locate(SaveBounds);
  END;
END;


PROCEDURE tShrinkWindow.SizeLimits (VAR Min, Max: tPoint);
BEGIN
  tMenuWindow.SizeLimits(Min, Max);
  IF GetState(sfShrunk) THEN BEGIN
    Min.Y := 2;
    Max := Min;
  END;
END;


PROCEDURE tShrinkWindow.Store (VAR S: tStream);
BEGIN
  tMenuWindow.Store(S);
  S.Write(SaveFlags, SizeOf(BYTE));
  S.Write(SaveOptions, SizeOf(WORD));
  S.Write(SaveBounds, SizeOf(tRect));
END;



(* ------------------------------------------------------ *)
(*                      tXWindow                          *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tXWindow.Init(VAR Bounds: tRect; ATitle:
                          tTitleStr; ANumber: INTEGER;
                          ASysMenu: pMenu);
BEGIN
  tShrinkWindow.Init(Bounds, ATitle, ANumber);
  SysMenu := ASysMenu;
END;


CONSTRUCTOR tXWindow.Load (VAR S: tStream);
BEGIN
  tShrinkWindow.Load(S);
  SysMenu := StdSysMenu;
END;


PROCEDURE tXWindow.HandleEvent (VAR Event: tEvent);

  PROCEDURE SysMenuBox;
  VAR
    R: tRect;
    P: pMenuBox;
  BEGIN
    REPEAT UNTIL NOT MouseEvent(Event, evNothing);
    R.Assign(0, 0, 10, 2);
    P := New(pAltF3MenuBox, Init(R, SysMenu, NIL));
    P^.MoveTo(Origin.X + 2, Origin.Y + 1);
    Message(P, evBroadcast, cmCommandSetChanged, NIL);
    Event.What := evCommand;
    Event.Command := Desktop^.ExecView(P);
    Event.InfoPtr := @Self;
    Dispose(P, Done);
    IF Event.Command <> 0 THEN PutEvent(Event);
    ClearEvent(Event);
  END;

BEGIN
  tShrinkWindow.HandleEvent(Event);

  IF (Event.What = evCommand) AND
     (Event.Command = cmSysMenu) AND
     (SysMenu <> NIL) THEN SysMenuBox;
END;


PROCEDURE tXWindow.InitFrame;
VAR
  R: tRect;
BEGIN
  GetExtent(R);
  Frame := New(pXFrame, Init(R));
END;


PROCEDURE InitStdSysMenu;
BEGIN
  StdSysMenu := NewMenu(NIL);
  StartMenuAt(StdSysMenu);
    AddItem('~S~chließen', 'Alt-F3', kbAltF3, cmClose, 0);
    AddLine;
    AddItem('Sym~b~ol', '', kbNoKey, cmShrink, 0);
    AddItem('~V~ollbild', 'F5', kbF5, cmZoom, 0);
    AddItem('~W~eiter', 'F6', kbF6, cmNext, 0);
    AddItem('~Z~urück', 'Shift-F6', kbShiftF6, cmPrev, 0);
END;


FUNCTION wnAutoNumber: INTEGER;
VAR
  I: INTEGER;
BEGIN
  I := 1;
  WHILE (I < 10) AND (WinNumberFlag AND (1 SHL I) <> 0) DO
    Inc(I);
  wnAutoNumber := I MOD 10;
END;


PROCEDURE RegisterXViews;
BEGIN
  RegisterType(rShrinkFrame);
  RegisterType(rXFrame);
  RegisterType(rIDWindow);
  RegisterType(rMenuWindow);
  RegisterType(rShrinkWindow);
  RegisterType(rXWindow);
END;


END.


(* ------------------------------------------------------ *)
(*                 Ende von XVIEWS.PAS                    *)