diff options
author | Graeme Geldenhuys <graemeg@gmail.com> | 2013-04-09 22:42:33 +0100 |
---|---|---|
committer | Graeme Geldenhuys <graemeg@gmail.com> | 2013-04-09 22:42:33 +0100 |
commit | c0bfb2f6397717b176b1afd99db5a36b4bb8ea84 (patch) | |
tree | 0ccf21ba216a66e80a02d0e8ba40bb32bb47056a /docview/src | |
parent | 2489181ef55feeefe10eeef7598b8123b19d5667 (diff) | |
parent | 440df54d189bf1748f18b36ce48af45a85d23023 (diff) | |
download | fpGUI-c0bfb2f6397717b176b1afd99db5a36b4bb8ea84.tar.xz |
Merge latest fixes from 'release-1.0' branch into develop
Diffstat (limited to 'docview/src')
-rw-r--r-- | docview/src/HelpBitmap.pas | 340 | ||||
-rw-r--r-- | docview/src/HelpFile.pas | 25 | ||||
-rw-r--r-- | docview/src/HelpTopic.pas | 2 | ||||
-rw-r--r-- | docview/src/NewViewConstantsUnit.pas | 37 | ||||
-rw-r--r-- | docview/src/docview.lpi | 62 | ||||
-rw-r--r-- | docview/src/docview.lpr | 9 | ||||
-rw-r--r-- | docview/src/dvHelpers.pas | 3 | ||||
-rw-r--r-- | docview/src/dvconstants.pas | 13 | ||||
-rw-r--r-- | docview/src/frm_bookmarks.pas | 312 | ||||
-rw-r--r-- | docview/src/frm_main.pas | 180 | ||||
-rw-r--r-- | docview/src/frm_note.pas | 17 | ||||
-rw-r--r-- | docview/src/lzwdecompress.pas | 263 |
12 files changed, 859 insertions, 404 deletions
diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas index 0931ce82..692bf64d 100644 --- a/docview/src/HelpBitmap.pas +++ b/docview/src/HelpBitmap.pas @@ -1,14 +1,32 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Encapsulates a bitmap as stored in a IPF file. Once created from + file data they can be used as a normal bitmap. +} + unit HelpBitmap; {$mode objfpc}{$H+} -interface +// Debug purposes only +{.$define LZW_DEBUG} -// Encapsulates a bitmap as stored in a IPF file. -// Once created from file data they can be used as a normal bitmap. +interface uses - Classes, SysUtils, fpg_main, ctypes, + Classes, SysUtils, fpg_main, IPFFileFormatUnit; type @@ -65,7 +83,6 @@ type _UncompressedBlockSize: longint; function GetPaletteSize: longint; procedure BitmapError(Msg: string); - procedure DecompressLZW(var Buffer: Pointer; const Count: integer; var NewBuffer: PByte; var NewCount: integer); procedure ReadBitmapData( Blocks: TList; TotalSize: longint ); public constructor CreateFromHelpFile(var AFileHandle: TFileStream; Offset: longint); @@ -73,19 +90,13 @@ type end; -var - LZWDecompressBlock: function( pInput: PBYTE; - pOutput: PBYTE; - bytesIn: uint32; - Var bytesOut: uint32; - Var FinalCode: byte ): Boolean; -// APIENTRY; -// 'newview' index 1; - implementation uses - nvUtilities, Math, fpg_imgfmt_bmp; + nvUtilities, + Math, + LZWDecompress, + fpg_imgfmt_bmp; const BFT_bMAP =$4d62; // 'bM' @@ -102,9 +113,15 @@ type _Size: uint16; _CompressionType: uint8; _Data: PBYTE; + constructor Create; destructor Destroy; override; end; +constructor TBitmapBlock.Create; +begin + _Data := nil; +end; + destructor TBitmapBlock.Destroy; begin FreeMem( _Data ); @@ -119,7 +136,6 @@ var BytesRead: longint; Block: TBitmapBlock; - p: pointer; Blocks: TList; BlockIndex: longint; ImageType: uint16; @@ -154,7 +170,8 @@ begin if _Header.usType <> BFT_bMAP then raise EHelpBitmapException.Create( 'Invalid bitmap header' ); - _Header.usType := $4d42; // sibyl only accepts 'BM' not 'bM' +// Graeme: we don't need to do this any more. It was only for Sybil +// _Header.usType := $4d42; // sibyl only accepts 'BM' not 'bM' // We can only parse bitmaps with 1 colour plane // (I can't be bothered and have never seen bitmaps @@ -174,19 +191,19 @@ begin _BitsSize := LineSize * _Header.cy; // Correct header offset - it is wrong in the header (why?) - _Header.OffBits := sizeof( _Header ) + GetPaletteSize; // TODO: Graeme, double check this! + _Header.OffBits := sizeof( _Header ) + GetPaletteSize; // Load palette if _Header.cBitCount <= 8 then begin _pPalette := GetMem( GetPaletteSize ); - bytes := FileHandle.Read(_pPalette, GetPaletteSize); + bytes := FileHandle.Read(_pPalette^, GetPaletteSize); if bytes <> GetPaletteSize then raise EHelpBitmapException.Create( 'Failed to read Palette.' ); end; // Read data header - FillChar( DataHeader, sizeof( DataHeader ), 0 ); +// FillChar( DataHeader, sizeof( DataHeader ), 0 ); bytes := FileHandle.Read(DataHeader, SizeOf(DataHeader)); if bytes <> SizeOf(DataHeader) then raise EHelpBitmapException.Create( 'Failed to read DataHeader.' ); @@ -214,7 +231,7 @@ begin // Now read the block Block._Data := GetMem( Block._Size ); - FileHandle.Read(Block._Data, Block._Size); + FileHandle.Read(Block._Data^, Block._Size); inc( BytesRead, Block._Size ); Blocks.Add( Block ); @@ -250,227 +267,7 @@ begin inherited Destroy; end; -procedure THelpBitmap.DecompressLZW(var Buffer: Pointer; const Count: Integer; var NewBuffer: PByte; var NewCount: integer); -type - TLZWString = packed record - Count: integer; - Data: PByte; - end; - PLZWString = ^TLZWString; -const - ClearCode = 256; // clear table, start with 9bit codes - EoiCode = 257; // end of input -var -// NewBuffer: PByte; -// NewCount: PtrInt; - NewCapacity: PtrInt; - SrcPos: PtrInt; - SrcPosBit: integer; - CurBitLength: integer; - Code: Word; - Table: PLZWString; - TableCapacity: integer; - TableCount: integer; - OldCode: Word; - - function GetNextCode: Word; - var - v: Integer; - begin - Result:=0; - // CurBitLength can be 9 to 12 - //writeln('GetNextCode CurBitLength=',CurBitLength,' SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' ',hexstr(PByte(Buffer)[SrcPos],2),' ',hexstr(PByte(Buffer)[SrcPos+1],2),' ',hexstr(PByte(Buffer)[SrcPos+2],2)); - // read two or three bytes - if CurBitLength+SrcPosBit>16 then begin - // read from three bytes - if SrcPos+3>Count then BitmapError('LZW stream overrun'); - v:=PByte(Buffer)[SrcPos]; - inc(SrcPos); - v:=(v shl 8)+PByte(Buffer)[SrcPos]; - inc(SrcPos); - v:=(v shl 8)+PByte(Buffer)[SrcPos]; - v:=v shr (24-CurBitLength-SrcPosBit); - end else begin - // read from two bytes - if SrcPos+2>Count then BitmapError('LZW stream overrun'); - v:=PByte(Buffer)[SrcPos]; - inc(SrcPos); - v:=(v shl 8)+PByte(Buffer)[SrcPos]; - if CurBitLength+SrcPosBit=16 then - inc(SrcPos); - v:=v shr (16-CurBitLength-SrcPosBit); - end; - Result:=v and ((1 shl CurBitLength)-1); - SrcPosBit:=(SrcPosBit+CurBitLength) and 7; - //writeln('GetNextCode END SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' Result=',Result,' Result=',hexstr(Result,4)); - end; - - procedure ClearTable; - var - i: Integer; - begin - for i:=0 to TableCount-1 do - ReAllocMem(Table[i].Data,0); - TableCount:=0; - end; - - procedure InitializeTable; - begin - CurBitLength:=9; - ClearTable; - end; - - function IsInTable(Code: word): boolean; - begin - Result:=Code<258+TableCount; - end; - - procedure WriteStringFromCode(Code: integer; AddFirstChar: boolean = false); - var - s: TLZWString; - b: byte; - begin - //WriteLn('WriteStringFromCode Code=',Code,' AddFirstChar=',AddFirstChar,' x=',(NewCount div 4) mod IDF.ImageWidth,' y=',(NewCount div 4) div IDF.ImageWidth,' PixelByte=',NewCount mod 4); - if Code<256 then begin - // write byte - b:=Code; - s.Data:=@b; - s.Count:=1; - end else if Code>=258 then begin - // write string - if Code-258>=TableCount then - BitmapError('LZW code out of bounds'); - s:=Table[Code-258]; - end else - BitmapError('LZW code out of bounds'); - if NewCount+s.Count+1>NewCapacity then begin - NewCapacity:=NewCapacity*2+8; - ReAllocMem(NewBuffer,NewCapacity); - end; - System.Move(s.Data^,NewBuffer[NewCount],s.Count); - //for i:=0 to s.Count-1 do write(HexStr(NewBuffer[NewCount+i],2)); // debug - inc(NewCount,s.Count); - if AddFirstChar then begin - NewBuffer[NewCount]:=s.Data^; - //write(HexStr(NewBuffer[NewCount],2)); // debug - inc(NewCount); - end; - //writeln(',WriteStringFromCode'); // debug - end; - - procedure AddStringToTable(Code, AddFirstCharFromCode: integer); - // add string from code plus first character of string from code as new string - var - b1, b2: byte; - s1, s2: TLZWString; - p: PByte; - begin - //WriteLn('AddStringToTable Code=',Code,' FCFCode=',AddFirstCharFromCode,' TableCount=',TableCount,' TableCapacity=',TableCapacity); - // grow table - if TableCount>=TableCapacity then begin - TableCapacity:=TableCapacity*2+128; - ReAllocMem(Table,TableCapacity*SizeOf(TLZWString)); - end; - // find string 1 - if Code<256 then begin - // string is byte - b1:=Code; - s1.Data:=@b1; - s1.Count:=1; - end else if Code>=258 then begin - // normal string - if Code-258>=TableCount then - BitmapError('LZW code out of bounds'); - s1:=Table[Code-258]; - end else - BitmapError('LZW code out of bounds'); - // find string 2 - if AddFirstCharFromCode<256 then begin - // string is byte - b2:=AddFirstCharFromCode; - s2.Data:=@b2; - s2.Count:=1; - end else begin - // normal string - if AddFirstCharFromCode-258>=TableCount then - BitmapError('LZW code out of bounds'); - s2:=Table[AddFirstCharFromCode-258]; - end; - // set new table entry - Table[TableCount].Count:=s1.Count+1; - p:=nil; - GetMem(p,s1.Count+1); - Table[TableCount].Data:=p; - System.Move(s1.Data^,p^,s1.Count); - // add first character from string 2 - p[s1.Count]:=s2.Data^; - // increase TableCount - inc(TableCount); - case TableCount+259 of - 512,1024,2048: inc(CurBitLength); - 4096: BitmapError('LZW too many codes'); - end; - end; - -begin - if Count=0 then exit; - //WriteLn('TFPReaderTiff.DecompressLZW START Count=',Count); - //for SrcPos:=0 to 19 do - // write(HexStr(PByte(Buffer)[SrcPos],2)); - //writeln(); - - NewBuffer:=nil; - NewCount:=0; - NewCapacity:=Count*2; - ReAllocMem(NewBuffer,NewCapacity); - - SrcPos:=0; - SrcPosBit:=0; - CurBitLength:=9; - Table:=nil; - TableCount:=0; - TableCapacity:=0; - try - repeat - Code:=GetNextCode; - //WriteLn('TFPReaderTiff.DecompressLZW Code=',Code); - if Code=EoiCode then break; - if Code=ClearCode then begin - InitializeTable; - Code:=GetNextCode; - //WriteLn('TFPReaderTiff.DecompressLZW after clear Code=',Code); - if Code=EoiCode then break; - if Code=ClearCode then - BitmapError('LZW code out of bounds'); - WriteStringFromCode(Code); - OldCode:=Code; - end else begin - if Code<TableCount+258 then begin - WriteStringFromCode(Code); - AddStringToTable(OldCode,Code); - OldCode:=Code; - end else if Code=TableCount+258 then begin - WriteStringFromCode(OldCode,true); - AddStringToTable(OldCode,OldCode); - OldCode:=Code; - end else - BitmapError('LZW code out of bounds'); - end; - until false; - finally - ClearTable; - ReAllocMem(Table,0); - end; - - ReAllocMem(NewBuffer,NewCount); -// FreeMem(Buffer); -// Buffer:=NewBuffer; -// Count:=NewCount; -end; - - -procedure THelpBitmap.ReadBitmapData( Blocks: TList; - TotalSize: longint ); +procedure THelpBitmap.ReadBitmapData( Blocks: TList; TotalSize: longint ); var BytesWritten: longint; BytesWrittenFromBlock: longword; @@ -483,16 +280,22 @@ var BlockIndex: longint; BitmapData: PBYTE; ptr: PByte; + i: integer; + img: TfpgImage; begin + BitmapOutputPointer := nil; + BitmapData := nil; + ptr := nil; + // Allocate memory to store the bitmap - Bitmapdata := GetMem( TotalSize ); + BitmapData := GetMem( TotalSize ); // Copy header to bitmap - MemCopy( _Header, BitmapData, sizeof( _Header ) ); + MemCopy( _Header, BitmapData^, sizeof( _Header ) ); // Copy palette into bitmap ptr := BitmapData + sizeof( _Header ); - MemCopy( _pPalette, ptr, GetPaletteSize ); + MemCopy( _pPalette^, ptr^, GetPaletteSize ); BytesWritten := 0; @@ -506,23 +309,18 @@ begin case Block._CompressionType of 0,1: // uncompressed (I'm not sure about 1) begin - MemCopy( Block._Data, BitmapOutputPointer, Block._Size ); + MemCopy( Block._Data^, BitmapOutputPointer^, Block._Size ); BytesWrittenFromBlock := Block._Size; inc( BytesWritten, BytesWrittenFromBlock ); end; 2: // LZW compression begin - // decompress block - if not Assigned( LZWDecompressBlock )then - raise EHelpBitmapException.Create( 'Cannot decode bitmap - DLL not found' ); - -// DecompressLZW(Block._Data, Block._Size); - //LZWDecompressBlock( Block._Data, - // BitmapOutputPointer, - // Block._Size, - // BytesWrittenFromBlock, - // lastOutByte ); + LZWDecompressBlock( Block._Data, + Block._Size, + BitmapOutputPointer, + BytesWrittenFromBlock, + lastOutByte ); inc( BytesWritten, BytesWrittenFromBlock ); @@ -555,15 +353,37 @@ begin > BitmapData + TotalSize ) then assert( false ); - inc( BitmapOutputPointer, BytesWrittenFromBlock ); +{ NOTE: This doesn't seem right. It moves the pointer so later the moving of data to + ImageData will be wrong! } +// inc( BitmapOutputPointer, BytesWrittenFromBlock ); TPersistentObjectState end; + i := TotalSize + SizeOf(_Header) + GetPaletteSize; + img := CreateImage_BMP(BitmapData, i); AllocateImage(32, _Header.cx, _Header.cy); - if TotalSize <> ImageDataSize then - writeln('Warning: INF Bitmap size and allocated bitmap size are different. ', TotalSize, ' vs ', ImageDataSize); - Move(BitmapData^, ImageData^, TotalSize); + + {$IFDEF LZW_DEBUG} + writeln('Width = ', Width); + writeln('Height = ', Height); + writeln('ImageDataSize = ', ImageDataSize); + writeln('------------- START -------------'); + for i := 1 to ImageDataSize do + begin + write(HexStr(BitmapOutputPointer[i-1],2)+' '); + if (i mod 16 = 0) then + writeln('') + else if (i mod 4 = 0) then + write (' | '); + end; + Writeln(''); + writeln('------------- END -------------'); + {$ENDIF} + +// Move(BitmapOutputPointer^, ImageData^, ImageDataSize); + Move(img.ImageData^, self.ImageData^, img.ImageDataSize); UpdateImage; + img.Free; FreeMem( BitmapData, TotalSize ); end; diff --git a/docview/src/HelpFile.pas b/docview/src/HelpFile.pas index cc4657d9..ce3d9f8a 100644 --- a/docview/src/HelpFile.pas +++ b/docview/src/HelpFile.pas @@ -321,29 +321,6 @@ const entries.AddObject(anIndexEntry.getLabel, anIndexEntry); end; - - - -//Procedure OnLanguageEvent( Language: TLanguageFile; -// const Apply: boolean ); -//var -// tmpPrefix : String; -//begin -// tmpPrefix := 'HelpFile' + LANGUAGE_LABEL_DELIMITER; -// -// Language.LL( Apply, FileErrorNotFound, tmpPrefix + 'FileErrorNotFound', 'File not found' ); -// Language.LL( Apply, FileErrorAccessDenied, tmpPrefix + 'FileErrorAccessDenied', 'Access denied' ); -// Language.LL( Apply, FileErrorInUse, tmpPrefix + 'FileErrorInUse', 'File in use by another program' ); -// Language.LL( Apply, -// FileErrorInvalidHeader, -// tmpPrefix + 'FileErrorInvalidHeader', -// 'File doesn''t appear to be an OS/2 Help document (header ID not correct)' ); -// Language.LL( Apply, -// ErrorCorruptHelpFile, -// tmpPrefix + 'ErrorCorruptHelpFile', -// 'File is corrupt' ); -//end; - Function TopicFile( Topic: TTopic ): THelpFile; Begin Result := Topic.HelpFile as THelpFile; @@ -1119,9 +1096,7 @@ begin + ': ' + e.Message );} begin -// Bitmap := THelpBitmap.Create; Bitmap := THelpBitmap(fpgImages.GetImage('stdimg.dlg.critical')); -// Bitmap.LoadFromResourceName( 'MissingBitmap' ); // TODO: Add image resource to DocView end; end; diff --git a/docview/src/HelpTopic.pas b/docview/src/HelpTopic.pas index 5a8245a7..a9b981f1 100644 --- a/docview/src/HelpTopic.pas +++ b/docview/src/HelpTopic.pas @@ -231,7 +231,7 @@ implementation uses SysUtils - ,NewViewConstantsUnit + ,dvConstants ,nvUtilities ,ACLStringUtility ,SettingsUnit diff --git a/docview/src/NewViewConstantsUnit.pas b/docview/src/NewViewConstantsUnit.pas deleted file mode 100644 index 2aed1cd0..00000000 --- a/docview/src/NewViewConstantsUnit.pas +++ /dev/null @@ -1,37 +0,0 @@ -{ - fpGUI - Free Pascal GUI Toolkit - - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this - distribution, for details of the copyright. - - See the file COPYING.modifiedLGPL, included in this distribution, - for details about redistributing fpGUI. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - - Description: - Common used constants for DocView -} -unit NewViewConstantsUnit; - -{$mode objfpc}{$H+} - -interface - -const - PARAM_LINK_NOTE = 'note'; - PARAM_LINK_PROGRAM = 'program'; - PARAM_LINK_URL = 'url'; - PARAM_LINK_EXTERNAL = 'external'; - - PRGM_EXPLORER = 'explore'; // web explorer - PRGM_NETSCAPE = 'netscape'; - PRGM_MOZILLA = 'mozilla'; - PRGM_FIREFOX = 'firefox'; - - -implementation - -end. diff --git a/docview/src/docview.lpi b/docview/src/docview.lpi index 30c8e7ff..6fc2c4cb 100644 --- a/docview/src/docview.lpi +++ b/docview/src/docview.lpi @@ -23,6 +23,7 @@ <RunParams> <local> <FormatVersion Value="1"/> + <CommandLineParams Value="/data/devel/tests/inf_test/test2.inf"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> </local> </RunParams> @@ -31,7 +32,7 @@ <PackageName Value="fpgui_toolkit"/> </Item1> </RequiredPackages> - <Units Count="36"> + <Units Count="37"> <Unit0> <Filename Value="docview.lpr"/> <IsPartOfProject Value="True"/> @@ -132,80 +133,85 @@ <UnitName Value="HelpWindowDimensions"/> </Unit19> <Unit20> - <Filename Value="NewViewConstantsUnit.pas"/> + <Filename Value="SettingsUnit.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="NewViewConstantsUnit"/> + <UnitName Value="SettingsUnit"/> </Unit20> <Unit21> - <Filename Value="SettingsUnit.pas"/> + <Filename Value="dvconstants.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="SettingsUnit"/> + <UnitName Value="dvConstants"/> </Unit21> <Unit22> - <Filename Value="dvconstants.pas"/> + <Filename Value="dvHelpers.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="dvConstants"/> + <UnitName Value="dvHelpers"/> </Unit22> <Unit23> - <Filename Value="dvHelpers.pas"/> + <Filename Value="HelpWindow.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="dvHelpers"/> + <UnitName Value="HelpWindow"/> </Unit23> <Unit24> - <Filename Value="HelpWindow.pas"/> + <Filename Value="../TODO.txt"/> <IsPartOfProject Value="True"/> - <UnitName Value="HelpWindow"/> </Unit24> <Unit25> - <Filename Value="../TODO.txt"/> + <Filename Value="frm_configuration.pas"/> <IsPartOfProject Value="True"/> + <UnitName Value="frm_configuration"/> </Unit25> <Unit26> - <Filename Value="frm_configuration.pas"/> + <Filename Value="arrows.inc"/> <IsPartOfProject Value="True"/> - <UnitName Value="frm_configuration"/> </Unit26> <Unit27> - <Filename Value="arrows.inc"/> + <Filename Value="HelpBitmap.pas"/> <IsPartOfProject Value="True"/> + <UnitName Value="HelpBitmap"/> </Unit27> <Unit28> - <Filename Value="HelpBitmap.pas"/> + <Filename Value="missing.inc"/> <IsPartOfProject Value="True"/> - <UnitName Value="HelpBitmap"/> </Unit28> <Unit29> - <Filename Value="missing.inc"/> + <Filename Value="frm_text.pas"/> <IsPartOfProject Value="True"/> + <UnitName Value="frm_text"/> </Unit29> <Unit30> - <Filename Value="frm_text.pas"/> + <Filename Value="docview.rc"/> <IsPartOfProject Value="True"/> - <UnitName Value="frm_text"/> </Unit30> <Unit31> - <Filename Value="docview.rc"/> + <Filename Value="../docs/docview.ipf"/> <IsPartOfProject Value="True"/> </Unit31> <Unit32> - <Filename Value="../docs/docview.ipf"/> + <Filename Value="frm_note.pas"/> <IsPartOfProject Value="True"/> + <UnitName Value="frm_note"/> </Unit32> <Unit33> - <Filename Value="frm_note.pas"/> + <Filename Value="HelpNote.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="frm_note"/> + <UnitName Value="HelpNote"/> </Unit33> <Unit34> - <Filename Value="HelpNote.pas"/> + <Filename Value="HelpBookmark.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="HelpNote"/> + <UnitName Value="HelpBookmark"/> </Unit34> <Unit35> - <Filename Value="HelpBookmark.pas"/> + <Filename Value="frm_bookmarks.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="HelpBookmark"/> + <UnitName Value="frm_bookmarks"/> </Unit35> + <Unit36> + <Filename Value="lzwdecompress.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="LZWDecompress"/> + </Unit36> </Units> </ProjectOptions> <CompilerOptions> diff --git a/docview/src/docview.lpr b/docview/src/docview.lpr index e49aa4c3..0bee1dbe 100644 --- a/docview/src/docview.lpr +++ b/docview/src/docview.lpr @@ -7,12 +7,13 @@ uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} - Classes, fpg_main, frm_main, IPFEscapeCodes, HelpTopic, CompareWordUnit, SearchTable, - TextSearchQuery, nvUtilities, HelpFile, SearchUnit, fpg_cmdlineparams, - IPFFileFormatUnit, HelpWindowDimensions, NewViewConstantsUnit, SettingsUnit, + Classes, fpg_main, frm_main, IPFEscapeCodes, HelpTopic, CompareWordUnit, + SearchTable, TextSearchQuery, nvUtilities, HelpFile, SearchUnit, + fpg_cmdlineparams, IPFFileFormatUnit, HelpWindowDimensions, SettingsUnit, RichTextStyleUnit, CanvasFontManager, ACLStringUtility, RichTextDocumentUnit, RichTextView, RichTextLayoutUnit, RichTextDisplayUnit, dvconstants, dvHelpers, - frm_configuration, HelpBitmap, frm_text, frm_note, HelpNote, HelpBookmark; + frm_configuration, HelpBitmap, frm_text, frm_note, HelpNote, HelpBookmark, + frm_bookmarks, LZWDecompress; {$IFDEF WINDOWS} {$R docview.rc} diff --git a/docview/src/dvHelpers.pas b/docview/src/dvHelpers.pas index 28dc7809..2aaf710a 100644 --- a/docview/src/dvHelpers.pas +++ b/docview/src/dvHelpers.pas @@ -7,9 +7,6 @@ interface uses Classes, SysUtils, fpg_base; -const - OWN_HELP_MARKER = '[DOCVIEWHELP]'; - function GetOwnHelpFileName: String; // Given a filename, which may or may not contain a path or extension, diff --git a/docview/src/dvconstants.pas b/docview/src/dvconstants.pas index 9e0073be..e549bfe8 100644 --- a/docview/src/dvconstants.pas +++ b/docview/src/dvconstants.pas @@ -36,6 +36,7 @@ const NOTES_FILE_EXTENSION = ExtensionSeparator + 'notes'; BOOKMARK_FILE_EXTENSION = ExtensionSeparator + 'bookmark'; BOOKMARK_SECTION = '[BOOKMARK]'; + OWN_HELP_MARKER = '[DOCVIEWHELP]'; cDocViewHelpFile = 'docview.inf'; @@ -60,6 +61,18 @@ const hcConfigGeneralTab = 510; hcConfigFontsColorTab = 520; +const + PARAM_LINK_NOTE = 'note'; + PARAM_LINK_PROGRAM = 'program'; + PARAM_LINK_URL = 'url'; + PARAM_LINK_EXTERNAL = 'external'; + + PRGM_EXPLORER = 'explore'; // web explorer + PRGM_NETSCAPE = 'netscape'; + PRGM_MOZILLA = 'mozilla'; + PRGM_FIREFOX = 'firefox'; + + implementation diff --git a/docview/src/frm_bookmarks.pas b/docview/src/frm_bookmarks.pas new file mode 100644 index 00000000..4180b74f --- /dev/null +++ b/docview/src/frm_bookmarks.pas @@ -0,0 +1,312 @@ +unit frm_bookmarks; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, + Classes, + fpg_base, + fpg_main, + fpg_form, + fpg_listbox, + fpg_button, + HelpBookmark; + +type + TBookmarkCallback = procedure(Bookmark: TBookmark) of object; + + TBookmarksForm = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: BookmarksForm} + lbBookmarks: TfpgListBox; + btnRename: TfpgButton; + btnDelete: TfpgButton; + btnGoTo: TfpgButton; + btnHelp: TfpgButton; + btnClose: TfpgButton; + {@VFD_HEAD_END: BookmarksForm} + FBookmarkList: TList; + FOnBookmarksChanged: TNotifyEvent; + FOnGotoBookmark: TBookmarkCallback; + procedure lbBookmarksKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + procedure FormShow(Sender: TObject); + procedure lbBookmarksDoubleClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + procedure btnRenameClicked(Sender: TObject); + procedure btnDeleteClicked(Sender: TObject); + procedure btnGotoClicked(Sender: TObject); + procedure btnHelpClicked(Sender: TObject); + procedure btnCloseClicked(Sender: TObject); + function SelectedObject(ListBox: TfpgListBox): TObject; + procedure UpdateControls; + function GetSelectedBookmark: TBookmark; + procedure GotoSelectedBookmark; + public + procedure AfterCreate; override; + procedure RefreshList; + published + property BookmarkList: TList read FBookmarkList write FBookmarkList; + property OnBookmarksChanged: TNotifyEvent read FOnBookmarksChanged write FOnBookmarksChanged; + property OnGotoBookmark: TBookmarkCallback read FOnGotoBookmark write FOnGotoBookmark; + end; + +{@VFD_NEWFORM_DECL} + +implementation + +uses + fpg_dialogs; + +{@VFD_NEWFORM_IMPL} + +procedure TBookmarksForm.lbBookmarksKeyPressed(Sender: TObject; + var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); +begin + if (KeyCode = keyEnter) or (KeyCode = keyPEnter) then + begin + GotoSelectedBookmark; + Close; + end; +end; + +procedure TBookmarksForm.FormShow(Sender: TObject); +begin + RefreshList; + lbBookmarks.SetFocus; +end; + +procedure TBookmarksForm.lbBookmarksDoubleClicked(Sender: TObject; + AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); +begin + GotoSelectedBookmark; + Close; +end; + +procedure TBookmarksForm.btnRenameClicked(Sender: TObject); +var + Bookmark: TBookmark; + lName: TfpgString; +begin + Bookmark := GetSelectedBookmark; + if Bookmark = nil then + exit; + + lName := Bookmark.Name; + if fpgInputQuery( 'Rename Bookmark', 'Enter the new name of the bookmark', lName ) then + begin + Bookmark.Name := lName; + if Assigned(OnBookmarksChanged) then + OnBookmarksChanged(self); + // redisplay name in list + lbBookmarks.Items[lbBookmarks.FocusItem] := Bookmark.Name; + lbBookmarks.Invalidate; + end; +end; + +procedure TBookmarksForm.btnDeleteClicked(Sender: TObject); +var + Bookmark: TBookmark; + BookmarkIndex: integer; +begin + Bookmark := GetSelectedBookmark; + if Bookmark = nil then + exit; + + if TfpgMessageDialog.Question('Delete Bookmark', + Format('Delete the bookmark named "%s"?', [Bookmark.Name])) = mbYes then + begin + BookmarkIndex := BookmarkList.IndexOf( Bookmark ); + lbBookmarks.Items.Delete( BookmarkIndex ); + BookmarkList.Delete( BookmarkIndex ); + + if BookmarkIndex > BookmarkList.Count - 1 then + BookmarkIndex := BookmarkList.Count - 1; + + lbBookmarks.FocusItem := BookmarkIndex; + + Bookmark.Free; + if Assigned(OnBookmarksChanged) then + OnBookmarksChanged(self); + lbBookmarks.Invalidate; + + UpdateControls; + end; +end; + +procedure TBookmarksForm.btnGotoClicked(Sender: TObject); +begin + GotoSelectedBookmark; +end; + +procedure TBookmarksForm.btnHelpClicked(Sender: TObject); +begin + InvokeHelp; +end; + +procedure TBookmarksForm.btnCloseClicked(Sender: TObject); +begin + Close; +end; + +function TBookmarksForm.SelectedObject(ListBox: TfpgListBox): TObject; +begin + if (ListBox.FocusItem >= 0) and (ListBox.FocusItem < ListBox.Items.Count) then + Result := ListBox.Items.Objects[ListBox.FocusItem] + else + Result := nil; +end; + +procedure TBookmarksForm.UpdateControls; +var + Selected: Boolean; +begin + Selected := GetSelectedBookmark <> nil; + btnRename.Enabled := Selected; + btnDelete.Enabled := Selected; + btnGoto.Enabled := Selected; + if not btnGoto.Enabled then + btnGoto.Default := false; +end; + +function TBookmarksForm.GetSelectedBookmark: TBookmark; +begin + if SelectedObject(lbBookmarks) = nil then + result := nil + else + result := SelectedObject(lbBookmarks) as TBookmark; +end; + +procedure TBookmarksForm.GotoSelectedBookmark; +begin + if Assigned(FOnGotoBookmark) then + if GetSelectedBookmark <> nil then + FOnGotoBookmark(GetSelectedBookmark); +end; + +procedure TBookmarksForm.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: BookmarksForm} + Name := 'BookmarksForm'; + SetPosition(553, 246, 393, 247); + WindowTitle := 'Bookmarks'; + Hint := ''; + HelpType := htContext; + HelpContext := 8; + OnShow := @FormShow; + + lbBookmarks := TfpgListBox.Create(self); + with lbBookmarks do + begin + Name := 'lbBookmarks'; + SetPosition(8, 12, 272, 227); + Anchors := [anLeft,anRight,anTop,anBottom]; + FontDesc := '#List'; + Hint := ''; + TabOrder := 1; + OnDoubleClick := @lbBookmarksDoubleClicked; + OnKeyPress := @lbBookmarksKeyPressed; + end; + + btnRename := TfpgButton.Create(self); + with btnRename do + begin + Name := 'btnRename'; + SetPosition(288, 16, 96, 23); + Anchors := [anRight,anTop]; + Text := 'Rename...'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 2; + OnClick := @btnRenameClicked; + end; + + btnDelete := TfpgButton.Create(self); + with btnDelete do + begin + Name := 'btnDelete'; + SetPosition(288, 44, 96, 23); + Anchors := [anRight,anTop]; + Text := 'Delete'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 3; + OnClick := @btnDeleteClicked; + end; + + btnGoTo := TfpgButton.Create(self); + with btnGoTo do + begin + Name := 'btnGoTo'; + SetPosition(288, 72, 96, 23); + Anchors := [anRight,anTop]; + Text := 'Goto'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 4; + Default := True; + OnClick := @btnGotoClicked; + end; + + btnHelp := TfpgButton.Create(self); + with btnHelp do + begin + Name := 'btnHelp'; + SetPosition(288, 100, 96, 23); + Anchors := [anRight,anTop]; + Text := 'Help'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 5; + OnClick := @btnHelpClicked; + end; + + btnClose := TfpgButton.Create(self); + with btnClose do + begin + Name := 'btnClose'; + SetPosition(288, 217, 96, 23); + Anchors := [anRight,anBottom]; + Text := 'Close'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 6; + OnClick := @btnCloseClicked; + end; + + {@VFD_BODY_END: BookmarksForm} + {%endregion} +end; + +procedure TBookmarksForm.RefreshList; +var + i: integer; + Bookmark: TBookmark; +Begin + lbBookmarks.Items.BeginUpdate; + + lbBookmarks.Items.Clear; + + if not Assigned(BookmarkList) then + exit; + + for i := 0 to BookmarkList.Count - 1 do + begin + Bookmark := TBookmark(BookmarkList[i]); + lbBookmarks.Items.AddObject(Bookmark.Name, Bookmark); + end; + + if lbBookmarks.Items.Count > 0 then + lbBookmarks.FocusItem := 0; + + lbBookmarks.Items.EndUpdate; + UpdateControls; +End; + +end. diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index ddad88d8..97a9fd04 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -58,6 +58,7 @@ type RichView: TRichTextView; MainMenu: TfpgMenuBar; miFile: TfpgPopupMenu; + miActions: TfpgPopupMenu; miSettings: TfpgPopupMenu; miBookmarks: TfpgPopupMenu; miView: TfpgPopupMenu; @@ -129,9 +130,19 @@ type procedure miFileOpenAdditionalFileClicked(Sender: TObject); procedure miFileOpenSpecialClicked(Sender: TObject); procedure miFileCloseClicked(Sender: TObject); + procedure miActionsContentsClicked(Sender: TObject); + procedure miActionsIndexClicked(Sender: TObject); + procedure miActionsSearchClicked(Sender: TObject); + procedure miActionsNotesClicked(Sender: TObject); + procedure miActionsHistoryClicked(Sender: TObject); + procedure miActionsBackClicked(Sender: TObject); + procedure miActionsForwardClicked(Sender: TObject); + procedure miActionsPrevTopicClicked(Sender: TObject); + procedure miActionsNextTopicClicked(Sender: TObject); procedure miConfigureClicked(Sender: TObject); procedure miViewExpandAllClicked(Sender: TObject); procedure miViewCollapseAllClicked(Sender: TObject); + procedure miOpenBookmarksMenuClicked(Sender: TObject); procedure miBookmarksMenuItemClicked(Sender: TObject); procedure miHelpProdInfoClicked(Sender: TObject); procedure miHelpAboutFPGui(Sender: TObject); @@ -234,7 +245,6 @@ type procedure ClearBookmarks; procedure OnBookmarksChanged(Sender: TObject); procedure BuildBookmarksMenu; - procedure UpdateBookmarksDisplay; procedure NavigateToBookmark(Bookmark: TBookmark); public constructor Create(AOwner: TComponent); override; @@ -265,7 +275,7 @@ uses ,frm_configuration ,frm_text ,frm_note - ,NewViewConstantsUnit + ,frm_bookmarks ,CanvasFontManager ,HelpNote ,RichTextDocumentUnit @@ -298,6 +308,26 @@ begin end end; +procedure TMainForm.miActionsBackClicked(Sender: TObject); +begin + btnBack.Click; +end; + +procedure TMainForm.miActionsForwardClicked(Sender: TObject); +begin + btnFwd.Click; +end; + +procedure TMainForm.miActionsPrevTopicClicked(Sender: TObject); +begin + btnPrev.Click; +end; + +procedure TMainForm.miActionsNextTopicClicked(Sender: TObject); +begin + btnNext.Click; +end; + procedure TMainForm.Splitter1DoubleClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin @@ -420,9 +450,12 @@ end; procedure TMainForm.RichViewClickLink(Sender: TRichTextView; Link: string); var + LinkDetails: TfpgString; LinkIndex: integer; lLink: THelpLink; lHelp: THelpFile; + f: THelpFile; + lHelpFileName: TfpgString; i: integer; lTopic: TTopic; lFound: Boolean; @@ -441,7 +474,32 @@ begin end else if pos(PARAM_LINK_EXTERNAL, Link) > 0 then begin - TfpgMessageDialog.Warning('', 'External links are not supported in DocView yet. Please try again with a later build.') + LinkDetails := StrRightFrom( Link, 10 ); // 10 is starting pos of data, after 'external ' + LinkIndex := StrToInt( ExtractNextValue( LinkDetails, ' ' ) ); + lHelp := CurrentTopic.HelpFile as THelpFile; + + lHelpFileName := lHelp.ReferencedFiles[ LinkIndex ]; + + { Only open the external file once. So see if it is already openned. } + lFound := False; + for i := 0 to CurrentOpenFiles.Count-1 do + begin + f := THelpFile(CurrentOpenFiles[i]); + if SameText(fpgExtractFileName(f.Filename), lHelpFileName) then + lFound := True; + end; + if not lFound then + begin + OpenAdditionalFile := True; + OpenFile(lHelpFileName, '', false); + OpenAdditionalFile := False; + end; + + { Not sure if we have an ID or Resource Name, so lets try both if possible } + if TryStrToInt(LinkDetails, i) then + DisplayTopicByResourceID(i) + else + DisplayTopicByName(LinkDetails); end else if pos(PARAM_LINK_URL, Link) > 0 then begin @@ -578,6 +636,31 @@ begin CloseFile; end; +procedure TMainForm.miActionsContentsClicked(Sender: TObject); +begin + PageControl1.ActivePage := tsContents; +end; + +procedure TMainForm.miActionsIndexClicked(Sender: TObject); +begin + PageControl1.ActivePage := tsIndex; +end; + +procedure TMainForm.miActionsSearchClicked(Sender: TObject); +begin + PageControl1.ActivePage := tsSearch; +end; + +procedure TMainForm.miActionsNotesClicked(Sender: TObject); +begin + PageControl1.ActivePage := tsNotes; +end; + +procedure TMainForm.miActionsHistoryClicked(Sender: TObject); +begin + PageControl1.ActivePage := tsHistory; +end; + procedure TMainForm.miConfigureClicked(Sender: TObject); begin ShowConfigForm; @@ -594,6 +677,21 @@ begin tvContents.FullCollapse; end; +procedure TMainForm.miOpenBookmarksMenuClicked(Sender: TObject); +var + frm: TBookmarksForm; +begin + frm := TBookmarksForm.Create(nil); + try + frm.BookmarkList := Bookmarks; + frm.OnGotoBookmark := @NavigateToBookmark; + frm.OnBookmarksChanged := @OnBookmarksChanged; + frm.ShowModal; + finally + frm.Free; + end; +end; + procedure TMainForm.miBookmarksMenuItemClicked(Sender: TObject); var t: PtrInt; @@ -2465,8 +2563,7 @@ begin if ImageIndices.Count > 0 then begin - { TODO -oGraeme : We do not support images yet } -// THelpFile(CurrentTopic.HelpFile).GetImages(ImageIndices, FImages); + THelpFile(CurrentTopic.HelpFile).GetImages(ImageIndices, FImages); end; ImageIndices.Free; @@ -2531,6 +2628,7 @@ var begin inherited Create(AOwner); fpgApplication.OnException := @MainFormException; + fpgApplication.HelpFile := cDocViewHelpFile; OnShow := @MainFormShow; OnDestroy := @MainFormDestroy; // Files := TList.Create; @@ -3078,17 +3176,34 @@ begin begin Name := 'miFile'; SetPosition(292, 96, 132, 20); - AddMenuItem('Open...', 'Ctrl+O', @miFileOpenClicked); - AddMenuItem('Open additional file...', 'Ctrl+Shift+O', @miFileOpenAdditionalFileClicked); - AddMenuItem('Open Special...', 'Ctrl+L', @miFileOpenSpecialClicked); - AddMenuItem('Save current Topic to IPF...', 'Ctrl+S', @miFileSaveTopicAsIPF); - AddMenuItem('Close', 'Ctrl+W', @miFileCloseClicked); - AddMenuitem('-', '', nil); + AddMenuItem('Open...', rsKeyCtrl+'O', @miFileOpenClicked); + AddMenuItem('Open additional file...', rsKeyCtrl+rsKeyShift+'O', @miFileOpenAdditionalFileClicked); + AddMenuItem('Open Special...', rsKeyCtrl+'L', @miFileOpenSpecialClicked); + AddMenuItem('Save current Topic to IPF...', rsKeyCtrl+'S', @miFileSaveTopicAsIPF); + AddMenuItem('Close', rsKeyCtrl+'W', @miFileCloseClicked); + AddSeparator; FFileOpenRecent := AddMenuItem('Open Recent...', '', nil); AddMenuitem('-', '', nil); AddMenuItem('Quit', 'Ctrl+Q', @miFileQuitClicked); end; + miActions := TfpgPopupMenu.Create(self); + with miActions do + begin + Name := 'miActions'; + SetPosition(282, 96, 132, 20); + AddMenuItem('Contents', 'F5', @miActionsContentsClicked); + AddMenuItem('Index', 'F6', @miActionsIndexClicked); + AddMenuItem('Search', 'F7', @miActionsSearchClicked); + AddMenuItem('Notes', 'F8', @miActionsNotesClicked); + AddMenuItem('History', 'F9', @miActionsHistoryClicked); + AddSeparator; + AddMenuItem('Back', rsKeyCtrl+'Left', @miActionsBackClicked); + AddMenuItem('Forward', rsKeyCtrl+'Right', @miActionsForwardClicked); + AddMenuItem('Previous Topic', rsKeyCtrl+'Up', @miActionsPrevTopicClicked); + AddMenuItem('Next Topic', rsKeyCtrl+'Down', @miActionsNextTopicClicked); + end; + miSettings := TfpgPopupMenu.Create(self); with miSettings do begin @@ -3102,8 +3217,10 @@ begin begin Name := 'miBookmarks'; SetPosition(292, 144, 132, 20); - AddMenuItem('Add..', '', nil).Enabled := False; - AddMenuItem('Show', '', nil).Enabled := False; + AddMenuItem('Add', rsKeyCtrl+'B', @btnBookmarkClick); + AddMenuItem('Edit...', rsKeyCtrl+'D', @miOpenBookmarksMenuClicked); + AddSeparator; + AddMenuItem('Add note at cursor position', rsKeyCtrl+'M', @btnNotesAddClick); end; miView := TfpgPopupMenu.Create(self); @@ -3113,7 +3230,7 @@ begin SetPosition(292, 216, 132, 20); AddMenuItem('Expand All', '', @miViewExpandAllClicked); AddMenuItem('Collapse All', '', @miViewCollapseAllClicked); - AddMenuItem('-', '', nil); + AddSeparator; AddMenuItem('Topic Properties', '', @miTopicPropertiesClicked); end; @@ -3137,9 +3254,9 @@ begin begin Name := 'miHelp'; SetPosition(292, 168, 132, 20); - AddMenuItem('Help using DocView', '', @miHelpUsingDocView); - AddMenuItem('Command line parameters', '', @miHelpCmdLineParams); - AddMenuItem('-', '', nil); + AddMenuItem('Help using DocView', rsKeyCtrl+'F1', @miHelpUsingDocView); + AddMenuItem('Command line parameters', rsKeyCtrl+rsKeyShift+'F1', @miHelpCmdLineParams); + AddSeparator; AddMenuItem('About fpGUI Toolkit...', '', @miHelpAboutFPGui); AddMenuItem('Product Information...', '', @miHelpProdInfoClicked); end; @@ -3375,6 +3492,7 @@ begin // hook up the sub-menus. MainMenu.AddMenuItem('&File', nil).SubMenu := miFile; MainMenu.AddMenuItem('&Settings', nil).SubMenu := miSettings; + MainMenu.AddMenuItem('&Actions', nil).SubMenu := miActions; MainMenu.AddMenuItem('&Bookmarks', nil).SubMenu := miBookmarks; MainMenu.AddMenuItem('&Tools', nil).SubMenu := miTools; MainMenu.AddMenuItem('&Help', nil).SubMenu := miHelp; @@ -3842,7 +3960,6 @@ end; procedure TMainForm.OnBookmarksChanged(Sender: TObject); begin BuildBookmarksMenu; -// UpdateBookmarksForm; SaveBookmarks; end; @@ -3870,33 +3987,6 @@ begin end; end; -procedure TMainForm.UpdateBookmarksDisplay; -var - i: integer; - Bookmark: TBookmark; -Begin -(* - BookmarksListBox.Items.BeginUpdate; - BookmarksListBox.Clear; - - if not Assigned( BookmarkList ) then - exit; - - for i := 0 to BookmarkList.Count - 1 do - begin - Bookmark := BookmarkList[ i ]; - BookmarksListBox.Items.AddObject( Bookmark.Name, - Bookmark ); - end; - - if BookmarksListBox.Items.Count > 0 then - BookmarksListBox.ItemIndex := 0; - - BookmarksListBox.Items.EndUpdate; - UpdateControls; -*) -end; - procedure TMainForm.NavigateToBookmark(Bookmark: TBookmark); begin DisplayTopic(Bookmark.ContentsTopic); diff --git a/docview/src/frm_note.pas b/docview/src/frm_note.pas index 2e280a89..310cc252 100644 --- a/docview/src/frm_note.pas +++ b/docview/src/frm_note.pas @@ -5,7 +5,13 @@ unit frm_note; interface uses - SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_memo, fpg_button; + SysUtils, + Classes, + fpg_base, + fpg_main, + fpg_form, + fpg_memo, + fpg_button; type @@ -23,6 +29,7 @@ type function GetText: TfpgString; procedure SetText(const AValue: TfpgString); procedure SetCanDelete(const AValue: boolean); + procedure btnHelpClicked(Sender: TObject); public procedure AfterCreate; override; property Text: TfpgString read GetText write SetText; @@ -56,6 +63,11 @@ begin btnDelete.Enabled := FCanDelete; end; +procedure TNoteForm.btnHelpClicked(Sender: TObject); +begin + InvokeHelp; +end; + procedure TNoteForm.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} @@ -65,6 +77,8 @@ begin WindowTitle := 'Notes'; Hint := ''; OnShow := @FormShow; + HelpType := htContext; + HelpContext := 7; Memo1 := TfpgMemo.Create(self); with Memo1 do @@ -102,6 +116,7 @@ begin Hint := ''; ImageName := ''; TabOrder := 3; + OnClick := @btnHelpClicked; end; btnCancel := TfpgButton.Create(self); diff --git a/docview/src/lzwdecompress.pas b/docview/src/lzwdecompress.pas new file mode 100644 index 00000000..0ebba38c --- /dev/null +++ b/docview/src/lzwdecompress.pas @@ -0,0 +1,263 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + LZW decompression code for uncompressing IPF bitmaps. +} + +unit LZWDecompress; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, types; + +procedure LZWDecompressBlock( pbInput: pByte; + number_bytes: LongWord; + pbOutput: PBYTE; + Var bytesOut: LongWord; + Var FinalCode: byte ); + +Implementation + +(* +/******************************************************************** + * * + * LZW decompression * + * * + *******************************************************************/ + +/* + * This is based on code (W) by Peter Fitzsimmons, pfitz@ican.net. + * His liner notes in the original: + * has its roots in a June 1990 + * DDJ article "LZW REVISITED", by Shawn M. Regan + * --=>revision history<=-- + * 1 lzw.c 21-Aug-96,2:24:36,`PLF' ; + * 2 lzw.c 24-Aug-96,2:27:24,`PLF' wip + * + * The code has been modified to take the input not from an + * open file, but from any memory region. For this, a double + * pointer is used, which must be passed to LZWDecompressBlock. + * I've also added a few comments for clarity. + * + * Ported to Sibyl Pascal by Aaron Lawrence + * Variables renamed etc to make things clearer. + */ +*) +// -- Stuff for LZW decompression -- */ +const INIT_BITS = 9; +const MAX_BITS = 12; //PLF Tue 95-10-03 02:16:56*/ +const HASHING_SHIFT = MAX_BITS - 8; + +{if MAX_BITS == 15 +const TABLE_SIZE 36768 +#elif MAX_BITS == 14 +const TABLE_SIZE 18041 +#elif MAX_BITS == 13 +const TABLE_SIZE 9029 +#else} +// For max_bits = 12: +const TABLE_SIZE = 5021; + +const CLEAR_TABLE = 256; +const TERMINATOR = 257; +const FIRST_CODE = 258; + +function MaxValNBits( N: word ): word; +begin + Result:= ( 1 shl n ) - 1; +end; + +var + prefix_code: array[ 0..TABLE_SIZE ] of longword; + append_character: array[ 0..TABLE_SIZE ] of Byte; + decode_stack: array[ 0..10000 ] of byte; + bitsPerCode: longint; + maxDictionaryCode: longint; + +(* + * decode_string: + * + *) +function decode_string( buffer: PByte; code: longword ): PByte; +var + i: longint; +begin + i:= 0; + + while Code > 255 do + begin + buffer^:= append_character[ Code ]; + inc( Buffer ); + code:= prefix_code[ code ]; + + inc( i ); + if i > High( decode_stack ) then + assert( false, 'Out of space decompressing bitmap!' ); + end; + + buffer^ := code; + Result:= buffer; +end; + +(* + * input_code: + * this function reads in bytes from the input + * stream. + *) + +var + bytes_out: longword = 0; + input_bit_count: longword = 0; + input_bit_buffer: longword = 0; + +// I think this simply reads the next bitsPerCode bits of the input data +// returning the resulting code. +function input_code( var pbInput: PBYTE; bytes_to_read: longword ): longword; +var + return_value: longword; +begin + while input_bit_count <= 24 do + begin + if bytes_out <= bytes_to_read then + begin + input_bit_buffer:= input_bit_buffer + or + ( ( longword( pbInput^ ) shl (24 - input_bit_count) ) ); + inc( pbInput ); + end + else + input_bit_buffer:= input_bit_buffer + or + ( longword( 0 ) shl ( 24 - input_bit_count ) ); + inc( bytes_out ); + inc( input_bit_count, 8 ); + end; + + return_value:= input_bit_buffer shr (32 - bitsPerCode); + input_bit_buffer:= input_bit_buffer shl bitsPerCode; + dec( input_bit_count, bitsPerCode ); + + if bytes_out > bytes_to_read then + begin + // flush static vars and quit */ + bytes_out:= 0; + input_bit_count:= 0; + input_bit_buffer:= 0; + Result:= TERMINATOR; + end + else + Result:= return_value; +end; + +// LZWDecompressBlock: +// this takes one of the INF bitmap blocks +// and decompresses it using LZW algorithms. + +procedure LZWDecompressBlock( pbInput: pByte; + number_bytes: LongWord; + pbOutput: PBYTE; + Var bytesOut: LongWord; + Var FinalCode: byte ); +var + nextAvailableCode: LongWord; + currentCode: LongWord; + lastCode: LongWord; + character: longword; + clear_flag: boolean; + theString: pByte; +begin + clear_flag:= true; + + nextAvailableCode:= FIRST_CODE; + bitsPerCode:= INIT_BITS; + maxDictionaryCode:= MaxValNBits( bitsPerCode ); + + bytesOut:= 0; + input_bit_count:= 0; + input_bit_buffer:= 0; + + // read the first code from input + currentCode:= input_code( pbInput, number_bytes ); + while currentCode <> TERMINATOR do + begin + if clear_flag then + begin + clear_flag:= false; + lastCode:= currentCode; + character:= currentCode; + + pbOutput^:= currentCode; + inc( pbOutput ); + FinalCode:= currentCode; + inc( BytesOut ); + end + else if currentCode = CLEAR_TABLE then + begin + clear_flag:= true; + nextAvailableCode:= FIRST_CODE; + bitsPerCode:= INIT_BITS; + maxDictionaryCode:= MaxValNBits( bitsPerCode ); + end + else + begin + if currentCode >= nextAvailableCode then + begin + decode_stack[ 0 ]:= character; + theString:= decode_string( Addr( decode_stack[ 1 ] ), + lastCode ); + end + else + theString:= decode_string( Addr( decode_stack[ 0 ] ), + currentCode ); + + character:= longword( theString^ ); + while theString >= Addr( decode_stack[ 0 ] ) do + begin + FinalCode:= theString^; + + pbOutput^:= theString^; + inc( pbOutput ); + dec( TheString ); + + inc( BytesOut ); + end; + + if nextAvailableCode <= maxDictionaryCode then + begin + prefix_code[ nextAvailableCode ]:= lastCode; + append_character[ nextAvailableCode ]:= character; + + inc( nextAvailableCode ); + + if ( nextAvailableCode = maxDictionaryCode ) and ( bitsPerCode < MAX_BITS ) then + begin + // expand dictionary + inc( bitsPerCode ); + maxDictionaryCode:= MaxValNBits( bitsPerCode ); + end; + end; + + lastCode:= currentCode; + end; + + // Read next code from input + currentCode:= input_code( pbInput, number_bytes ); + end; +end; + + +End. |