source: trunk/NewView/HelpFile.pas@ 43

Last change on this file since 43 was 43, checked in by RBRi, 19 years ago

% use new debug unit

  • Property svn:eol-style set to native
File size: 25.9 KB
Line 
1Unit HelpFile;
2
3// NewView - a new OS/2 Help Viewer
4// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com)
5// This software is released under the Gnu Public License - see readme.txt
6
7Interface
8
9// Encapsulates the basic reading of a help file's structure.
10
11uses
12 Classes,
13 BseDos,
14 Os2Def,
15 SysUtils,
16 Graphics,
17 IPFFileFormatUnit,
18 HelpTopic,
19 HelpBitmap,
20 ACLUtility,
21 SearchTable;
22
23type
24 THelpFile = class
25 protected
26 _Filename : string;
27 _FileSize : longint;
28 _Handle: HFILE;
29
30 _pSlotData: pUInt16;
31 _SlotDataSize: longint;
32
33 _Title: string;
34
35 _Topics: TList; // of TTopics
36
37 _Dictionary: TList; // pointers to strings.
38
39 _Index: TStringList;
40
41 _SearchTable: TSearchTable;
42
43 _ReferencedFiles: TStringList;
44
45 _FontTable: TList;
46
47 _pHeader: TPHelpFileHeader;
48 _pExtendedHeader: TPExtendedHelpFileHeader;
49 _pContentsData: pointer;
50 _pResourceData: pointer;
51 _pSearchData: pointer;
52 _pHighlightWords: UInt32ArrayPointer;
53 _pSlotOffsets: Uint32ArrayPointer;
54 _pDictionaryData: pointer;
55 _pFontTableData: pointer;
56 _pTopicNameData: pointer;
57 _pTopicGlobalNamesData: pointer;
58
59 procedure InitMembers;
60 procedure Open;
61 procedure Close;
62 procedure ReadFileBlock( Var Dest: pointer;
63 const StartPosition: ULONG;
64 const Length: ULONG );
65
66 procedure ReadHeader;
67 procedure ReadContents;
68 procedure ReadDictionary;
69 procedure ReadSearchTable;
70
71 procedure ReadIndex;
72
73 procedure ReadReferencedFilesTable;
74 procedure ReadFontTableData;
75 procedure ParseFontTable;
76
77 function GetTopic( Index: longint ): TTopic;
78 function GetTopicCount: longint;
79
80 function GetDictionaryCount: longint;
81 function GetDictionaryWord( Index: longint ): string;
82 function GetDictionaryWordPtr( Index: longint ): pstring;
83
84 function GetIndexEntryPtr( Index: longint ): pstring;
85 function GetHighlightWords: UInt32ArrayPointer;
86
87 function GetSearchTable: TSearchTable;
88
89 // Lookup global or local panel name list
90 function FindTopicByName( const Name: string;
91 Var pData: pointer;
92 Count: longint;
93 Offset: longint ): TTopic;
94
95 public
96 constructor Create( const FileName: string );
97
98 destructor Destroy; override;
99
100 function GetIndex: TStringList;
101
102 property Title: string read _Title;
103 property Topics[ Index: longint ]: TTopic read GetTopic;
104 property TopicList: TList read _Topics;
105 property TopicCount: longint read GetTopicCount;
106 property Index: TStringList read GetIndex;
107 property IndexEntryPtr[ index: longint ]: pstring read GetIndexEntryPtr;
108 property Filename: string read _FileName;
109
110 property ReferencedFiles: TStringList read _ReferencedFiles;
111
112 procedure GetImages( ImageOffsets: TList;
113 Images: TImageList );
114
115 function GetImage( ImageOffset: longint ): THelpBitmap;
116
117 property DictionaryCount: longint read GetDictionaryCount;
118 property DictionaryWords[ Index: longint ]: string read GetDictionaryWord;
119 property DictionaryWordPtrs[ Index: longint ]: pstring read GetDictionaryWordPtr;
120
121 function IndexOfTopic( Topic: TTopic ): longint;
122
123 property SearchTable: TSearchTable read GetSearchTable;
124
125 function FindTopicByResourceID( ID: uint16 ): TTopic;
126
127 function FindTopicByLocalName( const Name: string ): TTopic;
128 function FindTopicByGlobalName( const Name: string ): TTopic;
129
130 function FindTopicByTitleStartsWith( const SearchText: string ): TTopic;
131 function FindTopicByTitleContains( const SearchText: string ): TTopic;
132
133 function FindTopicByIndexStartsWith( const SearchText: string ): TTopic;
134 function FindTopicByIndexContains( const SearchText: string ): TTopic;
135
136 procedure FindResourceIDsForTopic( Topic: TTopic;
137 ResourceIDs: TList );
138
139 property HighlightWords: UInt32ArrayPointer read GetHighlightWords;
140
141 property FileSize: longint read _FileSize;
142
143 procedure SetupFontSubstitutes( Substitutions: string );
144 public
145 NotesLoaded: boolean; // used externally
146
147 end;
148
149// Returns helpfile that the given topic is within
150Function TopicFile( Topic: TTopic ): THelpFile;
151
152function GetHelpFileTitle( const Filename: string ): string;
153
154Implementation
155
156uses
157 BseErr,
158 DebugUnit,
159 ACLStringUtility,
160 ACLFileIOUtility,
161 ACLLanguageUnit;
162
163// Load "missing" bitmap
164{$R Images}
165
166var
167 FileErrorNotFound: string;
168 FileErrorAccessDenied: string;
169 FileErrorInUse: string;
170 FileErrorInvalidHeader: string;
171
172Procedure OnLanguageEvent( Language: TLanguageFile;
173 const Apply: boolean );
174begin
175
176 Language.Prefix := 'HelpFile.';
177 Language.LL( Apply, FileErrorNotFound, 'FileErrorNotFound', 'File not found' );
178 Language.LL( Apply, FileErrorAccessDenied, 'FileErrorAccessDenied', 'Access denied' );
179 Language.LL( Apply, FileErrorInUse, 'FileErrorInUse', 'File in use by another program' );
180 Language.LL( Apply,
181 FileErrorInvalidHeader,
182 'FileErrorInvalidHeader',
183 'File doesn''t appear to be an OS/2 Help document (header ID not correct)' );
184 Language.LL( Apply,
185 ErrorCorruptHelpFile,
186 'ErrorCorruptHelpFile',
187 'File is corrupt' );
188end;
189
190Function TopicFile( Topic: TTopic ): THelpFile;
191Begin
192 Result := Topic.HelpFile as THelpFile;
193end;
194
195procedure THelpFile.InitMembers;
196begin
197 _SlotDataSize := 0;
198
199 _pHeader := nil;
200 _pExtendedHeader := nil;
201 _pContentsData := nil;
202 _pSlotOffsets := nil;
203 _pResourceData := nil;
204 _pSearchData := nil;
205 _pDictionaryData := nil;
206// _pIndexData := nil;
207 _pFontTableData := nil;
208
209 _pHighlightWords := nil;
210
211 _Dictionary := TList.Create;
212 _Topics := TList.Create;
213// _Index := TStringList.Create;
214 _ReferencedFiles := TStringList.Create;
215 _FontTable := TList.Create;
216
217 NotesLoaded := false;
218end;
219
220constructor THelpFile.Create( const FileName: string );
221begin
222 LogEvent(LogParse, 'Helpfile Load: ' + FileName);
223
224 _FileName := FileName;
225
226 InitMembers;
227
228 Open;
229
230 // we always need these basics:
231 try
232 ReadHeader;
233 ReadContents;
234 // ReadIndex;
235 ReadDictionary;
236 ReadFontTableData;
237 ParseFontTable;
238 ReadReferencedFilesTable;
239 except
240 Close;
241 raise;
242 end;
243
244 // the rest is loaded on demand
245end;
246
247destructor THelpFile.Destroy;
248begin
249 DeallocateMemory( _pHeader );
250 DeallocateMemory( _pExtendedHeader );
251 DeallocateMemory( _pContentsData );
252 DeallocateMemory( _pSlotOffsets );
253 DeallocateMemory( _pResourceData );
254 DeallocateMemory( _pSearchData );
255 DeallocateMemory( _pDictionaryData );
256// DeallocateMemory( _pIndexData );
257 DeallocateMemory( _pFontTableData );
258
259 DeallocateMemory( _pHighlightWords );
260
261 if Assigned( _Topics ) then
262 DestroyListAndObjects( _Topics );
263
264 if Assigned( _Index ) then
265 _Index.Destroy;
266
267 _Dictionary.Free;
268 _SearchTable.Free;
269 _ReferencedFiles.Free;
270 _FontTable.Free;
271
272 DosClose( _Handle );
273end;
274
275procedure THelpFile.Open;
276var
277 OpenAction: ULong;
278 rc: APIRET;
279 szName: Cstring;
280 FileInfo: FILESTATUS3;
281begin
282 if not FileExists( _Filename ) then
283 raise EHelpFileException.Create( FileErrorNotFound );
284
285 szName := _FileName;
286 rc := DosOpen( szName,
287 _Handle,
288 OpenAction,
289 0, // file size - irrelevant, not creating,
290 0, // attributes - ''
291 OPEN_ACTION_OPEN_IF_EXISTS,
292 OPEN_SHARE_DENYNONE + OPEN_ACCESS_READONLY,
293 nil ); // no extended attributes
294 if rc<> 0 then
295 begin
296 case rc of
297 ERROR_FILE_NOT_FOUND: // crap, this doesn't actually occur!
298 raise EHelpFileException.Create( FileErrorNotFound );
299
300 ERROR_ACCESS_DENIED:
301 raise EHelpFileException.Create( FileErrorAccessDenied );
302
303 ERROR_SHARING_VIOLATION:
304 raise EHelpFileException.Create( FileErrorInUse );
305
306 else
307 raise EHelpFileException.Create( SysErrorMessage( rc ) );
308 end;
309 end;
310
311 DosQueryFileInfo( _Handle,
312 FIL_STANDARD,
313 FileInfo,
314 sizeof( FileInfo ) );
315 _FileSize := FileInfo.cbFile; // file size
316end;
317
318procedure THelpFile.Close;
319begin
320 if _Handle <> 0 then
321 DosClose( _Handle );
322 _Handle := 0;
323end;
324
325procedure THelpFile.ReadFileBlock( Var Dest: pointer;
326 const StartPosition: ULONG;
327 const Length: ULONG );
328begin
329 if not ACLFileIOUtility.ReadFileBlock( _Handle,
330 Dest,
331 StartPosition,
332 Length ) then
333 raise EHelpFileException.Create( ErrorCorruptHelpFile );
334end;
335
336// -------------------------------------------------------------------------
337
338procedure THelpFile.ReadHeader;
339begin
340 LogEvent(LogParse, 'Read header');
341
342 ReadFileBlock( _pHeader,
343 0,
344 sizeof( _pHeader^ ) );
345
346 if _pHeader^.ID <> INF_HEADER_ID then
347 begin
348 // not an OS/2 help file.
349 if _pHeader^.ID = $5f3f then
350 raise EWindowsHelpFormatException.Create( 'Win16' );
351
352 raise EHelpFileException.Create( FileErrorInvalidHeader );
353 end;
354
355 _Title := StrPas( _pHeader^.Title );
356
357 if _pHeader^.extstart > 0 then
358 begin
359 // read extended header
360 ReadFileBlock( _pExtendedHeader,
361 _pHeader^.extstart,
362 sizeof( _pExtendedHeader^ ) );
363 end;
364end;
365
366procedure THelpFile.ReadContents;
367var
368 Topic: TTopic;
369 EntryIndex: longint;
370 pEntry: pTTOCEntryStart;
371 pEnd: pTTOCEntryStart;
372begin
373 LogEvent(LogParse, 'Read contents');
374
375 if _pHeader^.ntoc = 0 then
376 exit; // explicit check required since ntoc is unsigned
377
378 // Presize the topics list to save reallocation time
379 _Topics.Capacity := _pHeader^.ntoc;
380
381 // read slots first so that Topics can refer to it.
382 ReadFileBlock( _pSlotOffsets,
383 _pHeader^.slotsstart,
384 _pHeader^.nslots * sizeof( uint32 ) );
385
386 ReadFileBlock( _pContentsData,
387 _pHeader^.tocstart,
388 _pHeader^.toclen );
389
390 pEntry := _pContentsData;
391 pEnd := _pContentsData + _pHeader^.toclen;
392
393 for EntryIndex := 0 to _pHeader^.ntoc - 1 do
394 begin
395 if pEntry >= pEnd then
396 // runs off end of data!
397 raise EHelpFileException.Create( ErrorCorruptHelpFile );
398
399 Topic := TTopic.Create( _Handle,
400 _pSlotOffsets,
401 _Dictionary,
402 pEntry,
403 _FontTable,
404 _ReferencedFiles );
405
406 Topic.HelpFile := Self;
407 Topic.Index := EntryIndex;
408
409 _Topics.Add( Topic );
410
411 inc( pEntry, pEntry ^. Length );
412 end;
413end;
414
415procedure THelpFile.ReadDictionary;
416var
417 i: longint;
418 Len: uint8;
419 p: pbyte;
420 pEnd: pbyte;
421begin
422 LogEvent(LogParse, 'Read dictionary');
423
424 if _pHeader^.ndict = 0 then
425 exit; // explicit check required since ndict is unsigned
426
427 ReadFileBlock( _pDictionaryData,
428 _pHeader^.dictstart,
429 _pHeader^.dictlen );
430
431 P := _pDictionaryData;
432 pEnd := _pDictionaryData + _pHeader^.dictlen;
433
434 // Presize the dictionary to save reallocation
435 _Dictionary.Capacity := _pHeader^.ndict;
436 for i := 0 to _pHeader^.ndict - 1 do
437 begin
438 // adjust length so we can use as a Pascal string
439 // (file uses length including length byte,
440 // Pascal string have length excluding length byte)
441 if p >= pEnd then
442 // ran off end of data
443 raise EHelpFileException.Create( ErrorCorruptHelpFile );
444
445 Len := p^ - 1;
446 p^ := Len;
447 _Dictionary.Add( P );
448 inc( P, Len + 1 );
449 end;
450end;
451
452function THelpFile.GetIndex: TStringList;
453begin
454 if _Index = nil then
455 ReadIndex;
456 Result := _Index;
457end;
458
459type
460 TIndexEntryHeader = record
461 TextLength: uint8;
462 Flags: uint8;
463 NumberOfRoots: uint8;
464 TOCIndex: uint16;
465 end;
466
467procedure THelpFile.ReadIndex;
468var
469 IndexIndex: longint; // I can't resist :-)
470 pEntryHeader: ^TIndexEntryHeader;
471 EntryText: string;
472 IndexTitleLen: longint;
473 p: pointer;
474 pEnd: pointer;
475 pIndexData: pointer;
476begin
477 LogEvent(LogParse, 'Read index');
478
479 _Index := TStringList.Create;
480
481 if _pHeader^.nindex = 0 then
482 exit; // explicit check required since ndict is unsigned
483
484 pIndexData := nil;
485 ReadFileBlock( pIndexData,
486 _pHeader^.indexstart,
487 _pHeader^.indexlen );
488
489 P := pIndexData;
490 pEnd := pIndexData + _pHeader^.indexlen;
491
492 for IndexIndex := 0 to _pHeader^.nindex - 1 do
493 begin
494 if p >= pEnd then
495 // ran off end of data
496 raise EHelpFileException.Create( ErrorCorruptHelpFile );
497
498 pEntryHeader := p;
499 IndexTitleLen := pEntryHeader^.TextLength;
500 inc( p, sizeof( TIndexEntryHeader ) );
501
502 GetMemString( p, EntryText, IndexTitleLen );
503 if ( pEntryHeader^.flags and 2 ) > 0 then
504 EntryText := '- ' + EntryText;
505 if pEntryHeader^.TOCIndex < _Topics.Count then
506 _Index.AddObject( EntryText, _Topics[ pEntryHeader^.TOCIndex ] )
507 else
508// raise EHelpFileException.Create( 'Error reading help file index - out of range topic reference' );
509 ; // pass! something special
510
511 inc( p, IndexTitleLen
512 + pEntryHeader^.NumberOfRoots
513 * sizeof( uint32 ) ); // skip 'roots' for index search
514 end;
515
516 DeallocateMemory( pIndexData );
517end;
518
519function THelpFile.GetSearchTable: TSearchTable;
520begin
521 if _SearchTable = nil then
522 ReadSearchTable;
523 Result := _SearchTable;
524end;
525
526procedure THelpFile.ReadSearchTable;
527var
528 SearchTableOffset: longint;
529 SearchTableRecordLengthIs16Bit: boolean;
530begin
531 LogEvent(LogParse, 'Read search table');
532
533 if _pHeader^.SearchLen = 0 then
534 begin
535 LogEvent(LogParse, 'Read search table (len = 0');
536 exit;
537 end;
538
539 SearchTableOffset := _pHeader^.SearchStart and $7fffffff;
540 SearchTableRecordLengthIs16Bit := _pHeader^.SearchStart and $80000000 > 0;
541 ReadFileBlock( _pSearchData,
542 SearchTableOffset,
543 _pHeader^.SearchLen );
544
545 _SearchTable := TSearchTable.Create( _pSearchData,
546 SearchTableRecordLengthIs16Bit,
547 _Dictionary.Count,
548 _Topics.Count );
549end;
550
551function THelpFile.GetHighlightWords: UInt32ArrayPointer;
552begin
553 if _pHighlightWords = nil then
554 _pHighlightWords := AllocateMemory( _Dictionary.Count * sizeof( UInt32 ) );
555 Result := _pHighlightWords;
556end;
557
558function THelpFile.FindTopicByResourceID( ID: uint16 ): TTopic;
559var
560 i: longint;
561 pResourceIDs: UInt16ArrayPointer;
562 pTopicIndices: UInt16ArrayPointer;
563 FileResourceID: uint16;
564 TopicIndex: uint16;
565begin
566 Result := nil;
567
568 if _pHeader^.nres = 0 then
569 // since nres is unsigned
570 exit;
571
572 if _pResourceData = nil then
573 ReadFileBlock( _pResourceData,
574 _pHeader^.resstart,
575 _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics
576
577 pResourceIDs := _pResourceData;
578 pTopicIndices := _pResourceData
579 + _pHeader^.nres * sizeof( uint16 );
580
581 for i := 0 to _pHeader^.nres - 1 do
582 begin
583 FileResourceID := pResourceIDs^[ i ];
584 if FileResourceID = ID then
585 begin
586 // found
587 TopicIndex := pTopicIndices^[ i ];
588 Result := _Topics[ TopicIndex ];
589 exit;
590 end;
591 end;
592end;
593
594// Look up a local "panel name" and return associated topic, if any.
595function THelpFile.FindTopicByLocalName( const Name: string ): TTopic;
596begin
597 Result := FindTopicByName( Name,
598 _pTopicNameData,
599 _pHeader^.nname,
600 _pHeader^.namestart );
601end;
602
603function THelpFile.FindTopicByGlobalName( const Name: string ): TTopic;
604begin
605 Result := nil;
606
607 if _pExtendedHeader = nil then
608 // no extended header - no global list to lookup
609 exit;
610
611 Result := FindTopicByName( Name,
612 _pTopicGlobalNamesData,
613 _pExtendedHeader ^. EntryInGNameTable,
614 _pExtendedHeader ^. HelpPanelGNameTblOffset );
615
616end;
617
618// The text of the names are stored in the (global) dictionary
619// with a table referencing them.
620// We could use a binary search here... but whatever...
621function THelpFile.FindTopicByName( const Name: string;
622 Var pData: pointer;
623 Count: longint;
624 Offset: longint ): TTopic;
625var
626 i: longint;
627 pNameTable: UInt16ArrayPointer;
628 pTopicIndices: UInt16ArrayPointer;
629 TopicIndex: uint16;
630
631 TopicNameWordIndex: uint16;
632 pTopicName: pstring;
633begin
634 Result := nil;
635
636 if Count = 0 then
637 // since it's unsigned
638 exit;
639
640 if pData = nil then
641 ReadFileBlock( pData,
642 Offset,
643 Count * sizeof( uint16 ) * 2 ); // list of name words, list of topics
644
645 // get pointers to the two parts of the table
646 pNameTable := pData;
647 pTopicIndices := pData
648 + Count * sizeof( uint16 );
649
650 for i := 0 to Count - 1 do
651 begin
652 TopicNameWordIndex := pNameTable[ i ];
653 pTopicName := DictionaryWordPtrs[ TopicNameWordIndex ];
654
655 if CompareText( pTopicName^, Name ) = 0 then
656 begin
657 // found
658 TopicIndex := pTopicIndices^[ i ];
659 Result := _Topics[ TopicIndex ];
660 exit;
661 end;
662 end;
663end;
664
665function THelpFile.FindTopicByIndexStartsWith( const SearchText: string ): TTopic;
666var
667 i: longint;
668begin
669 result := nil;
670 GetIndex; // make sure it's read
671 for i := 0 to _Index.Count - 1 do
672 begin
673 if StrStarts( SearchText, _Index.ValuePtrs[ i ] ^ ) then
674 begin
675 // found
676 result := TTopic( Index.Objects[ i ] );
677 exit;
678 end;
679 end;
680end;
681
682function THelpFile.FindTopicByIndexContains( const SearchText: string ): TTopic;
683var
684 i: longint;
685begin
686 result := nil;
687 GetIndex; // make sure it's read
688 for i := 0 to _Index.Count - 1 do
689 begin
690 if CaseInsensitivePos( SearchText, _Index.ValuePtrs[ i ] ^ ) > 0 then
691 begin
692 // found
693 result := TTopic( Index.Objects[ i ] );
694 exit;
695 end;
696 end;
697end;
698
699function THelpFile.FindTopicByTitleStartsWith( const SearchText: string ): TTopic;
700var
701 i: longint;
702 Topic: TTopic;
703begin
704 result := nil;
705 for i := 0 to _Topics.Count - 1 do
706 begin
707 Topic := _Topics[ i ];
708 if StrStarts( SearchText, Topic.TitlePtr ^ ) then
709 begin
710 result := Topic;
711 exit;
712 end;
713 end;
714end;
715
716function THelpFile.FindTopicByTitleContains( const SearchText: string ): TTopic;
717var
718 i: longint;
719 Topic: TTopic;
720begin
721 result := nil;
722 for i := 0 to _Topics.Count - 1 do
723 begin
724 Topic := _Topics[ i ];
725 if CaseInsensitivePos( SearchText, Topic.TitlePtr ^ ) > 0 then
726 begin
727 result := Topic;
728 exit;
729 end;
730 end;
731end;
732
733procedure THelpFile.FindResourceIDsForTopic( Topic: TTopic;
734 ResourceIDs: TList );
735var
736 i: longint;
737 pResourceIDs: UInt16ArrayPointer;
738 pTopicIndices: UInt16ArrayPointer;
739begin
740 ResourceIDs.Clear;
741
742 if _pHeader^.nres = 0 then
743 // since nres is unsigned
744 exit;
745
746 if _pResourceData = nil then
747 ReadFileBlock( _pResourceData,
748 _pHeader^.resstart,
749 _pHeader^.nres * sizeof( uint16 ) * 2 ); // list of IDs, list of topics
750
751 pResourceIDs := _pResourceData;
752 pTopicIndices := _pResourceData
753 + _pHeader^.nres * sizeof( uint16 );
754
755 for i := 0 to _pHeader^.nres - 1 do
756 begin
757 if pTopicIndices^[ i ] = Topic.Index then
758 begin
759 // found
760 ResourceIDs.Add( pointer( pResourceIDs^[ i ] ) );
761 end;
762 end;
763end;
764
765procedure THelpFile.ReadReferencedFilesTable;
766var
767 i: longint;
768 p: pointer;
769 pData: pointer;
770 DatabaseName: string;
771 pLength: pByte;
772begin
773 if _pExtendedHeader = nil then
774 // no extended header -> no referenced files table
775 exit;
776
777 if _pExtendedHeader ^.Numdatabase = 0 then
778 exit;
779
780 pData := nil; // please allocate...
781 ReadFileBlock( pData,
782 _pExtendedHeader^.DatabaseOffset,
783 _pExtendedHeader^.DatabaseSize );
784
785 p := pData;
786 for i := 0 to _pExtendedHeader^.Numdatabase - 1 do
787 begin
788 pLength := p; // length byte, including itself
789 GetMemString( p + 1, DatabaseName, ( pLength ^ ) - 1 );
790 _ReferencedFiles.Add( DatabaseName );
791 inc( p, pLength ^ ); // skip to next entry
792 end;
793 DeallocateMemory( pData );
794end;
795
796procedure THelpFile.ReadFontTableData;
797begin
798 if _pExtendedHeader = nil then
799 // no extended header -> no font table
800 exit;
801
802 if _pExtendedHeader^.NumFontEntry = 0 then
803 exit;
804
805 ReadFileBlock( _pFontTableData,
806 _pExtendedHeader^.FontTableOffset,
807 _pExtendedHeader^.NumFontEntry * sizeof( THelpFontSpec ) );
808end;
809
810procedure THelpFile.ParseFontTable;
811var
812 i: longint;
813 p: pointer;
814 pFontSpec: pTHelpFontSpec;
815begin
816 _FontTable.Clear;
817
818 p := _pFontTableData;
819 if p = nil then
820 exit; // no data
821
822 for i := 0 to _pExtendedHeader^.NumFontEntry - 1 do
823 begin
824 pFontSpec := p + i * sizeof( THelpFontSpec );
825 _FontTable.Add( pFontSpec );
826 end;
827end;
828
829procedure THelpFile.GetImages( ImageOffsets: TList;
830 Images: TImageList );
831var
832 ListIndex: longint;
833 ImageOffset: longint;
834 Bitmap: THelpBitmap;
835begin
836 Images.Clear;
837
838 for ListIndex := 0 to ImageOffsets.Count - 1 do
839 begin
840 ImageOffset := longint( ImageOffsets[ ListIndex ] );
841 try
842 Bitmap := THelpBitmap.CreateFromHelpFile( _Handle,
843 _pHeader^.imgstart
844 + ImageOffset );
845 except
846 on e: EHelpBitmapException do
847{ raise EHelpFileException.Create( 'Error loading help bitmap at'
848 + IntToStr( ImageOffset )
849 + ': '
850 + e.Message );}
851 begin
852 Bitmap := THelpBitmap.Create;
853 Bitmap.LoadFromResourceName( 'MissingBitmap' );
854 end;
855 end;
856
857 Images.Add( Bitmap, nil );
858 Bitmap.Destroy;
859
860 end;
861end;
862
863function THelpFile.GetImage( ImageOffset: longint ): THelpBitmap;
864begin
865 try
866 Result := THelpBitmap.CreateFromHelpFile( _Handle,
867 _pHeader^.imgstart
868 + ImageOffset );
869 except
870 on e: EHelpBitmapException do
871{ raise EHelpFileException.Create( 'Error loading help bitmap at'
872 + IntToStr( ImageOffset )
873 + ': '
874 + e.Message );}
875 begin
876 result := nil;
877 end;
878 end;
879end;
880
881function THelpFile.GetTopic( Index: longint ): TTopic;
882begin
883 if ( Index < 0 )
884 or ( Index > _Topics.Count - 1 ) then
885 Result := nil
886 else
887 Result := _Topics[ Index ];
888end;
889
890function THelpFile.GetTopicCount: longint;
891begin
892 Result := _Topics.Count;
893end;
894
895function THelpFile.IndexOfTopic( Topic: TTopic ): longint;
896begin
897 Result := _Topics.IndexOf( Topic );
898end;
899
900function THelpFile.GetDictionaryCount: longint;
901begin
902 Result := _Dictionary.Count;
903end;
904
905function THelpFile.GetDictionaryWord( Index: longint ): string;
906begin
907 Result := pstring( _Dictionary[ Index ] )^;
908end;
909
910function THelpFile.GetDictionaryWordPtr( Index: longint ): pstring;
911begin
912 Result := pstring( _Dictionary[ Index ] );
913end;
914
915function THelpFile.GetIndexEntryPtr( Index: longint ): pstring;
916begin
917 if _Index = nil then
918 ReadIndex;
919 Result := _Index.ValuePtrs[ Index ];
920end;
921
922
923// Looks for fonts that should be substitued to the
924// users selected fixed font
925// doesn't make a lot of sense for this to be here...
926procedure THelpFile.SetupFontSubstitutes( Substitutions: string );
927var
928 Item: string;
929 FontName: string;
930 SpacePos: longint;
931 W: longint;
932 H: longint;
933 i: longint;
934 pFontSpec: pTHelpFontSpec;
935begin
936 ParseFontTable; // (re)load table from raw data
937
938 while Substitutions <> '' do
939 begin
940 Item := ExtractNextValue( Substitutions, ';' );
941 try
942 if Item <> '' then
943 begin
944 // Look for space in xxxx WxH
945
946 SpacePos := FindCharFromEnd( Item, ' ' );
947 if SpacePos > 0 then
948 begin
949 // fontname comes before
950 FontName := StrLeft( Item, SpacePos - 1 );
951 Delete( Item, 1, SpacePos );
952 // width and height after, with an X between
953 W := StrToInt( ExtractNextValue( Item, 'x' ) );
954 H := StrToInt( Item );
955 if ( W > 0 ) and ( H > 0 ) then
956 begin
957 // Now look through the font table for matches
958 for i := 0 to _FontTable.Count - 1 do
959 begin
960 pFontSpec := _FontTable[ i ];
961 if StrNPas( pFontSpec ^. FaceName,
962 sizeof( pFontSpec ^. FaceName ) ) = FontName then
963 begin
964 // same face name...
965 if ( W = pFontSpec ^. Height ) and ( H = pFontSpec ^. Width ) then
966 begin
967 // match
968 _FontTable[ i ] := SubstituteFixedFont;
969 end;
970 end;
971 end;
972 end;
973 end;
974 end;
975 except
976 end;
977 end;
978end;
979
980
981// -------------------------------------------------------------
982// Get the title only from specific help file (if possible)
983
984function GetHelpFileTitle( const Filename: string ): string;
985var
986 OpenAction: ULong;
987 rc: APIRET;
988 szName: Cstring;
989
990 Header: THelpFileHeader;
991 Handle: HFILE;
992 Ext: string;
993begin
994 Ext := ExtractFileExt( Filename );
995 Result := '';
996
997 if StringsSame( Ext, '.inf' )
998 or StringsSame( Ext, '.hlp' ) then
999 begin
1000 szName := Filename;
1001 rc := DosOpen( szName,
1002 Handle,
1003 OpenAction,
1004 0, // file size - irrelevant, not creating,
1005 0, // attributes - ''
1006 OPEN_ACTION_OPEN_IF_EXISTS,
1007 OPEN_SHARE_DENYNONE + OPEN_ACCESS_READONLY,
1008 nil ); // no extended attributes
1009 if rc = 0 then
1010 begin
1011 FillChar( Header, sizeof( Header ), 0 );
1012 if MyRead( Handle, Addr( Header ), sizeof( Header ) ) then
1013 if Header.ID = INF_HEADER_ID then
1014 Result := StrPas( Header.Title );
1015 DosClose( Handle );
1016 end;
1017 end;
1018end;
1019
1020Initialization
1021 RegisterProcForLanguages( OnLanguageEvent );
1022End.
1023
Note: See TracBrowser for help on using the repository browser.