dos_compilers/Borland Turbo Pascal v7/EXAMPLES/TVDEBUG/SHOWEVNT.PAS
2024-07-02 08:21:37 -07:00

104 lines
2.4 KiB
Plaintext

{************************************************}
{ }
{ Turbo Vision Debuging Demo }
{ Copyright (c) 1992 by Borland International }
{ }
{************************************************}
{ This program demonstrates how to use TVDEBUG the debugging
unit. By using TVDEBUG your application will create two
windows on the desktop, an event window and a log window.
The event window will show all the events as they occur
in a readable fashion. The log window intercepts writes
to Output and displays them in a window. This allows
"Writeln" style debugging in Turbo Vision. }
program ShowEvnt;
{$X+}
{$DEFINE DEBUG}
{$IFDEF DEBUG}
uses Drivers, Objects, Views, Menus, App, TVDebug;
{$ELSE}
uses Drivers, Objects, Views, Menus, App;
{$ENDIF}
type
PMyWindow = ^TMyWindow;
TMyWindow = object(TWindow)
procedure HandleEvent(var Event: TEvent); virtual;
end;
procedure TMyWindow.HandleEvent(var Event: TEvent);
const
Times: Integer = 0;
begin
inherited HandleEvent(Event);
if Event.What = evMouseDown then
begin
Inc(Times);
{$IFDEF DEBUG}
Writeln('You clicked in the dummy window (', Times, ')');
{$ENDIF}
end;
end;
type
PMyApp = ^TMyApp;
TMyApp = object(TApplication)
constructor Init;
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
end;
var
MyApp: TMyApp;
constructor TMyApp.Init;
var
R: TRect;
begin
inherited Init;
R.Assign(3, 2, 60, 10);
InsertWindow(New(PMyWindow, Init(R, 'Dummy window', wnNoNumber)));
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('~F4~ New', kbF4, cmNew,
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(
StdFileMenuItems(nil)),
NewSubMenu('~W~indow', hcNoContext, NewMenu(
StdWindowMenuItems(nil)),
nil)))));
end;
begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.