home *** CD-ROM | disk | FTP | other *** search
/ The Devil's Doorknob BBS Capture (1996-2003) / devilsdoorknobbbscapture1996-2003.iso / Dloads / OTHERUTI / TPASCAL3.ZIP / TVDEMOS.ZIP / TVEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-11  |  11KB  |  398 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Editor Demo                     }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program TVEdit;
  10.  
  11. {$M 8192,8192,655360}
  12. {$X+,S-}
  13.  
  14. { This program demonstrates the use of the Buffers and Editors
  15.   units. See also BUFFERS.DOC and EDITORS.DOC in the \TP\DOC
  16.   directory.
  17. }
  18.  
  19. uses Dos, Objects, Drivers, Memory, Views, Menus, Dialogs,
  20.   StdDlg, MsgBox, App, Calc, Buffers, Editors;
  21.  
  22. const
  23.   HeapSize = 32 * (1024 div 16);
  24.  
  25. const
  26.   cmOpen       = 100;
  27.   cmNew        = 101;
  28.   cmChangeDir  = 102;
  29.   cmDosShell   = 103;
  30.   cmCalculator = 104;
  31.   cmShowClip   = 105;
  32.  
  33. type
  34.   PEditorApp = ^TEditorApp;
  35.   TEditorApp = object(TApplication)
  36.     constructor Init;
  37.     destructor Done; virtual;
  38.     procedure HandleEvent(var Event: TEvent); virtual;
  39.     procedure InitMenuBar; virtual;
  40.     procedure InitStatusLine; virtual;
  41.     procedure OutOfMemory; virtual;
  42.   end;
  43.  
  44. var
  45.   EditorApp: TEditorApp;
  46.   ClipWindow: PEditWindow;
  47.  
  48. function ExecDialog(P: PDialog; Data: Pointer): Word;
  49. var
  50.   Result: Word;
  51. begin
  52.   Result := cmCancel;
  53.   P := PDialog(Application^.ValidView(P));
  54.   if P <> nil then
  55.   begin
  56.     if Data <> nil then P^.SetData(Data^);
  57.     Result := DeskTop^.ExecView(P);
  58.     if (Result <> cmCancel) and (Data <> nil) then P^.GetData(Data^);
  59.     Dispose(P, Done);
  60.   end;
  61.   ExecDialog := Result;
  62. end;
  63.  
  64. function CreateFindDialog: PDialog;
  65. var
  66.   D: PDialog;
  67.   Control: PView;
  68.   R: TRect;
  69. begin
  70.   R.Assign(0, 0, 38, 12);
  71.   D := New(PDialog, Init(R, 'Find'));
  72.   with D^ do
  73.   begin
  74.     Options := Options or ofCentered;
  75.  
  76.     R.Assign(3, 3, 32, 4);
  77.     Control := New(PInputLine, Init(R, 80));
  78.     Insert(Control);
  79.     R.Assign(2, 2, 15, 3);
  80.     Insert(New(PLabel, Init(R, '~T~ext to find', Control)));
  81.     R.Assign(32, 3, 35, 4);
  82.     Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
  83.  
  84.     R.Assign(3, 5, 35, 7);
  85.     Insert(New(PCheckBoxes, Init(R,
  86.       NewSItem('~C~ase sensitive',
  87.       NewSItem('~W~hole words only', nil)))));
  88.  
  89.     R.Assign(14, 9, 24, 11);
  90.     Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
  91.     Inc(R.A.X, 12); Inc(R.B.X, 12);
  92.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  93.  
  94.     SelectNext(False);
  95.   end;
  96.   CreateFindDialog := D;
  97. end;
  98.  
  99. function CreateReplaceDialog: PDialog;
  100. var
  101.   D: PDialog;
  102.   Control: PView;
  103.   R: TRect;
  104. begin
  105.   R.Assign(0, 0, 40, 16);
  106.   D := New(PDialog, Init(R, 'Replace'));
  107.   with D^ do
  108.   begin
  109.     Options := Options or ofCentered;
  110.  
  111.     R.Assign(3, 3, 34, 4);
  112.     Control := New(PInputLine, Init(R, 80));
  113.     Insert(Control);
  114.     R.Assign(2, 2, 15, 3);
  115.     Insert(New(PLabel, Init(R, '~T~ext to find', Control)));
  116.     R.Assign(34, 3, 37, 4);
  117.     Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
  118.  
  119.     R.Assign(3, 6, 34, 7);
  120.     Control := New(PInputLine, Init(R, 80));
  121.     Insert(Control);
  122.     R.Assign(2, 5, 12, 6);
  123.     Insert(New(PLabel, Init(R, '~N~ew text', Control)));
  124.     R.Assign(34, 6, 37, 7);
  125.     Insert(New(PHistory, Init(R, PInputLine(Control), 11)));
  126.  
  127.     R.Assign(3, 8, 37, 12);
  128.     Insert(New(PCheckBoxes, Init(R,
  129.       NewSItem('~C~ase sensitive',
  130.       NewSItem('~W~hole words only',
  131.       NewSItem('~P~rompt on replace',
  132.       NewSItem('~R~eplace all', nil)))))));
  133.  
  134.     R.Assign(17, 13, 27, 15);
  135.     Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
  136.     R.Assign(28, 13, 38, 15);
  137.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  138.  
  139.     SelectNext(False);
  140.   end;
  141.   CreateReplaceDialog := D;
  142. end;
  143.  
  144. function DoEditDialog(Dialog: Integer; Info: Pointer): Word; far;
  145. var
  146.   R: TRect;
  147.   T: TPoint;
  148. begin
  149.   case Dialog of
  150.     edOutOfMemory:
  151.       DoEditDialog := MessageBox('Not enough memory for this operation.',
  152.         nil, mfError + mfOkButton);
  153.     edReadError:
  154.       DoEditDialog := MessageBox('Error reading file %s.',
  155.         @Info, mfError + mfOkButton);
  156.     edWriteError:
  157.       DoEditDialog := MessageBox('Error writing file %s.',
  158.         @Info, mfError + mfOkButton);
  159.     edCreateError:
  160.       DoEditDialog := MessageBox('Error creating file %s.',
  161.         @Info, mfError + mfOkButton);
  162.     edSaveModify:
  163.       DoEditDialog := MessageBox('%s has been modified. Save?',
  164.         @Info, mfInformation + mfYesNoCancel);
  165.     edSaveUntitled:
  166.       DoEditDialog := MessageBox('Save untitled file?',
  167.         nil, mfInformation + mfYesNoCancel);
  168.     edSaveAs:
  169.       DoEditDialog := ExecDialog(New(PFileDialog, Init('*.*',
  170.         'Save file as', '~N~ame', fdOkButton, 101)), Info);
  171.     edFind:
  172.       DoEditDialog := ExecDialog(CreateFindDialog, Info);
  173.     edSearchFailed:
  174.       DoEditDialog := MessageBox('Search string not found.',
  175.         nil, mfError + mfOkButton);
  176.     edReplace:
  177.       DoEditDialog := ExecDialog(CreateReplaceDialog, Info);
  178.     edReplacePrompt:
  179.       begin
  180.         { Avoid placing the dialog on the same line as the cursor }
  181.         R.Assign(0, 1, 40, 8);
  182.         R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
  183.         Desktop^.MakeGlobal(R.B, T);
  184.         Inc(T.Y);
  185.         if TPoint(Info).Y <= T.Y then
  186.           R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
  187.         DoEditDialog := MessageBoxRect(R, 'Replace this occurence?',
  188.           nil, mfYesNoCancel + mfInformation);
  189.       end;
  190.   end;
  191. end;
  192.  
  193. function OpenEditor(FileName: FNameStr; Visible: Boolean): PEditWindow;
  194. var
  195.   P: PView;
  196.   R: TRect;
  197. begin
  198.   DeskTop^.GetExtent(R);
  199.   P := Application^.ValidView(New(PEditWindow,
  200.     Init(R, FileName, wnNoNumber)));
  201.   if not Visible then P^.Hide;
  202.   DeskTop^.Insert(P);
  203.   OpenEditor := PEditWindow(P);
  204. end;
  205.  
  206. constructor TEditorApp.Init;
  207. var
  208.   H: Word;
  209.   R: TRect;
  210. begin
  211.   H := PtrRec(HeapEnd).Seg - PtrRec(HeapPtr).Seg;
  212.   if H > HeapSize then BufHeapSize := H - HeapSize else BufHeapSize := 0;
  213.   InitBuffers;
  214.   TApplication.Init;
  215.   DisableCommands([cmSave, cmSaveAs, cmCut, cmCopy, cmPaste, cmClear,
  216.     cmUndo, cmFind, cmReplace, cmSearchAgain]);
  217.   EditorDialog := DoEditDialog;
  218.   ClipWindow := OpenEditor('', False);
  219.   if ClipWindow <> nil then
  220.   begin
  221.     Clipboard := ClipWindow^.Editor;
  222.     Clipboard^.CanUndo := False;
  223.   end;
  224. end;
  225.  
  226. destructor TEditorApp.Done;
  227. begin
  228.   TApplication.Done;
  229.   DoneBuffers;
  230. end;
  231.  
  232. procedure TEditorApp.HandleEvent(var Event: TEvent);
  233.  
  234. procedure FileOpen;
  235. var
  236.   FileName: FNameStr;
  237. begin
  238.   FileName := '*.*';
  239.   if ExecDialog(New(PFileDialog, Init('*.*', 'Open file',
  240.     '~N~ame', fdOpenButton, 100)), @FileName) <> cmCancel then
  241.     OpenEditor(FileName, True);
  242. end;
  243.  
  244. procedure FileNew;
  245. begin
  246.   OpenEditor('', True);
  247. end;
  248.  
  249. procedure ChangeDir;
  250. begin
  251.   ExecDialog(New(PChDirDialog, Init(cdNormal, 0)), nil);
  252. end;
  253.  
  254. procedure DosShell;
  255. begin
  256.   DoneSysError;
  257.   DoneEvents;
  258.   DoneVideo;
  259.   DoneMemory;
  260.   SetMemTop(Ptr(BufHeapPtr, 0));
  261.   PrintStr('Type EXIT to return to TVEDIT...');
  262.   SwapVectors;
  263.   Exec(GetEnv('COMSPEC'), '');
  264.   SwapVectors;
  265.   SetMemTop(Ptr(BufHeapEnd, 0));
  266.   InitMemory;
  267.   InitVideo;
  268.   InitEvents;
  269.   InitSysError;
  270.   Redraw;
  271. end;
  272.  
  273. procedure ShowClip;
  274. begin
  275.   ClipWindow^.Select;
  276.   ClipWindow^.Show;
  277. end;
  278.  
  279. procedure Tile;
  280. var
  281.   R: TRect;
  282. begin
  283.   Desktop^.GetExtent(R);
  284.   Desktop^.Tile(R);
  285. end;
  286.  
  287. procedure Cascade;
  288. var
  289.   R: TRect;
  290. begin
  291.   Desktop^.GetExtent(R);
  292.   Desktop^.Cascade(R);
  293. end;
  294.  
  295. procedure Calculator;
  296. begin
  297.   DeskTop^.Insert(ValidView(New(PCalculator, Init)));
  298. end;
  299.  
  300. begin
  301.   TApplication.HandleEvent(Event);
  302.   case Event.What of
  303.     evCommand:
  304.       case Event.Command of
  305.         cmOpen: FileOpen;
  306.         cmNew: FileNew;
  307.         cmChangeDir: ChangeDir;
  308.         cmDosShell: DosShell;
  309.         cmCalculator: Calculator;
  310.         cmShowClip: ShowClip;
  311.         cmTile: Tile;
  312.         cmCascade: Cascade;
  313.       else
  314.         Exit;
  315.       end;
  316.   else
  317.     Exit;
  318.   end;
  319.   ClearEvent(Event);
  320. end;
  321.  
  322. procedure TEditorApp.InitMenuBar;
  323. var
  324.   R: TRect;
  325. begin
  326.   GetExtent(R);
  327.   R.B.Y := R.A.Y + 1;
  328.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  329.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  330.       NewItem('~O~pen...', 'F3', kbF3, cmOpen, hcNoContext,
  331.       NewItem('~N~ew', '', kbNoKey, cmNew, hcNoContext,
  332.       NewItem('~S~ave', 'F2', kbF2, cmSave, hcNoContext,
  333.       NewItem('S~a~ve as...', '', kbNoKey, cmSaveAs, hcNoContext,
  334.       NewLine(
  335.       NewItem('~C~hange dir...', '', kbNoKey, cmChangeDir, hcNoContext,
  336.       NewItem('~D~OS shell', '', kbNoKey, cmDosShell, hcNoContext,
  337.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  338.       nil))))))))),
  339.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  340.       NewItem('~U~ndo', '', kbNoKey, cmUndo, hcNoContext,
  341.       NewLine(
  342.       NewItem('Cu~t~', 'Shift-Del', kbShiftDel, cmCut, hcNoContext,
  343.       NewItem('~C~opy', 'Ctrl-Ins', kbCtrlIns, cmCopy, hcNoContext,
  344.       NewItem('~P~aste', 'Shift-Ins', kbShiftIns, cmPaste, hcNoContext,
  345.       NewItem('~S~how clipboard', '', kbNoKey, cmShowClip, hcNoContext,
  346.       NewLine(
  347.       NewItem('~C~lear', 'Ctrl-Del', kbCtrlDel, cmClear, hcNoContext,
  348.       nil))))))))),
  349.     NewSubMenu('~S~earch', hcNoContext, NewMenu(
  350.       NewItem('~F~ind...', '', kbNoKey, cmFind, hcNoContext,
  351.       NewItem('~R~eplace...', '', kbNoKey, cmReplace, hcNoContext,
  352.       NewItem('~S~earch again', '', kbNoKey, cmSearchAgain, hcNoContext,
  353.       nil)))),
  354.     NewSubMenu('~W~indows', hcNoContext, NewMenu(
  355.       NewItem('~S~ize/move','Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  356.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  357.       NewItem('~T~ile', '', kbNoKey, cmTile, hcNoContext,
  358.       NewItem('C~a~scade', '', kbNoKey, cmCascade, hcNoContext,
  359.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  360.       NewItem('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
  361.       NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
  362.       NewLine(
  363.       NewItem('Ca~l~culator', '', kbNoKey, cmCalculator, hcNoContext,
  364.       nil)))))))))),
  365.     nil)))))));
  366. end;
  367.  
  368. procedure TEditorApp.InitStatusLine;
  369. var
  370.   R: TRect;
  371. begin
  372.   GetExtent(R);
  373.   R.A.Y := R.B.Y - 1;
  374.   New(StatusLine, Init(R,
  375.     NewStatusDef(0, $FFFF,
  376.       NewStatusKey('~F2~ Save', kbF2, cmSave,
  377.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  378.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  379.       NewStatusKey('~F5~ Zoom', kbF5, cmZoom,
  380.       NewStatusKey('~F6~ Next', kbF6, cmNext,
  381.       NewStatusKey('~F10~ Menu', kbF10, cmMenu,
  382.       NewStatusKey('', kbCtrlF5, cmResize,
  383.       nil))))))),
  384.     nil)));
  385. end;
  386.  
  387. procedure TEditorApp.OutOfMemory;
  388. begin
  389.   MessageBox('Not enough memory for this operation.',
  390.     nil, mfError + mfOkButton);
  391. end;
  392.  
  393. begin
  394.   EditorApp.Init;
  395.   EditorApp.Run;
  396.   EditorApp.Done;
  397. end.
  398.