home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / tricks / pascal / whichwin / wwdemo.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-09-30  |  2.7 KB  |  101 lines

  1. (* ------------------------------------------------------ *)
  2. (*                     WMDEMO.PAS                         *)
  3. (*            Demonstration der Unit "WhichWin            *)
  4. (*         (c) 1991 Jan Laitenberger & DMV-Verlag         *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM WhichWin_Demo;
  7.  
  8. USES Objects, Drivers, Views, Menus, App, MsgBox, WhichWin;
  9.  
  10. TYPE
  11.   tMyApp = OBJECT (tApplication)
  12.     PROCEDURE OpenWindow;
  13.     PROCEDURE HandleEvent(VAR Event : tEvent);      VIRTUAL;
  14.     PROCEDURE InitMenuBar;                          VIRTUAL;
  15.     PROCEDURE InitStatusLine;                       VIRTUAL;
  16.   END;
  17.  
  18.   pWin   = ^tWin;
  19.   tWin   = OBJECT (tWindow)
  20.     PROCEDURE HandleEvent(VAR Event: tEvent);       VIRTUAL;
  21.   END;
  22.  
  23. VAR
  24.   MyApp : tMyApp;
  25.   R     : tRect;
  26.  
  27.   PROCEDURE TWin.HandleEvent(VAR Event : tEvent);
  28.   BEGIN
  29.     IF ActiveWindow(Event, Number) THEN ClearEvent(Event);
  30.     tWindow.HandleEvent(Event);
  31.   END;
  32.  
  33.   PROCEDURE tMyApp.OpenWindow;
  34.   VAR
  35.     Window : pWin;
  36.     s      : STRING;
  37.     w      : INTEGER;
  38.   BEGIN
  39.     w := WhichWindow;
  40.     IF w = -1 THEN
  41.       MessageBox(#3'Zu viele Fenster für WhichWindow',
  42.                  NIL, mfInformation + mfOkButton)
  43.     ELSE BEGIN
  44.       R.Assign(0, 0, 30, 7);
  45.       R.Move(Random(50), Random(16));
  46.       Str(w, s);
  47.       Window := New(pWin, Init(R, 'Fenster ' + s, w));
  48.       DeskTop^.Insert(Window);
  49.     END;
  50.   END;
  51.  
  52.   PROCEDURE tMyApp.InitMenuBar;
  53.   BEGIN
  54.     GetExtent(R);
  55.     R.B.Y := R.A.Y + 1;
  56.     MenuBar := New(pMenuBar, Init(R, NewMenu(
  57.       NewSubMenu('~F~enster', 0, NewMenu(
  58.         NewItem('~G~röße', 'Ctrl-F5', kbCtrlF5, cmResize, 0,
  59.         NewItem('~Z~oomen', 'F5', kbF5, cmZoom, 0,
  60.         NewItem('~N~ächstes', 'F6', kbF6, cmNext, 0,
  61.         NewItem('~L~etzes', 'Shift-F6', kbShiftF6, cmPrev,0,
  62.         NewItem('~S~chließen', 'Alt-F3', kbAltF3, cmClose,0,
  63.       NIL)))))),
  64.     NIL))));
  65.   END;
  66.  
  67.   PROCEDURE tMyApp.InitStatusLine;
  68.   BEGIN
  69.     GetExtent(R);
  70.     R.A.Y := R.B.Y - 1;
  71.     StatusLine := New(pStatusLine, Init(R,
  72.       NewStatusDef(0, $FFFF,
  73.         NewStatusKey('', kbF10, cmMenu,
  74.         NewStatusKey('~Alt-X~ Ende', kbAltX, cmQuit,
  75.         NewStatusKey('~F1~ Öffnen', kbF1, 100,
  76.       NIL))),
  77.     NIL)));
  78.   END;
  79.  
  80.   PROCEDURE tMyApp.HandleEvent(VAR Event : tEvent);
  81.   BEGIN
  82.     tApplication.HandleEvent(Event);
  83.     IF Event.What = evCommand THEN BEGIN
  84.       CASE Event.Command OF
  85.         100 : OpenWindow;
  86.       END;
  87.       ClearEvent(Event);
  88.     END;
  89.   END;
  90.  
  91. BEGIN
  92.   WITH MyApp DO BEGIN
  93.     Init;
  94.     Run;
  95.     Done;
  96.   END;
  97. END.
  98. (* ------------------------------------------------------ *)
  99. (*                Ende von WMDEMO.PAS                     *)
  100.  
  101.