ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/ANSIVIEW.ZIP/ANSITEST.PAS

Pascal/Delphi Source File | 1991-01-30 | 5.5 KB | 196 lines

{ DEFINE TVSPY}  {Define this if you want the TVSPY program installed}

Program ANSI_Test;

Uses  Dos, App, Objects, Menus, Drivers, Views, Gadgets, Memory,
{$IFDEF TVSPY}
      HeapWin, EventWin,
{$ENDIF}
      AnsiView;

CONST MaxScreen  = 100;

TYPE  PMyWindow = ^TMyWindow;
      TMyWindow = OBJECT(TANSIView)
                     Count : BYTE;
                     CONSTRUCTOR Init;
                     PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
                  END;

      PMyApp    = ^TMyApp;
      TMyApp    = OBJECT(TApplication)
                     Clock : PClockView;
                     Heap  : PHeapView;
                     CONSTRUCTOR Init;
                     PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
                     PROCEDURE GetEvent(VAR E : TEvent); VIRTUAL;
                     PROCEDURE InitStatusLine; VIRTUAL;
                     PROCEDURE InitMenuBar; VIRTUAL;
                     PROCEDURE Idle; VIRTUAL;
                     PROCEDURE NewWindow;
                  END;

VAR   MyApp : TMyApp;

CONST cmNewWin  = 100;
      cmWriteLN = 101;
      cmGotoXY  = 102;
      cmRandom  = 103;
      cmWacka   = 104;

CONSTRUCTOR TMyWindow.Init;
VAR   R : TRect;
      L : TPoint;
      X : BYTE;
      Y : BYTE;
BEGIN
   X := RANDOM(30);
   Y := RANDOM(10);
   R.Assign(X,Y,X + 50,Y + 10);
   L.X := 80;
   L.Y := 25;
   TANSIView.Init(R,L,'Test Window',0);
   Count := 0;
END;

PROCEDURE TMyWindow.HandleEvent;
VAR   i : INTEGER;
BEGIN
   TANSIView.HandleEvent(Event);
   CASE Event.What OF
      evCommand : CASE Event.Command OF
                     cmWriteLN : PrintLN('Another fine mess you found');
                     cmGotoXY  : GotoXY(RANDOM(Interior^.MaxDim.X),RANDOM(Interior^.MaxDim.Y));
                     cmRandom  : FOR i := 1 TO 500 DO
                                    PrintChar(CHAR(RANDOM(96) + 32));
                     cmWacka   : BEGIN
                                    ClrScr;
                                    FOR i := 1 TO 8 DO
                                       Print('1234567890');
                                    PrintLN('Another fine test of the system');
                                    PrintLN('This is going to test some insertion');
                                    PrintLN('and deletion commands...');
                                    GotoXY(8,1);
                                    print(#27 + '[6P');
                                    GotoXY(8,2);
                                    print(#27 + '[6@');
                                    GotoXY(1,6);
                                    PrintLN('Finished...')
                                 END;
                     ELSE EXIT
                  END;
      ELSE EXIT
   END;
   ClearEvent(Event)
END;

CONSTRUCTOR TMyApp.Init;
VAR   R : TRect;
BEGIN
   TApplication.Init;

   RegisterANSIView;

   GetExtent(R);
   R.A.X := R.B.X - 9;
   R.B.Y := R.A.Y + 1;
   Clock := NEW(PClockView,Init(R));
   Insert(Clock);

   GetExtent(R);
   Dec(R.B.X);
   R.A.X := R.B.X - 9;
   R.A.Y := R.B.Y - 1;
   Heap := NEW(PHeapView,Init(R));
   Insert(Heap);

{$IFDEF TVSPY}
   Desktop^.GetExtent(R);
   R.Assign(R.A.X,R.B.Y-10,R.B.X div 2,R.B.Y);
   EventWindow := NEW(PEventWindow,Init(R,'Event Window',wnNoNumber,100));
   Desktop^.Insert(EventWindow);
   EventWindow^.InsertCommand(cmNewWin,'cmNewWin');
   EventWindow^.InsertCommand(cmWriteLN,'cmWriteLN');
   EventWindow^.InsertCommand(cmGotoXY,'cmGotoXY');
   EventWindow^.InsertCommand(cmRandom,'cmRandom');
   EventWindow^.InsertCommand(cmWacka,'cmWacka');
{$ENDIF}
END;

PROCEDURE TMyApp.HandleEvent;
BEGIN
   TApplication.HandleEvent(Event);
   CASE Event.What OF
      evCommand : CASE Event.Command OF
                     cmNewWin : NewWindow;
                     ELSE EXIT
                  END;
      ELSE EXIT
   END;
   ClearEvent(Event)
END;

PROCEDURE TMyApp.Idle;
BEGIN
   TApplication.Idle;
   Clock^.Update;
   Heap^.Update;
END;

PROCEDURE TMyApp.GetEvent;
BEGIN
   TApplication.GetEvent(E);
{$IFDEF TVSPY}
   EventWindow^.DisplayEvent(E);
{$ENDIF}
END;

PROCEDURE TMyApp.InitStatusLine;
VAR   R : TRect;
BEGIN
   GetExtent(R);
   R.A.Y := R.B.Y - 1;
   StatusLine := NEW(PStatusLine,Init(R,
                   NewStatusDef(0,$FFFF,
                     NewStatusKey('~Alt-X~ Exit',kbAltX,cmQuit,
                     NewStatusKey('~Alt-F3~ Close',kbAltF3,cmClose,
                     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,cmNewWin,hcNoContext,
                  NewItem('~Q~uit','Alt-X',kbAltX,cmQuit,hcNoContext,
                  NIL))),
                NewSubMenu('~V~irtual',hcNoContext,NewMenu(
                  NewItem('~W~riteLN','',kbNoKey,cmWriteLN,hcNoContext,
                  NewItem('~G~otoXY','',kbNoKey,cmGotoXY,hcNoContext,
                  NewItem('~R~andom','',kbNoKey,cmRandom,hcNoContext,
                  NewItem('W~a~cka','',kbNoKey,cmWacka,hcNoContext,
                  NIL))))),
                NIL))
              )))
END;

PROCEDURE TMyApp.NewWindow;
VAR   PPtr : PMyWindow;
BEGIN
   PPtr := NEW(PMyWindow,Init);
   IF PPtr <> NIL THEN
      DeskTop^.Insert(PPtr);
END;

BEGIN
   MyApp.Init;
   MyApp.Run;
   MyApp.Done
END.