Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TVSPY.ZIP/EVENTWIN.PAS

Pascal/Delphi Source File | 1990-12-17 | 10.0 KB | 376 lines

unit eventwin;

{********************************************************}
{ Event watching window for Turbo Vision applications.   }
{ Copyright (c) 1990 by Danny Thorpe                     }
{********************************************************}

{$X+}  { allow function results to be ignored }

interface

uses objects, drivers, views, menus, dialogs, keynamer, textwin;


type
       PCommandRec = ^TCommandRec;
       TCommandRec = record
         command: word;
         description: string[80];
         end;

       PCommandCollection = ^TCommandCollection;
       TCommandCollection = object(TSortedCollection)
         function Compare( Key1, Key2: pointer): integer; virtual;
         function Keyof( Item: pointer): pointer;  virtual;
         procedure FreeItem( Item: pointer);  virtual;
         end;


       PEWMenubar = ^TEWMenubar;
       TEWMenubar = object(TMenubar)
         function GetPalette: PPalette;         virtual;
         function NewSubView(var Bounds: TRect; AMenu: PMenu;
           AParentMenu: PMenuView): PMenuView; virtual;
         end;


       PEWMenubox = ^TEWMenubox;
       TEWMenubox = object(TMenubox)
         function GetPalette: PPalette;         virtual;
         end;


       PEventWindow = ^TEventWindow;
       TEventWindow = object(TTextWindow)
         CommandList: TCommandCollection;
         Filters: word;
         constructor Init( var R: TRect; ATitle: string; Num, MaxLines: integer);
         destructor  Done;  virtual;
         procedure DisplayEvent( var Event: TEvent); virtual;
         function  GetPalette: PPalette;             virtual;
         procedure InsertCommand(ACommand: word; ADescription: string); virtual;
         procedure HandleEvent(var Event: TEvent);   virtual;
         procedure MakeInterior( Maxlines: integer); virtual;
         procedure FiltersDialog;
         end;


var EventWindow: PEventWindow;



{ This message function will override Views.Message, if this unit is listed
  after Views in your source code's uses statement.
}

function Message( Receiver: PView; What, Command: word; InfoPtr: Pointer): pointer;




implementation

const

  cmEventFilters = 503;

  CEWMenu = #9#10#11#12#13#14;


function TCommandCollection.Compare( Key1, Key2: pointer): integer;
  begin
  if word(Key1^) < word(Key2^) then
    Compare := -1
  else if word(Key1^) > word(Key2^) then
    Compare := 1
  else
    Compare := 0;
  end;


function TCommandCollection.KeyOf( Item: pointer): pointer;
  begin
  KeyOf := @PCommandRec(Item)^.Command;
  end;


procedure TCommandCollection.FreeItem( Item: pointer);
  begin
  if Item <> nil then  Dispose(Item);
  end;




function TEWMenubar.GetPalette: PPalette;
  const P: string[length(CEWMenu)] = CEWMenu;
  begin
  GetPalette:= @P;
  end;


function TEWMenubar.NewSubView(var Bounds: TRect; AMenu: PMenu;
           AParentMenu: PMenuView): PMenuView;
  begin
  NewSubView := New(PEWMenuBox, Init(Bounds, AMenu, AParentMenu));
  end;


function TEWMenubox.GetPalette: PPalette;
  const P: string[length(CEWMenu)] = CEWMenu;
  begin
  GetPalette:= @P;
  end;



constructor TEventWindow.Init( var R: TRect;
                               ATitle: string;
                               Num, Maxlines: integer);
  begin
  TTextWindow.Init( R, ATitle, Num, MaxLines);
  Flags := Flags and not (wfClose or wfZoom);
  Filters := evMouse or evKeyBoard or evMessage;
  CommandList.Init( 5,1);
  end;



destructor TEventWindow.Done;
  begin
  CommandList.Done;
  TTextWindow.Done;
  end;



procedure TEventWindow.DisplayEvent( var Event: TEvent);
  var st,xs,ys: string;
      index: integer;
      E: TEvent;
  begin
  st:='';
  if ((State and sfSelected) = 0) then
    { don't log messages when we're selected }
    begin
    E := Event;
    { if Filter bit isn't set, then don't log it }
    E.What := E.What and Filters;
    case E.What of
      evNothing  : exit;
      evMouseDown,
      evMouseUp,
      evMouseMove,
      evMouseAuto: begin
                   st:='Mouse ';
                   case E.What of
                     evMouseDown: st:= st+ 'Down, ';
                     evMouseUp  : st:= st+ 'Up, ';
                     evMouseMove: st:= st+ 'Move, ';
                     evMouseAuto: st:= st+ 'Auto, ';
                     end;
                   case E.Buttons of
                     mbLeftButton : st:= st+'Left Button, ';
                     mbRightButton: st:= st+'Right Button, ';
                     $04          : st:= st+'Center Button, ';
                     end;
                   if (E.Buttons <> 0) and E.Double then
                     st:= st+'Double Click ';
                   str(E.Where.X:0,xs);
                   str(E.Where.Y:0,ys);
                   st:= st+'X:'+xs+' Y:'+ys;
                   end;
      evKeyDown  : begin
                   st:= KeyName(E.KeyCode);
                   if length(st)=0 then
                     st:= KeyName(word(E.CharCode));
                   st:= 'Keyboard '+st;
                   end;
      evCommand,
      evBroadcast: begin
                   if E.What = evCommand then
                     st:='Command '
                   else
                     st:='Broadcast ';
                   case E.Command of
                     cmQuit  : st:= st+'cmQuit';
                     cmError : st:= st+'cmError';
                     cmMenu  : st:= st+'cmMenu';
                     cmClose : st:= st+'cmClose';
                     cmZoom  : st:= st+'cmZoom';
                     cmResize: st:= st+'cmResize';
                     cmNext  : st:= st+'cmNext';

                     cmOk    : st:= st+'cmOk';
                     cmCancel: st:= st+'cmCancel';
                     cmYes   : st:= st+'cmYes';
                     cmNo    : st:= st+'cmNo';
                     cmDefault:st:= st+'cmDefault';

                     cmReceivedFocus    : st:= st+'cmReceivedFocus';
                     cmReleasedFocus    : st:= st+'cmReleasedFocus';
                     cmCommandSetChanged: st:= st+'cmCommandSetChanged';
                     cmScrollBarChanged : st:= st+'cmScrollBarChanged';
                     cmScrollBarClicked : st:= st+'cmScrollBarClicked';
                     cmSelectWindowNum  : st:= st+'cmSelectWindowNum';
                     else
                       begin
                       index:=0;
                       if CommandList.Search(@E.Command, index) then
                         begin
                         st:= st+ PCommandRec(CommandList.At(index))^.Description;
                         end
                       else
                         begin
                         str(E.Command:0, xs);
                         st:= st+'unknown: '+xs;
                         end;
                       end;
                     end;
                   end;
      else
        begin
        str(E.What:0, xs);
        st:= 'Unknown Event.What: '+xs;
        end;
      end;  {case}

    Interior^.Append(NewStr(st));
    end;  { if }
  end;





function TEventWindow.GetPalette: PPalette;
  const P: string[length(CBlueWindow)+ length(CMenuView)]
         = CBlueWindow + CMenuView;
  begin
  GetPalette := @P;
  end;



procedure TEventWindow.InsertCommand( ACommand: word; ADescription: string);
  var P: PCommandRec;
  begin
  new(P);
  P^.Command := ACommand;
  P^.Description := ADescription;
  CommandList.Insert(P);
  end;



procedure TEventWindow.HandleEvent(var Event: TEvent);
  begin
  TWindow.HandleEvent(Event);
  if Event.What = evCommand then
    begin
    case Event.Command of
      cmEventFilters: FiltersDialog;
      end;
    end;
  end;



procedure TEventWindow.MakeInterior( Maxlines: integer);
  var R: TRect;
      M: PMenubar;

  begin
  GetExtent(R);
  R.Grow(-1,-1);
  R.B.Y:= R.A.Y+1;
  M:= new(PEWMenubar, Init(R, NewMenu( NewSubMenu('~O~ptions',hcNoContext, NewMenu(
                 NewItem('~F~ilters','',0,cmEventFilters,hcNoContext,nil)),nil))));

  Insert(M);

  GetExtent(R);
  R.Grow(-1,-1);
  inc(R.A.Y);
  Interior := new(PTextInterior, Init(R, MaxLines,
                                      StandardScrollBar(sbHorizontal+sbHandleKeyboard),
                                      StandardScrollBar(sbVertical+sbHandleKeyboard)));
  Insert( Interior );
  end;




procedure TEventWindow.FiltersDialog;
  var P: PView;
      D: PDialog;
      R: TRect;
      Result: word;
      DataRec: word;
  begin
  R.Assign(10,6,40,20);
  D := new(PDialog, Init(R, 'Message Filters'));

  R.Assign(7,2,22,10);
  P := new(PCheckBoxes, Init(R,
         NewSItem('Mouse ~D~own',
         NewSItem('Mouse ~U~p',
         NewSItem('Mouse ~M~ove',
         NewSItem('Mouse ~A~uto',
         NewSItem('~K~eyboard',
         NewSItem('~C~ommand',
         NewSItem('~B~roadcast',
         NewSItem('~O~ther', nil))))))))));
  D^.Insert(P);

  R.Assign(5,11,13,13);
  P := new(PButton, Init(R, 'Ok', cmOk, bfDefault));
  D^.Insert(P);

  R.Assign(14,11,24,13);
  P := new(PButton, Init(R, 'Cancel', cmCancel, bfNormal));
  D^.Insert(P);

  D^.SelectNext(false);

  { transfer data from filters to a more linear datarec }
  DataRec := 0;
  DataRec := Filters and (evMouse or evKeyDown);
  DataRec := DataRec or ((Filters - DataRec) shr 3);

  D^.SetData(DataRec);

  Result := Owner^.ExecView(D);

  if Result <> cmCancel then
    begin
    D^.GetData(DataRec);
    Filters := 0;
    Filters := DataRec and (evMouse or evKeyDown);
    Filters := Filters or ((DataRec - Filters) shl 3);
    end;

  Dispose(D, Done);
  end;




function Message( Receiver: PView; What, Command: word; InfoPtr: Pointer): pointer;
  var E: TEvent;
  begin
  E.What:=what;
  E.Command:=command;
  E.Infoptr:=Infoptr;

  if (EventWindow <> nil) then
    EventWindow^.DisplayEvent(E);

  { pass the intercepted data on to the Message function it was intended for }
  Message:= Views.Message( Receiver, What, Command, InfoPtr);
  end;


end.