home *** CD-ROM | disk | FTP | other *** search
/ Lion Share / lionsharecd.iso / dos_misc / holmes.zip / HOLMES.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-27  |  8KB  |  295 lines
  1. program Holmes;
  2.  
  3. uses Objects, Drivers, Views, Menus, App;
  4.  
  5. const
  6.   MaxLines          = 11000;
  7.   WinCount: Integer =   0;
  8.   cmChapter1_1      = 101;
  9.   cmChapter1_2      = 102;
  10.   cmChapter1_3      = 103;
  11.   cmChapter1_4      = 104;
  12.   cmChapter1_5      = 105;
  13.   cmChapter1_6      = 106;
  14.   cmChapter1_7      = 107;
  15.   cmChapter2_1      = 108;
  16.   cmChapter2_2      = 109;
  17.   cmChapter2_3      = 110;
  18.   cmChapter2_4      = 111;
  19.   cmChapter2_5      = 112;
  20.   cmChapter2_6      = 113;
  21.   cmChapter2_7      = 114;
  22.   cmAbout           = 115;
  23.  
  24. var
  25.   LineCount: Integer;
  26.   Lines: array[0..MaxLines - 1] of PString;
  27.    
  28. type
  29.   TMyApp = object(TApplication)
  30.     procedure HandleEvent(var Event: TEvent); virtual;
  31.     procedure InitMenuBar; virtual;
  32.     procedure InitStatusLine; virtual;
  33.     procedure NewWindow;
  34.   end;
  35.  
  36.   PInterior = ^TInterior;
  37.   TInterior = object(TScroller)
  38.     constructor Init(var Bounds: TRect; AHScrollBar,
  39.       AVScrollBar: PScrollBar);
  40.     procedure Draw; virtual;
  41.   end;
  42.  
  43.   PDemoWindow = ^TDemoWindow;
  44.   TDemoWindow = object(TWindow)
  45.     constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
  46.     procedure MakeInterior(Bounds: TRect);
  47.   end;
  48.  
  49. procedure ReadFile (FileToRead : string);
  50. var
  51.   F: Text;
  52.   S: String;
  53. begin
  54.   LineCount := 0;
  55.   Assign(F, FileToRead);
  56.   {$I-}
  57.   Reset(F);
  58.   {$I+}
  59.   if IOResult <> 0 then
  60.   begin
  61.     Writeln('Cannot open ', FileToRead);
  62.     Halt(1);
  63.   end;
  64.   while not Eof(F) and (LineCount < MaxLines) do
  65.   begin
  66.     Readln(F, S);
  67.     Lines[LineCount] := NewStr(S);
  68.     Inc(LineCount);
  69.   end;
  70.   Close(F);
  71. end;
  72.  
  73. procedure DoneFile;
  74. var
  75.   I: Integer;
  76. begin
  77.   for I := 0 to LineCount - 1 do
  78.     if Lines[I] <> nil then DisposeStr(Lines[i]);
  79. end;
  80.  
  81. { TInterior }
  82. constructor TInterior.Init(var Bounds: TRect; AHScrollBar,
  83.   AVScrollBar: PScrollBar);
  84. begin
  85.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  86.   GrowMode := gfGrowHiX + gfGrowHiY;
  87.   Options := Options or ofFramed;
  88.   SetLimit(128, LineCount);
  89. end;
  90.  
  91. procedure TInterior.Draw;
  92. var
  93.   Color: Byte;
  94.   I, Y: Integer;
  95.   B: TDrawBuffer;
  96. begin
  97.   Color := GetColor(1);
  98.   for Y := 0 to Size.Y - 1 do
  99.   begin
  100.     MoveChar(B, ' ', Color, Size.X);
  101.     i := Delta.Y + Y;
  102.     if (I < LineCount) and (Lines[I] <> nil) then
  103.       MoveStr(B, Copy(Lines[I]^, Delta.X + 1, Size.X), Color);
  104.     WriteLine(0, Y, Size.X, 1, B);
  105.   end;
  106. end;
  107.  
  108. { TDemoWindow }
  109. constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String;
  110.   WindowNo: Word);
  111. var
  112.   S: string[3];
  113. begin
  114.   Str(WindowNo, S);
  115.   TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  116.   MakeInterior(Bounds);
  117. end;
  118.  
  119. procedure TDemoWindow.MakeInterior(Bounds: TRect);
  120. var
  121.   HScrollBar, VScrollBar: PScrollBar;
  122.   Interior: PInterior;
  123.   R: TRect;
  124. begin
  125.   VScrollBar := StandardScrollBar(sbVertical + sbHandleKeyboard);
  126.   HScrollBar := StandardScrollBar(sbHorizontal + sbHandleKeyboard);
  127.   GetExtent(Bounds);
  128.   Bounds.Grow(-1,-1);
  129.   Interior := New(PInterior, Init(Bounds, HScrollBar, VScrollBar));
  130.   Insert(Interior);
  131. end;
  132.  
  133. { TMyApp }
  134. procedure TMyApp.HandleEvent(var Event: TEvent);
  135.  
  136. begin
  137.   TApplication.HandleEvent(Event);
  138.   if Event.What = evCommand then
  139.   begin
  140.     case Event.Command of
  141.       cmAbout : BEGIN
  142.                   ReadFile ('ABOUT.TXT');
  143.                   WinCount := 0;
  144.                   NewWindow;
  145.                 END;
  146.       cmChapter1_1: BEGIN
  147.                       ReadFile ('STUDY11.TXT');
  148.                       WinCount := 1;
  149.                       NewWindow;
  150.                     END;
  151.       cmChapter1_2: BEGIN
  152.                       ReadFile ('STUDY12.TXT');
  153.                       WinCount := 2;
  154.                       NewWindow;
  155.                     END;
  156.       cmChapter1_3: BEGIN
  157.                       ReadFile ('STUDY13.TXT');
  158.                       WinCount := 3;
  159.                       NewWindow;
  160.                     END;
  161.       cmChapter1_4: BEGIN
  162.                       ReadFile ('STUDY14.TXT');
  163.                       WinCount := 4;
  164.                       NewWindow;
  165.                     END;
  166.       cmChapter1_5: BEGIN
  167.                       ReadFile ('STUDY15.TXT');
  168.                       WinCount := 5;
  169.                       NewWindow;
  170.                     END;
  171.       cmChapter1_6: BEGIN
  172.                       ReadFile ('STUDY16.TXT');
  173.                       WinCount := 6;
  174.                       NewWindow;
  175.                     END;
  176.       cmChapter1_7: BEGIN
  177.                       ReadFile ('STUDY17.TXT');
  178.                       WinCount := 7;
  179.                       NewWindow;
  180.                     END;
  181.       cmChapter2_1: BEGIN
  182.                       ReadFile ('STUDY21.TXT');
  183.                       WinCount := 1;
  184.                       NewWindow;
  185.                     END;
  186.       cmChapter2_2: BEGIN
  187.                       ReadFile ('STUDY22.TXT');
  188.                       WinCount := 2;
  189.                       NewWindow;
  190.                     END;
  191.       cmChapter2_3: BEGIN
  192.                       ReadFile ('STUDY23.TXT');
  193.                       WinCount := 3;
  194.                       NewWindow;
  195.                     END;
  196.       cmChapter2_4: BEGIN
  197.                       ReadFile ('STUDY24.TXT');
  198.                       WinCount := 4;
  199.                       NewWindow;
  200.                     END;
  201.       cmChapter2_5: BEGIN
  202.                       ReadFile ('STUDY25.TXT');
  203.                       WinCount := 5;
  204.                       NewWindow;
  205.                     END;
  206.       cmChapter2_6: BEGIN
  207.                       ReadFile ('STUDY26.TXT');
  208.                       WinCount := 6;
  209.                       NewWindow;
  210.                     END;
  211.       cmChapter2_7: BEGIN
  212.                       ReadFile ('STUDY27.TXT');
  213.                       WinCount := 7;
  214.                       NewWindow;
  215.                     END;
  216.     else
  217.       Exit;
  218.     end;
  219.     ClearEvent(Event);
  220.   end;
  221. end;
  222.  
  223. procedure TMyApp.InitMenuBar;
  224. var R: TRect;
  225. begin
  226.   GetExtent(R);
  227.   R.B.Y := R.A.Y + 1;
  228.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  229.     NewSubMenu('~I~nfo   ', hcNoContext, NewMenu(
  230.       NewItem('~A~ Study in Scarlet', '', kbNoKey, cmAbout, hcNoContext,
  231.       NewLine(
  232.       NewItem('E~x~it', '', kbAltX, cmQuit, hcNoContext, nil)))),
  233.     NewSubMenu('  Part ~1~  ', hcNoContext, NewMenu(
  234.       NewItem('Chapter ~1~', '', kbNoKey, cmChapter1_1, hcNoContext,
  235.       NewItem('Chapter ~2~', '', kbNoKey, cmChapter1_2, hcNoContext,
  236.       NewItem('Chapter ~3~', '', kbNoKey, cmChapter1_3, hcNoContext,
  237.       NewItem('Chapter ~4~', '', kbNoKey, cmChapter1_4, hcNoContext,
  238.       NewItem('Chapter ~5~', '', kbNoKey, cmChapter1_5, hcNoContext,
  239.       NewItem('Chapter ~6~', '', kbNoKey, cmChapter1_6, hcNoContext,
  240.       NewItem('Chapter ~7~', '', kbNoKey, cmChapter1_7, hcNoContext,
  241.       nil)))))))),
  242.     NewSubMenu('  Part ~2~  ', hcNoContext, NewMenu(
  243.       NewItem('Chapter ~1~', '', kbNoKey, cmChapter2_1, hcNoContext,
  244.       NewItem('Chapter ~2~', '', kbNoKey, cmChapter2_2, hcNoContext,
  245.       NewItem('Chapter ~3~', '', kbNoKey, cmChapter2_3, hcNoContext,
  246.       NewItem('Chapter ~4~', '', kbNoKey, cmChapter2_4, hcNoContext,
  247.       NewItem('Chapter ~5~', '', kbNoKey, cmChapter2_5, hcNoContext,
  248.       NewItem('Chapter ~6~', '', kbNoKey, cmChapter2_6, hcNoContext,
  249.       NewItem('Chapter ~7~', '', kbNoKey, cmChapter2_7, hcNoContext,
  250.       nil)))))))),
  251.     NewSubMenu('  ~W~indows  ', hcNoContext, NewMenu(
  252.       NewItem('~R~esize/move','Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  253.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  254.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  255.       NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
  256.       nil))))),
  257.     nil))
  258.   )))));
  259. end;
  260.  
  261. procedure TMyApp.InitStatusLine;
  262. var R: TRect;
  263. begin
  264.   GetExtent(R);
  265.   R.A.Y := R.B.Y - 1;
  266.   StatusLine := New(PStatusLine, Init(R,
  267.     NewStatusDef(0, $FFFF,
  268.       NewStatusKey('', kbF10, cmMenu,
  269.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  270.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  271.       nil))),
  272.     nil)
  273.   ));
  274. end;
  275.  
  276. procedure TMyApp.NewWindow;
  277. var
  278.   Window: PDemoWindow;
  279.   R: TRect;
  280. begin
  281.   R.Assign(0, 0, 80, 23);
  282.   Window := New(PDemoWindow, Init(R, 'Chapter', WinCount));
  283.   DeskTop^.Insert(Window);
  284. end;
  285.  
  286. var
  287.   MyApp: TMyApp;
  288.  
  289. begin
  290.   MyApp.Init;
  291.   MyApp.Run;
  292.   MyApp.Done;
  293.   DoneFile;
  294. end.
  295.