home *** CD-ROM | disk | FTP | other *** search
/ The Devil's Doorknob BBS Capture (1996-2003) / devilsdoorknobbbscapture1996-2003.iso / Dloads / OTHERUTI / TPASCAL3.ZIP / TVDEMOS.ZIP / HELPFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-11  |  20KB  |  848 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Demo                            }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit HelpFile;
  10.  
  11. {$F+,O+,X+,S-,D-}
  12.  
  13. interface
  14.  
  15. uses Objects, Drivers, Views;
  16.  
  17. const
  18.   CHelpColor      = #$37#$3F#$3A#$13#$13#$30#$3E#$1E;
  19.   CHelpBlackWhite = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  20.   CHelpMonochrome = #$07#$0F#$07#$70#$70#$07#$0F#$70;
  21.   CHelpViewer     = #6#7#8;
  22.   CHelpWindow     = #64#65#66#67#68#69#70#71;
  23.  
  24. type
  25.  
  26. { TParagraph }
  27.  
  28.   PParagraph = ^TParagraph;
  29.   TParagraph = record
  30.     Next: PParagraph;
  31.     Wrap: Boolean;
  32.     Size: Word;
  33.     Text: record end;
  34.   end;
  35.  
  36. { THelpTopic }
  37.  
  38.   TCrossRef = record
  39.     Ref: Integer;
  40.     Offset: Integer;
  41.     Length: Byte;
  42.   end;
  43.  
  44.   PCrossRefs = ^TCrossRefs;
  45.   TCrossRefs = array[1..10000] of TCrossRef;
  46.   TCrossRefHandler = procedure (var S: TStream; XRefValue: Integer);
  47.  
  48.   PHelpTopic = ^THelpTopic;
  49.   THelpTopic = object(TObject)
  50.     constructor Init;
  51.     constructor Load(var S: TStream);
  52.     destructor Done; virtual;
  53.     procedure AddCrossRef(Ref: TCrossRef);
  54.     procedure AddParagraph(P: PParagraph);
  55.     procedure GetCrossRef(I: Integer; var Loc: TPoint; var Length: Byte;
  56.       var Ref: Integer);
  57.     function GetLine(Line: Integer): String;
  58.     function GetNumCrossRefs: Integer;
  59.     function NumLines: Integer;
  60.     procedure SetCrossRef(I: Integer; var Ref: TCrossRef);
  61.     procedure SetNumCrossRefs(I: Integer);
  62.     procedure SetWidth(AWidth: Integer);
  63.     procedure Store(var S: TStream);
  64.   private
  65.     Paragraphs: PParagraph;
  66.     NumRefs: Integer;
  67.     CrossRefs: PCrossRefs;
  68.     Width: Integer;
  69.     LastOffset: Integer;
  70.     LastLine: Integer;
  71.     LastParagraph: PParagraph;
  72.     function WrapText(var Text; Size: Integer; var Offset: Integer;
  73.       Wrap: Boolean): String;
  74.   end;
  75.  
  76. { THelpIndex }
  77.  
  78.   PIndexArray = ^TIndexArray;
  79.   TIndexArray = array[0..16380] of LongInt;
  80.  
  81.   PHelpIndex = ^THelpIndex;
  82.   THelpIndex = object(TObject)
  83.     Size: Word;
  84.     Index: PIndexArray;
  85.     constructor Init;
  86.     constructor Load(var S: TStream);
  87.     destructor Done; virtual;
  88.     function Position(I: Integer): Longint;
  89.     procedure Add(I: Integer; Val: Longint);
  90.     procedure Store(var S: TStream);
  91.   end;
  92.  
  93. { THelpFile }
  94.  
  95.   PHelpFile = ^THelpFile;
  96.   THelpFile = object(TObject)
  97.     Stream: PStream;
  98.     Modified: Boolean;
  99.     constructor Init(S: PStream);
  100.     destructor Done; virtual;
  101.     function GetTopic(I: Integer): PHelpTopic;
  102.     function InvalidTopic: PHelpTopic;
  103.     procedure RecordPositionInIndex(I: Integer);
  104.     procedure PutTopic(Topic: PHelpTopic);
  105.   private
  106.     Index: PHelpIndex;
  107.     IndexPos: LongInt;
  108.   end;
  109.  
  110. { THelpViewer }
  111.  
  112.   PHelpViewer = ^THelpViewer;
  113.   THelpViewer = object(TScroller)
  114.     HFile: PHelpFile;
  115.     Topic: PHelpTopic;
  116.     Selected: Integer;
  117.     constructor Init(var Bounds: TRect; AHScrollBar,
  118.       AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
  119.     destructor Done; virtual;
  120.     procedure ChangeBounds(var Bounds: TRect); virtual;
  121.     procedure Draw; virtual;
  122.     function GetPalette: PPalette; virtual;
  123.     procedure HandleEvent(var Event: TEvent); virtual;
  124.   end;
  125.  
  126. { THelpWindow }
  127.  
  128.   PHelpWindow = ^THelpWindow;
  129.   THelpWindow = object(TWindow)
  130.     constructor Init(HFile: PHelpFile; Context: Word);
  131.     function GetPalette: PPalette; virtual;
  132.   end;
  133.  
  134. const
  135.  
  136.   RHelpTopic: TStreamRec = (
  137.      ObjType: 10000;
  138.      VmtLink: Ofs(TypeOf(THelpTopic)^);
  139.      Load:    @THelpTopic.Load;
  140.      Store:   @THelpTopic.Store
  141.   );
  142.   RHelpIndex: TStreamRec = (
  143.      ObjType: 10001;
  144.      VmtLink: Ofs(TypeOf(THelpIndex)^);
  145.      Load:    @THelpIndex.Load;
  146.      Store:   @THelpIndex.Store
  147.   );
  148.  
  149. procedure RegisterHelpFile;
  150.  
  151. procedure NotAssigned(var S: TStream; Value: Integer);
  152.  
  153. const
  154.   CrossRefHandler: TCrossRefHandler = NotAssigned;
  155.  
  156. implementation
  157.  
  158. { THelpTopic }
  159.  
  160. constructor THelpTopic.Init;
  161. begin
  162.   TObject.Init;
  163.   LastLine := MaxInt;
  164. end;
  165.  
  166. constructor THelpTopic.Load(var S: TStream);
  167.  
  168. procedure ReadParagraphs;
  169. var
  170.   I, Size: Integer;
  171.   PP: ^PParagraph;
  172. begin
  173.   S.Read(I, SizeOf(I));
  174.   PP := @Paragraphs;
  175.   while I > 0 do
  176.   begin
  177.     S.Read(Size, SizeOf(Size));
  178.     GetMem(PP^, SizeOf(PP^^) + Size);
  179.     PP^^.Size := Size;
  180.     S.Read(PP^^.Wrap, SizeOf(Boolean));
  181.     S.Read(PP^^.Text, Size);
  182.     PP := @PP^^.Next;
  183.     Dec(I);
  184.   end;
  185.   PP^ := nil;
  186. end;
  187.  
  188. procedure ReadCrossRefs;
  189. begin
  190.   S.Read(NumRefs, SizeOf(Integer));
  191.   GetMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  192.   S.Read(CrossRefs^, SizeOf(TCrossRef) * NumRefs);
  193. end;
  194.  
  195. begin
  196.   ReadParagraphs;
  197.   ReadCrossRefs;
  198.   Width := 0;
  199.   LastLine := MaxInt;
  200. end;
  201.  
  202. destructor THelpTopic.Done;
  203.  
  204. procedure DisposeParagraphs;
  205. var
  206.   P, T: PParagraph;
  207. begin
  208.   P := Paragraphs;
  209.   while P <> nil do
  210.   begin
  211.     T := P;
  212.     P := P^.Next;
  213.     FreeMem(T, SizeOf(T^) + T^.Size);
  214.   end;
  215. end;
  216.  
  217. begin
  218.   DisposeParagraphs;
  219.   FreeMem(CrossRefs, SizeOf(TCrossRef) * NumRefs);
  220.   TObject.Done
  221. end;
  222.  
  223. procedure THelpTopic.AddCrossRef(Ref: TCrossRef);
  224. var
  225.   P: PCrossRefs;
  226. begin
  227.   GetMem(P, (NumRefs+1) * SizeOf(TCrossRef));
  228.   if NumRefs > 0 then
  229.   begin
  230.     Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef));
  231.     FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  232.   end;
  233.   CrossRefs^[NumRefs] := Ref;
  234.   Inc(NumRefs);
  235. end;
  236.  
  237. procedure THelpTopic.AddParagraph(P: PParagraph);
  238. var
  239.   PP: ^PParagraph;
  240. begin
  241.   PP := @Paragraphs;
  242.   while PP^ <> nil do
  243.     PP := @PP^^.Next;
  244.   PP^ := P;
  245.   P^.Next := nil;
  246. end;
  247.  
  248. procedure THelpTopic.GetCrossRef(I: Integer; var Loc: TPoint;
  249.   var Length: Byte; var Ref: Integer);
  250. var
  251.   OldOffset, CurOffset, Offset, ParaOffset: Integer;
  252.   P: PParagraph;
  253.   Line: Integer;
  254. begin
  255.   ParaOffset := 0;
  256.   CurOffset := 0;
  257.   OldOffset := 0;
  258.   Line := 0;
  259.   Offset := CrossRefs^[I].Offset;
  260.   P := Paragraphs;
  261.   while ParaOffset+CurOffset < Offset do
  262.   begin
  263.     OldOffset := ParaOffset + CurOffset;
  264.     WrapText(P^.Text, P^.Size, CurOffset, P^.Wrap);
  265.     Inc(Line);
  266.     if CurOffset >= P^.Size then
  267.     begin
  268.       Inc(ParaOffset, P^.Size);
  269.       P := P^.Next;
  270.       CurOffset := 0;
  271.     end;
  272.   end;
  273.   Loc.X := Offset - OldOffset - 1;
  274.   Loc.Y := Line;
  275.   Length := CrossRefs^[I].Length;
  276.   Ref := CrossRefs^[I].Ref;
  277. end;
  278.  
  279. function THelpTopic.GetLine(Line: Integer): String;
  280. var
  281.   Offset, I: Integer;
  282.   P: PParagraph;
  283. begin
  284.   if LastLine < Line then
  285.   begin
  286.     I := Line;
  287.     Dec(Line, LastLine);
  288.     LastLine := I;
  289.     Offset := LastOffset;
  290.     P := LastParagraph;
  291.   end
  292.   else
  293.   begin
  294.     P := Paragraphs;
  295.     Offset := 0;
  296.     LastLine := Line;
  297.   end;
  298.   GetLine := '';
  299.   while (P <> nil) do
  300.   begin
  301.     while Offset < P^.Size do
  302.     begin
  303.       Dec(Line);
  304.       GetLine := WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
  305.       if Line = 0 then
  306.       begin
  307.         LastOffset := Offset;
  308.         LastParagraph := P;
  309.         Exit;
  310.       end;
  311.     end;
  312.     P := P^.Next;
  313.     Offset := 0;
  314.   end;
  315.   GetLine := '';
  316. end;
  317.  
  318. function THelpTopic.GetNumCrossRefs: Integer;
  319. begin
  320.   GetNumCrossRefs := NumRefs;
  321. end;
  322.  
  323. function THelpTopic.NumLines: Integer;
  324. var
  325.   Offset, Lines: Integer;
  326.   P: PParagraph;
  327. begin
  328.   Offset := 0;
  329.   Lines := 0;
  330.   P := Paragraphs;
  331.   while P <> nil do
  332.   begin
  333.     Offset := 0;
  334.     while Offset < P^.Size do
  335.     begin
  336.       Inc(Lines);
  337.       WrapText(P^.Text, P^.Size, Offset, P^.Wrap);
  338.     end;
  339.     P := P^.Next;
  340.   end;
  341.   NumLines := Lines;
  342. end;
  343.  
  344. procedure THelpTopic.SetCrossRef(I: Integer; var Ref: TCrossRef);
  345. begin
  346.   if I <= NumRefs then CrossRefs^[I] := Ref;
  347. end;
  348.  
  349. procedure THelpTopic.SetNumCrossRefs(I: Integer);
  350. var
  351.   P: PCrossRefs;
  352. begin
  353.   if NumRefs = I then Exit;
  354.   GetMem(P, I * SizeOf(TCrossRef));
  355.   if NumRefs > 0 then
  356.   begin
  357.     if I > NumRefs then Move(CrossRefs^, P^, NumRefs * SizeOf(TCrossRef))
  358.     else Move(CrossRefs^, P^, I * SizeOf(TCrossRef));
  359.     FreeMem(CrossRefs, NumRefs * SizeOf(TCrossRef));
  360.   end;
  361.   CrossRefs := P;
  362.   NumRefs := I;
  363. end;
  364.  
  365. procedure THelpTopic.SetWidth(AWidth: Integer);
  366. begin
  367.   Width := AWidth;
  368. end;
  369.  
  370. procedure THelpTopic.Store(var S: TStream);
  371.  
  372. procedure WriteParagraphs;
  373. var
  374.   I: Integer;
  375.   P: PParagraph;
  376. begin
  377.   P := Paragraphs;
  378.   I := 0;
  379.   while P <> nil do
  380.   begin
  381.     Inc(I);
  382.     P := P^.Next;
  383.   end;
  384.   S.Write(I, SizeOf(I));
  385.   P := Paragraphs;
  386.   while P <> nil do
  387.   begin
  388.     S.Write(P^.Size, SizeOf(Integer));
  389.     S.Write(P^.Wrap, SizeOf(Boolean));
  390.     S.Write(P^.Text, P^.Size);
  391.     P := P^.Next;
  392.   end;
  393. end;
  394.  
  395. procedure WriteCrossRefs;
  396. var
  397.   I: Integer;
  398. begin
  399.   S.Write(NumRefs, SizeOf(Integer));
  400.   if @CrossRefHandler = @NotAssigned then
  401.     S.Write(CrossRefs^, SizeOf(TCrossRef) * NumRefs)
  402.   else
  403.     for I := 1 to NumRefs do
  404.     begin
  405.       CrossRefHandler(S, CrossRefs^[I].Ref);
  406.       S.Write(CrossRefs^[I].Offset, SizeOf(Integer) + SizeOf(Byte));
  407.     end;
  408. end;
  409.  
  410. begin
  411.   WriteParagraphs;
  412.   WriteCrossRefs;
  413. end;
  414.  
  415. function THelpTopic.WrapText(var Text; Size: Integer;
  416.   var Offset: Integer; Wrap: Boolean): String;
  417. type
  418.   PCArray = ^CArray;
  419.   CArray = array[0..32767] of Char;
  420. var
  421.   Line: String;
  422.   I, P: Integer;
  423.  
  424. function IsBlank(Ch: Char): Boolean;
  425. begin
  426.   IsBlank := (Ch = ' ') or (Ch = #13) or (Ch = #10);
  427. end;
  428.  
  429. function Scan(var P; Offset: Integer; C: Char): Integer; assembler;
  430. asm
  431.     CLD
  432.     LES    DI,P
  433.         ADD    DI,&Offset
  434.     MOV    CX,256
  435.     MOV    AL, C
  436.         REPNE    SCASB
  437.     SUB    CX,256
  438.         NEG    CX
  439.         XCHG    AX,CX
  440. end;
  441.  
  442. procedure TextToLine(var Text; Offset, Length: Integer; var Line: String);
  443.   assembler;
  444. asm
  445.     CLD
  446.     PUSH    DS
  447.     LDS    SI,Text
  448.         ADD    SI,&Offset
  449.         LES     DI,Line
  450.         MOV    AX,Length
  451.         STOSB
  452.         XCHG    AX,CX
  453.         REP    MOVSB
  454.         POP    DS
  455. end;
  456.  
  457. begin
  458.   I := Scan(Text, Offset, #13);
  459.   if I + Offset > Size then I := Size - Offset;
  460.   if (I >= Width) and Wrap then
  461.   begin
  462.     I := Offset + Width;
  463.     if I > Size then I := Size
  464.     else
  465.     begin
  466.       while (I > Offset) and not IsBlank(PCArray(@Text)^[I]) do Dec(I);
  467.       if I = Offset then I := Offset + Width
  468.       else Inc(I);
  469.     end;
  470.     if I = Offset then I := Offset + Width;
  471.     Dec(I, Offset);
  472.   end;
  473.   TextToLine(Text, Offset, I, Line);
  474.   if Line[Length(Line)] = #13 then Dec(Line[0]);
  475.   Inc(Offset, I);
  476.   WrapText := Line;
  477. end;
  478.  
  479. { THelpIndex }
  480.  
  481. constructor THelpIndex.Init;
  482. begin
  483.   TObject.Init;
  484.   Size := 0;
  485.   Index := nil;
  486. end;
  487.  
  488. constructor THelpIndex.Load(var S: TStream);
  489. begin
  490.   S.Read(Size, SizeOf(Size));
  491.   if Size = 0 then Index := nil
  492.   else
  493.   begin
  494.     GetMem(Index, SizeOf(Longint) * Size);
  495.     S.Read(Index^, SizeOf(Longint) * Size);
  496.   end;
  497. end;
  498.  
  499. destructor THelpIndex.Done;
  500. begin
  501.   FreeMem(Index, SizeOf(Longint) * Size);
  502.   TObject.Done;
  503. end;
  504.  
  505. function THelpIndex.Position(I: Integer): Longint;
  506. begin
  507.   if I < Size then Position := Index^[I]
  508.   else Position := -1;
  509. end;
  510.  
  511. procedure THelpIndex.Add(I: Integer; Val: Longint);
  512. const
  513.   Delta = 10;
  514. var
  515.   P: PIndexArray;
  516.   NewSize: Integer;
  517. begin
  518.   if I >= Size then
  519.   begin
  520.     NewSize := (I + Delta) div Delta * Delta;
  521.     GetMem(P, NewSize * SizeOf(LongInt));
  522.     if P <> nil then
  523.     begin
  524.       Move(Index^, P^, Size * SizeOf(LongInt));
  525.       FillChar(P^[Size], (NewSize - Size) * SizeOf(Longint), $FF);
  526.     end;
  527.     if Size > 0 then FreeMem(Index, Size * SizeOf(Longint));
  528.     Index := P;
  529.     Size := NewSize;
  530.   end;
  531.   Index^[I] := Val;
  532. end;
  533.  
  534. procedure THelpIndex.Store(var S: TStream);
  535. begin
  536.   S.Write(Size, SizeOf(Size));
  537.   S.Write(Index^, SizeOf(Longint) * Size);
  538. end;
  539.  
  540. { THelpFile }
  541.  
  542. const
  543.   MagicHeader = $46484246; {'FBHF'}
  544.  
  545. constructor THelpFile.Init(S: PStream);
  546. var
  547.   Magic: Longint;
  548. begin
  549.   Magic := 0;
  550.   S^.Seek(0);
  551.   if S^.GetSize > SizeOf(Magic) then
  552.     S^.Read(Magic, SizeOf(Magic));
  553.   if Magic <> MagicHeader then
  554.   begin
  555.     IndexPos := 12;
  556.     S^.Seek(IndexPos);
  557.     Index := New(PHelpIndex, Init);
  558.     Modified := True;
  559.   end
  560.   else
  561.   begin
  562.     S^.Seek(8);
  563.     S^.Read(IndexPos, SizeOf(IndexPos));
  564.     S^.Seek(IndexPos);
  565.     Index := PHelpIndex(S^.Get);
  566.     Modified := False;
  567.   end;
  568.   Stream := S;
  569. end;
  570.  
  571. destructor THelpFile.Done;
  572. var
  573.   Magic, Size: Longint;
  574. begin
  575.   if Modified then
  576.   begin
  577.     Stream^.Seek(IndexPos);
  578.     Stream^.Put(Index);
  579.     Stream^.Seek(0);
  580.     Magic := MagicHeader;
  581.     Size := Stream^.GetSize - 8;
  582.     Stream^.Write(Magic, SizeOf(Magic));
  583.     Stream^.Write(Size, SizeOf(Size));
  584.     Stream^.Write(IndexPos, SizeOf(IndexPos));
  585.   end;
  586.   Dispose(Stream, Done);
  587.   Dispose(Index, Done);
  588. end;
  589.  
  590. function THelpFile.GetTopic(I: Integer): PHelpTopic;
  591. var
  592.   Pos: Longint;
  593. begin
  594.   Pos := Index^.Position(I);
  595.   if Pos > 0 then
  596.   begin
  597.     Stream^.Seek(Pos);
  598.     GetTopic := PHelpTopic(Stream^.Get);
  599.   end
  600.   else GetTopic := InvalidTopic;
  601. end;
  602.  
  603. function THelpFile.InvalidTopic: PHelpTopic;
  604. var
  605.   Topic: PHelpTopic;
  606.   Para: PParagraph;
  607. const
  608.   InvalidStr = #13' No help available in this context.';
  609.   InvalidText: array[1..Length(InvalidStr)] of Char = InvalidStr;
  610. begin
  611.   Topic := New(PHelpTopic, Init);
  612.   GetMem(Para, SizeOf(Para^) + SizeOf(InvalidText));
  613.   Para^.Size := SizeOf(InvalidText);
  614.   Para^.Wrap := False;
  615.   Para^.Next := nil;
  616.   Move(InvalidText, Para^.Text, SizeOf(InvalidText));
  617.   Topic^.AddParagraph(Para);
  618.   InvalidTopic := Topic;
  619. end;
  620.  
  621. procedure THelpFile.RecordPositionInIndex(I: Integer);
  622. begin
  623.   Index^.Add(I, IndexPos);
  624.   Modified := True;
  625. end;
  626.  
  627. procedure THelpFile.PutTopic(Topic: PHelpTopic);
  628. begin
  629.   Stream^.Seek(IndexPos);
  630.   Stream^.Put(Topic);
  631.   IndexPos := Stream^.GetPos;
  632.   Modified := True;
  633. end;
  634.  
  635. { THelpViewer }
  636.  
  637. constructor THelpViewer.Init(var Bounds: TRect; AHScrollBar,
  638.   AVScrollBar: PScrollBar; AHelpFile: PHelpFile; Context: Word);
  639. begin
  640.   TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  641.   Options := Options or ofSelectable;
  642.   GrowMode := gfGrowHiX + gfGrowHiY;
  643.   HFile := AHelpFile;
  644.   Topic := AHelpFile^.GetTopic(Context);
  645.   Topic^.SetWidth(Size.X);
  646.   SetLimit(78, Topic^.NumLines);
  647.   Selected := 1;
  648. end;
  649.  
  650. destructor THelpViewer.Done;
  651. begin
  652.   TScroller.Done;
  653.   Dispose(HFile, Done);
  654.   Dispose(Topic, Done);
  655. end;
  656.  
  657. procedure THelpViewer.ChangeBounds(var Bounds: TRect);
  658. begin
  659.   TScroller.ChangeBounds(Bounds);
  660.   Topic^.SetWidth(Size.X);
  661.   SetLimit(Limit.X, Topic^.NumLines);
  662. end;
  663.  
  664. procedure THelpViewer.Draw;
  665. var
  666.   B: TDrawBuffer;
  667.   Line: String;
  668.   I, J, L: Integer;
  669.   KeyCount: Integer;
  670.   Normal, Keyword, SelKeyword, C: Byte;
  671.   KeyPoint: TPoint;
  672.   KeyLength: Byte;
  673.   KeyRef: Integer;
  674. begin
  675.   Normal := GetColor(1);
  676.   Keyword := GetColor(2);
  677.   SelKeyword := GetColor(3);
  678.   KeyCount := 0;
  679.   KeyPoint.X := 0;
  680.   KeyPoint.Y := 0;
  681.   Topic^.SetWidth(Size.X);
  682.   if Topic^.GetNumCrossRefs > 0 then
  683.     repeat
  684.       Inc(KeyCount);
  685.       Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
  686.     until (KeyCount >= Topic^.GetNumCrossRefs) or (KeyPoint.Y > Delta.Y);
  687.   for I := 1 to Size.Y do
  688.   begin
  689.     MoveChar(B, ' ', Normal, Size.X);
  690.     Line := Topic^.GetLine(I + Delta.Y);
  691.     MoveStr(B, Copy(Line, Delta.X+1, Size.X), Normal);
  692.     while I + Delta.Y = KeyPoint.Y do
  693.     begin
  694.       L := KeyLength;
  695.       if KeyPoint.X < Delta.X then
  696.       begin
  697.         Dec(L, Delta.X - KeyPoint.X);
  698.         KeyPoint.X := Delta.X;
  699.       end;
  700.       if KeyCount = Selected then C := SelKeyword
  701.       else C := Keyword;
  702.       for J := 0 to L-1 do
  703.         WordRec(B[KeyPoint.X - Delta.X + J]).Hi := C;
  704.       Inc(KeyCount);
  705.       if KeyCount <= Topic^.GetNumCrossRefs then
  706.         Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef)
  707.       else KeyPoint.Y := 0;
  708.     end;
  709.     WriteLine(0, I-1, Size.X, 1, B);
  710.   end;
  711. end;
  712.  
  713. function THelpViewer.GetPalette: PPalette;
  714. const
  715.   P: String[Length(CHelpViewer)] = CHelpViewer;
  716. begin
  717.   GetPalette := @P;
  718. end;
  719.  
  720. procedure THelpViewer.HandleEvent(var Event: TEvent);
  721. var
  722.   KeyPoint, Mouse: TPoint;
  723.   KeyLength: Byte;
  724.   KeyRef: Integer;
  725.   KeyCount: Integer;
  726.  
  727. procedure MakeSelectVisible;
  728. var
  729.   D: TPoint;
  730. begin
  731.   Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
  732.   D := Delta;
  733.   if KeyPoint.X < D.X then D.X := KeyPoint.X
  734.   else if KeyPoint.X + KeyLength > D.X + Size.X then
  735.     D.X := KeyPoint.X + KeyLength - Size.X + 1;
  736.   if KeyPoint.Y <= D.Y then D.Y := KeyPoint.Y - 1;
  737.   if KeyPoint.Y > D.Y + Size.Y then D.Y := KeyPoint.Y - Size.Y;
  738.   if (D.X <> Delta.X) or (D.Y <> Delta.Y) then ScrollTo(D.X, D.Y);
  739. end;
  740.  
  741. procedure SwitchToTopic(KeyRef: Integer);
  742. begin
  743.   if Topic <> nil then Dispose(Topic, Done);
  744.   Topic := HFile^.GetTopic(KeyRef);
  745.   Topic^.SetWidth(Size.X);
  746.   ScrollTo(0, 0);
  747.   SetLimit(Limit.X, Topic^.NumLines);
  748.   Selected := 1;
  749.   DrawView;
  750. end;
  751.  
  752. begin
  753.   TScroller.HandleEvent(Event);
  754.   case Event.What of
  755.     evKeyDown:
  756.       begin
  757.         case Event.KeyCode of
  758.           kbTab:
  759.             begin
  760.               Inc(Selected);
  761.               if Selected > Topic^.GetNumCrossRefs then Selected := 1;
  762.               MakeSelectVisible;
  763.             end;
  764.           kbShiftTab:
  765.             begin
  766.               Dec(Selected);
  767.               if Selected = 0 then Selected := Topic^.GetNumCrossRefs;
  768.               MakeSelectVisible;
  769.             end;
  770.           kbEnter:
  771.             begin
  772.               if Selected <= Topic^.GetNumCrossRefs then
  773.               begin
  774.                 Topic^.GetCrossRef(Selected, KeyPoint, KeyLength, KeyRef);
  775.                 SwitchToTopic(KeyRef);
  776.               end;
  777.             end;
  778.           kbEsc:
  779.             begin
  780.               Event.What := evCommand;
  781.               Event.Command := cmClose;
  782.               PutEvent(Event);
  783.             end;
  784.         else
  785.           Exit;
  786.         end;
  787.         DrawView;
  788.         ClearEvent(Event);
  789.       end;
  790.     evMouseDown:
  791.       begin
  792.         MakeLocal(Event.Where, Mouse);
  793.         Inc(Mouse.X, Delta.X); Inc(Mouse.Y, Delta.Y);
  794.         KeyCount := 0;
  795.         repeat
  796.           Inc(KeyCount);
  797.           if KeyCount > Topic^.GetNumCrossRefs then Exit;
  798.           Topic^.GetCrossRef(KeyCount, KeyPoint, KeyLength, KeyRef);
  799.         until (KeyPoint.Y = Mouse.Y+1) and (Mouse.X >= KeyPoint.X) and
  800.           (Mouse.X < KeyPoint.X + KeyLength);
  801.         Selected := KeyCount;
  802.         DrawView;
  803.         if Event.Double then SwitchToTopic(KeyRef);
  804.         ClearEvent(Event);
  805.       end;
  806.     evCommand:
  807.       if (Event.Command = cmClose) and (Owner^.State and sfModal <> 0) then
  808.       begin
  809.         EndModal(cmClose);
  810.         ClearEvent(Event);
  811.       end;
  812.   end;
  813. end;
  814.  
  815. { THelpWindow }
  816.  
  817. constructor THelpWindow.Init(HFile: PHelpFile; Context: Word);
  818. var
  819.   R: TRect;
  820. begin
  821.   R.Assign(0, 0, 50, 18);
  822.   TWindow.Init(R, 'Help', wnNoNumber);
  823.   Options := Options or ofCentered;
  824.   R.Grow(-2,-1);
  825.   Insert(New(PHelpViewer, Init(R,
  826.     StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  827.     StandardScrollBar(sbVertical + sbHandleKeyboard), HFile, Context)));
  828. end;
  829.  
  830. function THelpWindow.GetPalette: PPalette;
  831. const
  832.   P: String[Length(CHelpWindow)] = CHelpWindow;
  833. begin
  834.   GetPalette := @P;
  835. end;
  836.  
  837. procedure RegisterHelpFile;
  838. begin
  839.   RegisterType(RHelpTopic);
  840.   RegisterType(RHelpIndex);
  841. end;
  842.  
  843. procedure NotAssigned(var S: TStream; Value: Integer);
  844. begin
  845. end;
  846.  
  847. end.
  848.