home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l044 / 4.ddi / DOCDEMOS.ZIP / TVGUID16.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-23  |  7.4 KB  |  293 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Demo program from the Turbo Vision Guide     }
  5. {                                                }
  6. {   Copyright (c) 1990 by Borland International  }
  7. {                                                }
  8. {************************************************}
  9.  
  10. program TVGUID16;
  11.  
  12. uses Objects, Drivers, Views, Menus, Dialogs, App;
  13.  
  14. const
  15.   FileToRead        = 'TVGUID16.PAS';
  16.   MaxLines          = 100;
  17.   WinCount: Integer =   0;
  18.   cmFileOpen        = 100;
  19.   cmNewWin          = 101;
  20.   cmNewDialog       = 102;
  21.  
  22. var
  23.   LineCount: Integer;
  24.   Lines: array[0..MaxLines - 1] of PString;
  25.  
  26. type
  27.   DialogData = record
  28.     CheckBoxData: Word;
  29.     RadioButtonData: Word;
  30.     InputLineData: string[128];
  31.   end;
  32.  
  33.   TMyApp = object(TApplication)
  34.     procedure HandleEvent(var Event: TEvent); virtual;
  35.     procedure InitMenuBar; virtual;
  36.     procedure InitStatusLine; virtual;
  37.     procedure NewDialog;
  38.     procedure NewWindow;
  39.   end;
  40.  
  41.   PInterior = ^TInterior;
  42.   TInterior = object(TScroller)
  43.     constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  44.     procedure Draw; virtual;
  45.   end;
  46.  
  47.   PDemoWindow = ^TDemoWindow;
  48.   TDemoWindow = object(TWindow)
  49.     RInterior, LInterior: PInterior;
  50.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  51.     function MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
  52.     procedure SizeLimits(var Min, Max: TPoint); virtual;
  53.   end;
  54.  
  55.   PDemoDialog = ^TDemoDialog;
  56.   TDemoDialog = object(TDialog)
  57.   end;
  58.  
  59. var
  60.   DemoDialogData: DialogData;
  61.  
  62. procedure ReadFile;
  63. var
  64.   F: Text;
  65.   S: String;
  66. begin
  67.   LineCount := 0;
  68.   Assign(F, FileToRead);
  69.   {$I-}
  70.   Reset(F);
  71.   {$I+}
  72.   if IOResult <> 0 then
  73.   begin
  74.     Writeln('Cannot open ', FileToRead);
  75.     Halt(1);
  76.   end;
  77.   while not Eof(F) and (LineCount < MaxLines) do
  78.   begin
  79.     Readln(F, S);
  80.     Lines[LineCount] := NewStr(S);
  81.     Inc(LineCount);
  82.   end;
  83.   Close(F);
  84. end;
  85.  
  86. procedure DoneFile;
  87. var
  88.   I: Integer;
  89. begin
  90.   for I := 0 to LineCount - 1 do
  91.     if Lines[I] <> nil then DisposeStr(Lines[i]);
  92. end;
  93.  
  94. { TInterior }
  95. constructor TInterior.Init(var Bounds: TRect; AHScrollBar,
  96.   AVScrollBar: PScrollBar);
  97. begin
  98.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  99.   Options := Options or ofFramed;
  100.   SetLimit(128, LineCount);
  101. end;
  102.  
  103. procedure TInterior.Draw;
  104. var
  105.   Color: Byte;
  106.   I, Y: Integer;
  107.   B: TDrawBuffer;
  108. begin
  109.   Color := GetColor(1);
  110.   for Y := 0 to Size.Y - 1 do
  111.   begin
  112.     MoveChar(B, ' ', Color, Size.X);
  113.     i := Delta.Y + Y;
  114.     if (I < LineCount) and (Lines[I] <> nil) then
  115.       MoveStr(B, Copy(Lines[I]^, Delta.X + 1, Size.X), Color);
  116.     WriteLine(0, Y, Size.X, 1, B);
  117.   end;
  118. end;
  119.  
  120. { TDemoWindow }
  121. constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  122. var
  123.   S: string[3];
  124.   R: TRect;
  125. begin
  126.   Str(WindowNo, S);
  127.   TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  128.   GetExtent(Bounds);
  129.   R.Assign(Bounds.A.X, Bounds.A.Y, Bounds.B.X div 2 + 1, Bounds.B.Y);
  130.   LInterior := MakeInterior(R, True);
  131.   LInterior^.GrowMode := gfGrowHiY;
  132.   Insert(Linterior);
  133.   R.Assign(Bounds.B.X div 2, Bounds.A.Y, Bounds.B.X, Bounds.B.Y);
  134.   RInterior := MakeInterior(R,False);
  135.   RInterior^.GrowMode := gfGrowHiX + gfGrowHiY;
  136.   Insert(RInterior);
  137. end;
  138.  
  139. function TDemoWindow.MakeInterior(Bounds: TRect; Left: Boolean): PInterior;
  140. var
  141.   HScrollBar, VScrollBar: PScrollBar;
  142.   R: TRect;
  143. begin
  144.   R.Assign(Bounds.B.X-1, Bounds.A.Y+1, Bounds.B.X, Bounds.B.Y-1);
  145.   VScrollBar := New(PScrollBar, Init(R));
  146.   VScrollBar^.Options := VScrollBar^.Options or ofPostProcess;
  147.   if Left then VScrollBar^.GrowMode := gfGrowHiY;
  148.   Insert(VScrollBar);
  149.   R.Assign(Bounds.A.X+2, Bounds.B.Y-1, Bounds.B.X-2, Bounds.B.Y);
  150.   HScrollBar := New(PScrollBar, Init(R));
  151.   HScrollBar^.Options := HScrollBar^.Options or ofPostProcess;
  152.   if Left then HScrollBar^.GrowMode := gfGrowHiY + gfGrowLoY;
  153.   Insert(HScrollBar);
  154.   Bounds.Grow(-1,-1);
  155.   MakeInterior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar));
  156. end;
  157.  
  158. procedure TDemoWindow.SizeLimits(var Min, Max: TPoint);
  159. var R: TRect;
  160. begin
  161.   TWindow.SizeLimits(Min, Max);
  162.   Min.X := LInterior^.Size.X + 9;
  163. end;
  164.  
  165. { TMyApp }
  166. procedure TMyApp.HandleEvent(var Event: TEvent);
  167. begin
  168.   TApplication.HandleEvent(Event);
  169.   if Event.What = evCommand then
  170.   begin
  171.     case Event.Command of
  172.       cmNewWin: NewWindow;
  173.       cmNewDialog: NewDialog;
  174.     else
  175.       Exit;
  176.     end;
  177.     ClearEvent(Event);
  178.   end;
  179. end;
  180.  
  181. procedure TMyApp.InitMenuBar;
  182. var R: TRect;
  183. begin
  184.   GetExtent(R);
  185.   R.B.Y := R.A.Y + 1;
  186.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  187.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  188.       NewItem('~O~pen', 'F3', kbF3, cmFileOpen, hcNoContext,
  189.       NewItem('~N~ew', 'F4', kbF4, cmNewWin, hcNoContext,
  190.       NewLine(
  191.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  192.       nil))))),
  193.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  194.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  195.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  196.       NewItem('~D~ialog', 'F2', kbF2, cmNewDialog, hcNoContext,
  197.       nil)))),
  198.     nil))
  199.   )));
  200. end;
  201.  
  202. procedure TMyApp.InitStatusLine;
  203. var R: TRect;
  204. begin
  205.   GetExtent(R);
  206.   R.A.Y := R.B.Y - 1;
  207.   StatusLine := New(PStatusLine, Init(R,
  208.     NewStatusDef(0, $FFFF,
  209.       NewStatusKey('', kbF10, cmMenu,
  210.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  211.       NewStatusKey('~F4~ New', kbF4, cmNewWin,
  212.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  213.       nil)))),
  214.     nil)
  215.   ));
  216. end;
  217.  
  218. procedure TMyApp.NewDialog;
  219. var
  220.   Bruce: PView;
  221.   Dialog: PDemoDialog;
  222.   R: TRect;
  223.   C: Word;
  224. begin
  225.   R.Assign(20, 6, 60, 19);
  226.   Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
  227.   with Dialog^ do
  228.   begin
  229.     R.Assign(3, 3, 18, 6);
  230.     Bruce := New(PCheckBoxes, Init(R,
  231.       NewSItem('~H~varti',
  232.       NewSItem('~T~ilset',
  233.       NewSItem('~J~arlsberg',
  234.       nil)))
  235.     ));
  236.     Insert(Bruce);
  237.     R.Assign(2, 2, 10, 3);
  238.     Insert(New(PLabel, Init(R, 'Cheeses', Bruce)));
  239.     R.Assign(22, 3, 34, 6);
  240.     Bruce := New(PRadioButtons, Init(R,
  241.       NewSItem('~S~olid',
  242.       NewSItem('~R~unny',
  243.       NewSItem('~M~elted',
  244.       nil)))
  245.     ));
  246.     Insert(Bruce);
  247.     R.Assign(21, 2, 33, 3);
  248.     Insert(New(PLabel, Init(R, 'Consistency', Bruce)));
  249.     R.Assign(3, 8, 37, 9);
  250.     Bruce := New(PInputLine, Init(R, 128));
  251.     Insert(Bruce);
  252.     R.Assign(2, 7, 24, 8);
  253.     Insert(New(PLabel, Init(R, 'Delivery instructions', Bruce)));
  254.     R.Assign(15, 10, 25, 12);
  255.     Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
  256.     R.Assign(28, 10, 38, 12);
  257.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  258.   end;
  259.   Dialog^.SetData(DemoDialogData);
  260.   C := DeskTop^.ExecView(Dialog);
  261.   if C <> cmCancel then Dialog^.GetData(DemoDialogData);
  262.   Dispose(Dialog, Done);
  263. end;
  264.  
  265. procedure TMyApp.NewWindow;
  266. var
  267.   Window: PDemoWindow;
  268.   R: TRect;
  269. begin
  270.   Inc(WinCount);
  271.   R.Assign(0, 0, 45, 13);
  272.   R.Move(Random(34), Random(11));
  273.   Window := New(PDemoWindow, Init(R, 'Demo Window', WinCount));
  274.   DeskTop^.Insert(Window);
  275. end;
  276.  
  277. var
  278.   MyApp: TMyApp;
  279.  
  280. begin
  281.   with DemoDialogData do
  282.   begin
  283.     CheckboxData := 1;
  284.     RadioButtonData := 2;
  285.     InputLineData := 'Phone home.';
  286.   end;
  287.   ReadFile;
  288.   MyApp.Init;
  289.   MyApp.Run;
  290.   MyApp.Done;
  291.   DoneFile;
  292. end.
  293.