home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TVAPP / TEST28.PAS < prev   
Pascal/Delphi Source File  |  1993-09-30  |  4KB  |  143 lines
  1. { ---->>>>TEST28<<<<-------------------------------------------
  2.  
  3.   Last Update: 9/29/93
  4.   Author: Ed Jordan
  5.  
  6.   This program demonstrates the use of the accompanying App28 unit.
  7.  
  8.   TApp28 is defined in APP28.PAS.  A descendant of TApplication, 
  9.   it over-rides TApplication's SetScreenMode method to allow the 
  10.   use of a 28-line text mode on VGA adaptors.  It should operate 
  11.   normally on other adaptors.
  12.  
  13.   App28 is free.  It is a simple thing, but it has not been 
  14.   extensively tested, and I make no guarantees and accept no 
  15.   liability.
  16.  
  17.   ------------------------------------------------------------- }
  18.  
  19. program Test28;
  20. uses Objects, App, App28, Drivers, Views, Menus, Editors, 
  21.      Memory, Dialogs, MsgBox;
  22.  
  23. type
  24.   TTestApp = object(TApp28)
  25.     constructor Init;
  26.     procedure InitMenuBar; virtual;
  27.     procedure HandleEvent (var Event: TEvent); virtual;
  28.     function OpenEditor (FileName: FNameStr): PEditWindow;
  29.   end;
  30.  
  31. const
  32.   cm25Lines = 150;
  33.   cm28Lines = 151;
  34.   cm50Lines = 152;
  35.  
  36. var
  37.   TestApp: TTestApp;
  38.  
  39. function FileExists (FileNm: string): boolean;
  40. var Untyped: file;
  41. begin
  42.   {$I-}
  43.   assign(Untyped,FileNm);
  44.   FileMode := 0;
  45.   reset(Untyped);
  46.   close(Untyped);
  47.   {$I+}
  48.   FileExists := (IOResult = 0) and (FileNm <> '');
  49. end;
  50.  
  51. function DoEditDialog (Dialog: Integer; Info: Pointer): Word; far;
  52. begin
  53.   case Dialog of
  54.     edOutOfMemory:
  55.       DoEditDialog := MessageBox ('Not enough memory for this operation.',
  56.         nil, mfError + mfOkButton);
  57.     edReadError:
  58.       DoEditDialog := MessageBox ('Error reading file %s.',
  59.         @Info, mfError + mfOkButton);
  60.     edWriteError:
  61.       DoEditDialog := MessageBox ('Error writing file %s.',
  62.         @Info, mfError + mfOkButton);
  63.     edCreateError:
  64.       DoEditDialog := MessageBox ('Error creating file %s.',
  65.         @Info, mfError + mfOkButton);
  66.     edSaveModify: 
  67.       DoEditDialog := cmNo;
  68.     edSaveUntitled: 
  69.       DoEditDialog := cmNo;
  70.   end;
  71. end;
  72.  
  73. constructor TTestApp.Init;
  74. begin
  75.   MaxHeapSize := 4096;
  76.   inherited Init;
  77.   EditorDialog := DoEditDialog;
  78. end;
  79.  
  80. procedure TTestApp.InitMenuBar;
  81. var R: TRect;
  82. begin
  83.   GetExtent(R);
  84.   R.B.Y := R.A.Y+1;
  85.   MenuBar := New(PMenubar,Init(R,NewMenu(
  86.     NewSubMenu('~F~ile',hcNoContext,NewMenu(
  87.       NewItem('~O~pen','F3',kbF3,cmOpen,hcNoContext,
  88.       NewItem('E~x~it','Alt+X',kbAltX,cmQuit,hcNoContext,
  89.       nil))),
  90.     NewSubMenu('~O~ptions',hcNoContext,NewMenu(
  91.       NewItem('2~5~ lines','',0,cm25Lines,hcNoContext,
  92.       NewItem('2~8~ lines','',0,cm28Lines,hcNoContext,
  93.       NewItem('~4~3/50 lines','',0,cm50Lines,hcNoContext,
  94.       nil)))),
  95.     NewSubMenu('~W~indow',hcNoContext,NewMenu(
  96.       StdWindowMenuItems(nil)),
  97.     nil)
  98.   )))));
  99. end;
  100.  
  101. function TTestApp.OpenEditor;
  102. var
  103.   P: PView;
  104.   R: TRect;
  105. begin
  106.   DeskTop^.GetExtent(R);
  107.   P := Application^.ValidView(New(PEditWindow,
  108.     Init(R, FileName, wnNoNumber)));
  109.   DeskTop^.Insert(P);
  110.   OpenEditor := PEditWindow(P);
  111. end;
  112.  
  113. procedure TTestApp.HandleEvent;
  114. const ViewFile = 'TEST28.PAS';
  115. begin
  116.   inherited HandleEvent(Event);
  117.   if (Event.What = evCommand) then
  118.     case Event.Command of
  119.       cmOpen: 
  120.         if FileExists(ViewFile) then OpenEditor(ViewFile)
  121.           else OpenEditor('');
  122.       cm25Lines: 
  123.         if (ScreenMode and smFont8x8 <> 0) or
  124.             (ScreenMode and smFont8x14 <> 0) then
  125.           SetScreenMode((ScreenMode and not smFont8x8) 
  126.                          and not smFont8x14);
  127.       cm28Lines: 
  128.         if ScreenMode and smFont8x14 = 0 then
  129.           SetScreenMode((ScreenMode and not smFont8x8) 
  130.                          or smFont8x14);
  131.       cm50Lines: 
  132.         if ScreenMode and smFont8x8 = 0 then
  133.           SetScreenMode((ScreenMode or smFont8x8) 
  134.                          and not smFont8x14);
  135.     end; { case }
  136.   ClearEvent(Event);
  137. end;
  138.  
  139. begin
  140.   TestApp.Init;
  141.   TestApp.Run;
  142.   TestApp.Done;
  143. end.