home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l044 / 2.ddi / TVDEMOS.ZIP / TVBGI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-23  |  7.8 KB  |  304 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision BGI Support Demo                }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program TVBGI;
  10.  
  11. {$M 8192,8192,655360}
  12. {$S-}
  13.  
  14. { This simple Vision program shows how to use GRAPHAPP unit
  15.   to control switching back and forth to BGI routines from
  16.   inside a Turbo Vision application.
  17.  
  18.   If you are running this program in the IDE, be sure to enable
  19.   the full graphics save option when you load TURBO.EXE:
  20.  
  21.     turbo -g
  22.  
  23.   This ensures that the IDE fully swaps video RAM and keeps
  24.   "dustclouds" from appearing on the user screen when in
  25.   graphics mode. You can enable this option permanently
  26.   via the Options|Environment|Startup dialog.
  27.  
  28.   This program uses the Graph unit and its .BGI driver files to
  29.   display graphics on your system. The "PathToDrivers"
  30.   constant defined below is set to \TP\BGI, which is the default
  31.   location of the BGI files as installed by the INSTALL program.
  32.   If you have installed these files in a different location, make
  33.   sure the .BGI file for your system (EGAVGA.BGI, etc.) is in the
  34.   current directory or modify the "PathToDrivers" constant
  35.   accordingly.
  36. }
  37.  
  38. {$X+}
  39.  
  40. uses
  41.   Dos, Graph, Objects, Drivers, Memory, Views, Menus, Dialogs,
  42.   StdDlg, MsgBox, App, GraphApp;
  43.  
  44. const
  45.   PathToDrivers = '\TP\BGI';  { Default location of *.BGI files }
  46.  
  47.   cmTile       = 100;
  48.   cmCascade    = 101;
  49.   cmNewWin     = 1000;
  50.   cmChangeDir  = 1001;
  51.   cmSetBGIPath = 1002;
  52.   cmDoGraphics = 1003;
  53.  
  54.   hlChangeDir  = cmChangeDir;        { History list ID }
  55.   hlSetBGIPath = cmSetBGIPath;       { History list ID }
  56.  
  57. type
  58.   PBGIApp = ^TBGIApp;
  59.   TBGIApp = object(TApplication)
  60.     AppDriver: Integer;
  61.     AppMode: Integer;
  62.     BGIPath: PString;
  63.     constructor Init;
  64.     destructor Done; virtual;
  65.     procedure HandleEvent(var Event: TEvent); virtual;
  66.     procedure InitMenuBar; virtual;
  67.     procedure InitStatusLine; virtual;
  68.     procedure OutOfMemory; virtual;
  69.   end;
  70.  
  71. constructor TBGIApp.Init;
  72. begin
  73.   TApplication.Init;
  74.   BGIPath := NewStr(FExpand(PathToDrivers));
  75.   AppDriver := Detect;
  76.   AppMode := 0;
  77.   if not GraphAppInit(AppDriver, AppMode, BGIPath, True) then
  78.     MessageBox('Cannot load graphics driver.',
  79.       nil, mfError or mfOkButton);
  80. end;
  81.  
  82. destructor TBGIApp.Done;
  83. begin
  84.   GraphAppDone;
  85.   if BGIPath <> nil then DisposeStr(BGIPath);
  86.   TApplication.Done;
  87. end;
  88.  
  89. procedure TBGIApp.HandleEvent(var Event: TEvent);
  90.  
  91. procedure NewWin;
  92. const
  93.   WinNum: Word = 0;
  94. var
  95.   R: TRect;
  96.   S: string[3];
  97.   P: PWindow;
  98. begin
  99.   Str(WinNum, S);
  100.   DeskTop^.GetExtent(R);
  101.   with DeskTop^.Size do
  102.     R.Assign(WinNum mod Pred(Y), WinNum mod Pred(Y), X, Y);
  103.   Inc(WinNum);
  104.   P := New(PWindow, Init(R, 'Window ' + S, 0));
  105.   P^.Options := P^.Options or ofTileable;
  106.   DeskTop^.Insert(ValidView(P));
  107. end;
  108.  
  109. { Draw random polygons with random fill styles on the screen }
  110. procedure DoGraphics;
  111. const
  112.   MaxPts = 5;
  113. type
  114.   PolygonType = array[1..MaxPts] of PointType;
  115. var
  116.   Event: TEvent;
  117.   Poly: PolygonType;
  118.   I, Color: Word;
  119.   MaxX, MaxY: Word;
  120. begin
  121.   if not GraphicsStart then
  122.     MessageBox(GraphErrorMsg(GraphResult) + '.',
  123.       nil, mfError or mfOkButton)
  124.   else
  125.   begin
  126.     MaxX := GetMaxX;
  127.     MaxY := GetMaxY;
  128.     OutTextXY(0, MaxY - TextHeight('M'),
  129.       'Press any key to return...');
  130.     SetViewPort(0, 0, MaxX - 1, MaxY - (TextHeight('M') + 5), ClipOn);
  131.     repeat
  132.       Color := Random(GetMaxColor) + 1;
  133.       SetFillStyle(Random(11) + 1, Color);
  134.       SetColor(Color);
  135.       for I := 1 to MaxPts do
  136.         with Poly[I] do
  137.         begin
  138.           X := Random(MaxX);
  139.           Y := Random(MaxY);
  140.         end;
  141.       FillPoly(MaxPts, Poly);
  142.       GetKeyEvent(Event);
  143.     until Event.What <> evNothing;
  144.     GraphicsStop;
  145.   end;
  146. end;
  147.  
  148. procedure SetBGIPath;
  149. var
  150.   D: PDialog;
  151.   R: TRect;
  152.   Control: PView;
  153.   PathInput: PInputLine;
  154.   S: PathStr;
  155. begin
  156.   R.Assign(0, 0, 35, 8);
  157.   D := New(PDialog, Init(R, 'Path to BGI Files'));
  158.   D^.Options := D^.Options or ofCentered;
  159.  
  160.   { Buttons }
  161.   R.Assign(23, 5, 33, 7);
  162.   D^.Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  163.   R.Assign(12, 5, 22, 7);
  164.   D^.Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
  165.  
  166.   { Input line, history list and label }
  167.   R.Assign(3, 3, 30, 4);
  168.   PathInput := New(PInputLine, Init(R, 68));
  169.   D^.Insert(PathInput);
  170.   R.Assign(30, 3, 33, 4);
  171.   Control := New(PHistory, Init(R, PathInput, hlSetBGIPath));
  172.   D^.Insert(Control);
  173.  
  174.   S := FExpand(BGIPath^);
  175.   D^.SetData(S);
  176.   D := PDialog(ValidView(D));
  177.   if D <> nil then
  178.   begin
  179.     if Desktop^.ExecView(D) = cmOk then
  180.     begin
  181.       D^.GetData(S);
  182.       DisposeStr(BGIPath);
  183.       S := FExpand(S);
  184.       if (Length(S) > 0) and (S[Length(S)] <> '\') then
  185.         S := S + '\';
  186.       BGIPath := NewStr(S);
  187.       if not GraphAppInit(AppDriver, AppMode, BGIPath, True) then
  188.         MessageBox('Cannot load graphics driver.', nil,
  189.           mfError or mfOkButton);
  190.     end;
  191.     Dispose(D, Done);
  192.   end;
  193. end;
  194.  
  195. procedure ChangeDir;
  196. var
  197.   P: PView;
  198. begin
  199.   P := ValidView(New(PChDirDialog, Init(0, hlChangeDir)));
  200.   if P <> nil then
  201.   begin
  202.     DeskTop^.ExecView(P);
  203.     Dispose(P, Done);
  204.   end;
  205. end;
  206.  
  207. procedure Tile;
  208. var
  209.   R: TRect;
  210. begin
  211.   Desktop^.GetExtent(R);
  212.   Desktop^.Tile(R);
  213. end;
  214.  
  215. procedure Cascade;
  216. var
  217.   R: TRect;
  218. begin
  219.   Desktop^.GetExtent(R);
  220.   Desktop^.Cascade(R);
  221. end;
  222.  
  223. begin
  224.   TApplication.HandleEvent(Event);
  225.   case Event.What of
  226.     evCommand:
  227.       case Event.Command of
  228.         cmNewWin: NewWin;
  229.         cmChangeDir: ChangeDir;
  230.         cmSetBGIPath: SetBGIPath;
  231.         cmDoGraphics: DoGraphics;
  232.         cmTile: Tile;
  233.         cmCascade: Cascade;
  234.       else
  235.         Exit;
  236.       end;
  237.   else
  238.     Exit;
  239.   end;
  240.   ClearEvent(Event);
  241. end;
  242.  
  243. procedure TBGIApp.InitMenuBar;
  244. var
  245.   R: TRect;
  246. begin
  247.   GetExtent(R);
  248.   R.B.Y := R.A.Y + 1;
  249.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  250.     NewSubMenu('~T~est', hcNoContext, NewMenu(
  251.       NewItem('~B~GI settings...', '', kbNoKey, 0, hcNoContext,
  252.       NewItem('~G~raph', 'Alt-F5', kbAltF5, cmDoGraphics, hcNoContext,
  253.       NewItem('~S~et BGI path...', '', kbNoKey, cmSetBGIPath, hcNoContext,
  254.       NewLine(
  255.       NewItem('~C~hange dir...', '', kbNoKey, cmChangeDir, hcNoContext,
  256.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  257.       nil))))))),
  258.     NewSubMenu('~W~indows', hcNoContext, NewMenu(
  259.         NewItem('~S~ize/move','Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  260.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  261.       NewItem('~T~ile', '', kbNoKey, cmTile, hcNoContext,
  262.       NewItem('C~a~scade', '', kbNoKey, cmCascade, hcNoContext,
  263.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  264.       NewItem('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
  265.       NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
  266.       NewLine(
  267.     NewItem('Add ~w~indow','F4', kbF4, cmNewWin, hcNoContext,
  268.       nil)))))))))),
  269.     nil)))));
  270. end;
  271.  
  272. procedure TBGIApp.InitStatusLine;
  273. var
  274.   R: TRect;
  275. begin
  276.   GetExtent(R);
  277.   R.A.Y := R.B.Y - 1;
  278.   New(StatusLine, Init(R,
  279.     NewStatusDef(0, $FFFF,
  280.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  281.       NewStatusKey('~Alt-F5~ Graph', kbAltF5, cmDoGraphics,
  282.       NewStatusKey('', kbF10, cmMenu,
  283.       NewStatusKey('', kbAltF3, cmClose,
  284.       NewStatusKey('', kbF5, cmZoom,
  285.       NewStatusKey('', kbCtrlF5, cmResize,
  286.       NewStatusKey('', kbF6, cmNext,
  287.       nil))))))),
  288.     nil)));
  289. end;
  290.  
  291. procedure TBGIApp.OutOfMemory;
  292. begin
  293.   MessageBox('Out of memory.', nil, mfError or mfOkButton);
  294. end;
  295.  
  296. var
  297.   BGIApp: TBGIApp;
  298.  
  299. begin
  300.   BGIApp.Init;
  301.   BGIApp.Run;
  302.   BGIApp.Done;
  303. end.
  304.