World of Shareware - Software Farm 2/wosw_2.zip/wosw_2/PASCAL/VSAFE.ZIP/TVSPY.PAS

Pascal/Delphi Source File | 1990-12-17 | 5KB | 164 lines

program TVSpy;
{$X+}

{ This program shows TVision events in a special scrolling TEventWindow as the
  events are generated by the user and the application.

  All keyboard and mouse events will be displayed by TEventWindow.  All
  broadcast and command events created with PutEvent should be displayed.
  Message events can be intercepted if you include EventWin AFTER the Views
  unit in the uses statements of your source code.  (TVision internal
  messages cannot be intercepted)

  While the TEventWindow is deselected, it will capture and display events in
  its scrolling interior.  When TEventWindow is selected, the display of
  events pauses, and you may scroll back through the last 100 events that
  were captured.

  THeapWin is a small window that displays the amount of free memory while
  that displays the amount of free memory while the application runs.

  TEventWindow is a TTextWindow object with a DisplayEvent method to accept
  a TEvent record and do its best to decipher the event codes.  Insert your
  own event constants and text strings using the InsertCommand method to make
  watching your applications more enjoyable and informative.

  A TTextWindow is a TWindow with a TCollection of strings, which are
  displayed by a scrolling interior view (basically).

  This application has a do-nothing menubar installed so you can see command
  events at work.  To install a TEventWindow in your own existing application,
  simply init the EventWindow global pointer in your MyApp.Init and insert
  EventWindow^.DisplayEvent(E) in your MyApp.GetEvent.  If your app doesn't
  already override its inherited GetEvent, then use the one in this program.
  Don't forget to call your ancestor's GetEvent!!!!

  If you should ever want to close the TEventWindow, don't forget to set the
  global pointer EventWindow to nil, so that dependent routines will know
  not to use it.  (Dispose doesn't set pointers to nil).

  New!  Filter option on the EventWindow mini-menu lets you turn off logging
  of different types of events.  Handy when all you want to see are command
  events but you're drowning in mouse move events.

  New!  Informative text for keyboard events!  KeyNamer unit returns a text
  string for all the predefined TVision kbxxxx constants.

  Enjoy!

  Copyright (c) 1990 by Danny Thorpe


  This program may be freely distributed so long as no fee (other than
  media cost or BBS time charges) is charged and no changes are made to
  this file or its related source units.
}


uses dos, objects, drivers, menus, views, app, heapwin, eventwin;


const cmNewWin = 500;
      cmFileOpen = 501;


type  PMyApp = ^TMyApp;
      TMyApp = object(TApplication)
        constructor Init;
        procedure   GetEvent(var E: TEvent);  virtual;
        procedure   Idle;            virtual;
        procedure   InitStatusLine;  virtual;
        procedure   InitMenuBar;     virtual;
        end;

var MyApp: TMyApp;



constructor TMyApp.Init;
  var R:TRect;
  begin
  TApplication.Init;
                                        { retain last 100 lines in scroller }
  Desktop^.GetExtent(R);
  R.Assign(R.A.X,R.B.Y-10,R.B.X div 2,R.B.Y);                       { vvv }
  EventWindow:= new(PEventWindow, Init(R, 'Event Window', wnNoNumber, 100));
  Desktop^.Insert(EventWindow);

  EventWindow^.InsertCommand( cmNewWin, 'cmNewWin');
  EventWindow^.InsertCommand( cmFileOpen, 'cmFileOpen');


  HeapWindow:= new(PHeapWin, Init);
  Desktop^.Insert( HeapWindow);

  R.Assign(3,2,60,10);
  Desktop^.Insert(new(PWindow, Init(R, 'Dummy window', wnNoNumber)));
  end;


procedure TMyApp.GetEvent(var E: TEvent);
  begin
  TApplication.GetEvent(E);
  EventWindow^.DisplayEvent(E);
  end;


procedure TMyApp.Idle;
  begin
  TApplication.Idle;
  if HeapWindow <> nil then
    HeapWindow^.Update;
  end;


procedure TMyApp.InitStatusLine;
  var R: TRect;

  begin
  GetExtent(R);      { find out how big the current view is }
  R.A.Y := R.B.Y-1;  { squeeze R down to one line at bottom of frame }
  StatusLine := New(PStatusline, Init(R,
                  NewStatusDef(0, $FFFF,
                    NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
                    NewStatusKey('~F4~ New', kbF4, cmNewWin,
                    NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
                    NewStatusKey('',kbF10, cmMenu,
                    nil)))),
                  nil)
                ));
  end;




procedure TMyApp.InitMenuBar;
  var R: TRect;

  begin
  GetExtent(R);
  r.b.y:= r.a.y+1;
  Menubar := New(PMenuBar, Init(R, NewMenu(
               NewSubMenu('~F~ile', hcNoContext, NewMenu(
                 NewItem('~O~pen','F3', kbF3, cmFileOpen, hcNoContext,
                 NewItem('~N~ew','F4', kbF4, cmNewWin, hcNoContext,
                 NewLine(
                 NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcNoContext,
                 nil))))),
               NewSubMenu('~W~indow', hcNoContext, NewMenu(
                 NewItem('~N~ext','F6', kbF6, cmNext, hcNoContext,
                 NewItem('~Z~oom','F7', kbF7, cmZoom, hcNoContext,
                 nil))),
               nil))    { one ) for each menu defined }
             )));
  end;





begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.