source: trunk/NewView/HelpFile.pas@ 18

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

+ newview source

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