From 5e75bca62347618d8b1fa40e1a164abe3f77827d Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 19 Mar 2013 23:04:09 +0000 Subject: docview: Fixes a bug where URL links where not handled correctly. When we detected know web browser names, we had to only use the URL part, not the original program+url text. DocView lets the OS choose the web browser. --- docview/src/HelpTopic.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'docview/src') diff --git a/docview/src/HelpTopic.pas b/docview/src/HelpTopic.pas index 3af43e6a..5a8245a7 100644 --- a/docview/src/HelpTopic.pas +++ b/docview/src/HelpTopic.pas @@ -859,6 +859,7 @@ var ProgramLink: string; ProgramPath: string; ProgramFilename: string; + lURL: string; ProgramInfo : TSerializableStringList; tmpProgramLinkParts : TStrings; @@ -1000,6 +1001,7 @@ begin tmpProgramLinkParts := TStringList.Create; StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0); ProgramPath := tmpProgramLinkParts[0]; + lURL := tmpProgramLinkParts[1]; tmpProgramLinkParts.Destroy; ProgramFilename := ExtractFilename( ProgramPath ); @@ -1011,7 +1013,7 @@ begin then begin OutputString := ''; end else -- cgit v1.2.3-70-g09d2 From a825372de0ad8d75abeeb6d9061377ca4ec032be Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 19 Mar 2013 23:04:32 +0000 Subject: docview: fixes grammer error in code comment --- docview/src/frm_main.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'docview/src') diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index 0b8cd694..ddad88d8 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -445,7 +445,7 @@ begin end else if pos(PARAM_LINK_URL, Link) > 0 then begin - // we have a external URL of some kind + // we have an external URL of some kind // format is always: 'url ""' lURL := StringReplace(Link, 'url "', '', []); lURL := UTF8Copy(lURL, 0, UTF8Length(lURL)-1); -- cgit v1.2.3-70-g09d2 From a1f4823efed17adf5eb9c5137ba12a5feee2753e Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 2 Apr 2013 12:59:45 +0100 Subject: Bump the version numbers --- docview/src/docview.rc | 8 ++++---- src/VERSION_FILE.inc | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) (limited to 'docview/src') diff --git a/docview/src/docview.rc b/docview/src/docview.rc index 87597a3f..34ed0c18 100644 --- a/docview/src/docview.rc +++ b/docview/src/docview.rc @@ -1,8 +1,8 @@ MAINICON ICON "../images/docview-48x48.ico" 1 VERSIONINFO -FILEVERSION 0, 8, 0, 0 -PRODUCTVERSION 0, 8, 0, 0 +FILEVERSION 1, 0, 0, 0 +PRODUCTVERSION 1, 0, 0, 0 FILEFLAGSMASK 0 FILEOS 0x40000 FILETYPE 1 @@ -13,12 +13,12 @@ FILETYPE 1 { VALUE "CompanyName", "fpGUI Toolkit" VALUE "FileDescription", "fpGUI's INF Documentation Viewer" - VALUE "FileVersion", "0.8.0" + VALUE "FileVersion", "1.0.0" VALUE "InternalName", "docview" VALUE "LegalCopyright", "GNU Public License" VALUE "OriginalFilename", "docview" VALUE "ProductName", "fpGUI Toolkit" - VALUE "ProductVersion", "0.8.0" + VALUE "ProductVersion", "1.0.0" } } BLOCK "VarFileInfo" diff --git a/src/VERSION_FILE.inc b/src/VERSION_FILE.inc index f5780fb3..212d4aea 100644 --- a/src/VERSION_FILE.inc +++ b/src/VERSION_FILE.inc @@ -1 +1 @@ -FPGUI_VERSION = '0.8'; +FPGUI_VERSION = '1.0'; -- cgit v1.2.3-70-g09d2 From 148823d602916830465bc4331b64ece5077cce76 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Apr 2013 00:35:55 +0100 Subject: docview: Adds support for external links (links to other INF files) --- docview/src/frm_main.pas | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) (limited to 'docview/src') diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index ddad88d8..6427efd5 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -420,9 +420,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 +444,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 -- cgit v1.2.3-70-g09d2 From 5927b6cf6418341906857535f7ed8ed3d948165d Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Apr 2013 09:38:08 +0100 Subject: docview: removed second constants unit - we only need one --- docview/src/HelpTopic.pas | 2 +- docview/src/NewViewConstantsUnit.pas | 37 ------------------------ docview/src/docview.lpi | 55 ++++++++++++++++-------------------- docview/src/docview.lpr | 2 +- docview/src/dvconstants.pas | 12 ++++++++ docview/src/frm_main.pas | 1 - 6 files changed, 39 insertions(+), 70 deletions(-) delete mode 100644 docview/src/NewViewConstantsUnit.pas (limited to 'docview/src') 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..a9faf321 100644 --- a/docview/src/docview.lpi +++ b/docview/src/docview.lpi @@ -31,7 +31,7 @@ - + @@ -132,80 +132,75 @@ - + - + - + - + - + - + - + - + - + - - + + - + - - + + - + - - + + - + - - + - - - - - - + + - - + + - + diff --git a/docview/src/docview.lpr b/docview/src/docview.lpr index e49aa4c3..17f53a71 100644 --- a/docview/src/docview.lpr +++ b/docview/src/docview.lpr @@ -9,7 +9,7 @@ uses {$ENDIF}{$ENDIF} Classes, fpg_main, frm_main, IPFEscapeCodes, HelpTopic, CompareWordUnit, SearchTable, TextSearchQuery, nvUtilities, HelpFile, SearchUnit, fpg_cmdlineparams, - IPFFileFormatUnit, HelpWindowDimensions, NewViewConstantsUnit, SettingsUnit, + IPFFileFormatUnit, HelpWindowDimensions, SettingsUnit, RichTextStyleUnit, CanvasFontManager, ACLStringUtility, RichTextDocumentUnit, RichTextView, RichTextLayoutUnit, RichTextDisplayUnit, dvconstants, dvHelpers, frm_configuration, HelpBitmap, frm_text, frm_note, HelpNote, HelpBookmark; diff --git a/docview/src/dvconstants.pas b/docview/src/dvconstants.pas index 9e0073be..cbff4ad7 100644 --- a/docview/src/dvconstants.pas +++ b/docview/src/dvconstants.pas @@ -60,6 +60,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_main.pas b/docview/src/frm_main.pas index 6427efd5..6ec71335 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -265,7 +265,6 @@ uses ,frm_configuration ,frm_text ,frm_note - ,NewViewConstantsUnit ,CanvasFontManager ,HelpNote ,RichTextDocumentUnit -- cgit v1.2.3-70-g09d2 From c2e3d428a2d186272566a5de54ef5ad40485ea1b Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Apr 2013 12:21:48 +0100 Subject: Move constants to constants unit --- docview/src/dvHelpers.pas | 3 --- docview/src/dvconstants.pas | 1 + 2 files changed, 1 insertion(+), 3 deletions(-) (limited to 'docview/src') 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 cbff4ad7..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'; -- cgit v1.2.3-70-g09d2 From 03303574f2d09759cab902dd859429c391426206 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Apr 2013 12:22:43 +0100 Subject: docview: assign own help file for future dialog help. --- docview/src/frm_main.pas | 1 + 1 file changed, 1 insertion(+) (limited to 'docview/src') diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index 6ec71335..0463c69a 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -2558,6 +2558,7 @@ var begin inherited Create(AOwner); fpgApplication.OnException := @MainFormException; + fpgApplication.HelpFile := cDocViewHelpFile; OnShow := @MainFormShow; OnDestroy := @MainFormDestroy; // Files := TList.Create; -- cgit v1.2.3-70-g09d2 From a4ebdffd940c415d3784733df54b1e2ab5ac332c Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Apr 2013 14:14:17 +0100 Subject: docview: Implements the Bookmark Maintenance form. We can now Jump To bookmark, rename bookmarks, delete bookmarks etc. --- docview/src/docview.lpi | 7 +- docview/src/docview.lpr | 9 +- docview/src/frm_bookmarks.pas | 312 ++++++++++++++++++++++++++++++++++++++++++ docview/src/frm_main.pas | 50 +++---- 4 files changed, 342 insertions(+), 36 deletions(-) create mode 100644 docview/src/frm_bookmarks.pas (limited to 'docview/src') diff --git a/docview/src/docview.lpi b/docview/src/docview.lpi index a9faf321..aa570406 100644 --- a/docview/src/docview.lpi +++ b/docview/src/docview.lpi @@ -31,7 +31,7 @@ - + @@ -201,6 +201,11 @@ + + + + + diff --git a/docview/src/docview.lpr b/docview/src/docview.lpr index 17f53a71..ad71b43a 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, 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; {$IFDEF WINDOWS} {$R docview.rc} 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 0463c69a..42d8fa73 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -132,6 +132,7 @@ type 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 +235,6 @@ type procedure ClearBookmarks; procedure OnBookmarksChanged(Sender: TObject); procedure BuildBookmarksMenu; - procedure UpdateBookmarksDisplay; procedure NavigateToBookmark(Bookmark: TBookmark); public constructor Create(AOwner: TComponent); override; @@ -265,6 +265,7 @@ uses ,frm_configuration ,frm_text ,frm_note + ,frm_bookmarks ,CanvasFontManager ,HelpNote ,RichTextDocumentUnit @@ -621,6 +622,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; @@ -3130,8 +3146,8 @@ begin begin Name := 'miBookmarks'; SetPosition(292, 144, 132, 20); - AddMenuItem('Add..', '', nil).Enabled := False; - AddMenuItem('Show', '', nil).Enabled := False; + AddMenuItem('Add', '', @btnBookmarkClick); + AddMenuItem('Show...', '', @miOpenBookmarksMenuClicked); end; miView := TfpgPopupMenu.Create(self); @@ -3870,7 +3886,6 @@ end; procedure TMainForm.OnBookmarksChanged(Sender: TObject); begin BuildBookmarksMenu; -// UpdateBookmarksForm; SaveBookmarks; end; @@ -3898,33 +3913,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); -- cgit v1.2.3-70-g09d2 From 68a0c5357a9efd9c6184dd0b93593f192f377a23 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Apr 2013 14:20:47 +0100 Subject: docview: update help file - bookmarks functionality is now fully implemented --- docview/docs/docview.ipf | 11 +++++------ docview/src/frm_main.pas | 2 +- 2 files changed, 6 insertions(+), 7 deletions(-) (limited to 'docview/src') diff --git a/docview/docs/docview.ipf b/docview/docs/docview.ipf index 567ef1bd..e073990d 100644 --- a/docview/docs/docview.ipf +++ b/docview/docs/docview.ipf @@ -568,7 +568,6 @@ you open a new or additional help file. .* ************************************************************ :h1 res=8 id='bookmarks'.Bookmarks :hp2.Bookmarks:ehp2. -:note.:hp8.*** This feature is partially implemented. ***:ehp8. :p. &dv. allows you to bookmark particular topics within the current help file. Simply click the bookmark toolbar button @@ -579,16 +578,16 @@ To jump to a bookmark, go to the "Bookmarks" menu, and click on the bookmark you want to open. :p. You can view or delete all your bookmarks by clicking on "Edit..." in -the "Bookmarks" menu. This window can remain open while you read, so -that you can quickly look through your bookmarks. +the "Bookmarks" menu. :p. Bookmarks are saved in a file with the extension ".bookmarks", in the &dv. config directory. This is in the user's home profile directory where there is read/write access. Under Linux it is normally "~/.config/docview/" and under Windows it is normally "C:\Documents and Settings\\Local Settings\Application Data\docview". -I will probably add a setting in &dv., so the user can configure a -preferred storage location for bookmarks (eg: some users prefer it like OS/2's View program did, -by storing notes in the same directory as the help file). +.* TODO +.* I will probably add a setting in &dv., so the user can configure a +.* preferred storage location for bookmarks (eg: some users prefer it like OS/2's View program did, +.* by storing notes in the same directory as the help file). .* ************************************************************ diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index 42d8fa73..090916a3 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -3147,7 +3147,7 @@ begin Name := 'miBookmarks'; SetPosition(292, 144, 132, 20); AddMenuItem('Add', '', @btnBookmarkClick); - AddMenuItem('Show...', '', @miOpenBookmarksMenuClicked); + AddMenuItem('Edit...', '', @miOpenBookmarksMenuClicked); end; miView := TfpgPopupMenu.Create(self); -- cgit v1.2.3-70-g09d2 From ad18775da3754e7243bdf30ff158a7d366363dc7 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Apr 2013 14:21:51 +0100 Subject: docview: Help button in Notes dialog is now functional. --- docview/src/frm_note.pas | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) (limited to 'docview/src') 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); -- cgit v1.2.3-70-g09d2 From 5a2f413b691379d24f2ec8158d5de9cbf627547d Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Fri, 5 Apr 2013 00:16:49 +0100 Subject: docview: simple pointer usage issues. The program was overwriting the pointer itself, and not the location the pointer is pointing too. Simple mistake! :-/ --- docview/src/HelpBitmap.pas | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'docview/src') diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas index 0931ce82..eb2d9190 100644 --- a/docview/src/HelpBitmap.pas +++ b/docview/src/HelpBitmap.pas @@ -180,7 +180,7 @@ begin 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; @@ -214,7 +214,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 ); @@ -484,15 +484,19 @@ var BitmapData: PBYTE; ptr: PByte; begin + BitmapOutputPointer := nil; + BitmapData := nil; + ptr := nil; + // Allocate memory to store the bitmap 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,7 +510,7 @@ 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; -- cgit v1.2.3-70-g09d2 From 53f0a941d5490dbc01f9d8f220eb583a3fc5f84a Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Fri, 5 Apr 2013 00:17:37 +0100 Subject: docview: removes commented code we don't use or need any more. --- docview/src/HelpFile.pas | 25 ------------------------- 1 file changed, 25 deletions(-) (limited to 'docview/src') 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; -- cgit v1.2.3-70-g09d2 From 135c1deac21d749c6c1093e1740d3883d00d99ec Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Fri, 5 Apr 2013 10:08:52 +0100 Subject: docview: debug code to help debug reading images from INF files. --- docview/src/HelpBitmap.pas | 42 +++++++++++++++++++++++++++++++++++++++--- 1 file changed, 39 insertions(+), 3 deletions(-) (limited to 'docview/src') diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas index eb2d9190..ecce808f 100644 --- a/docview/src/HelpBitmap.pas +++ b/docview/src/HelpBitmap.pas @@ -1,11 +1,29 @@ +{ + 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, @@ -564,6 +582,24 @@ begin AllocateImage(32, _Header.cx, _Header.cy); + + {$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} + if TotalSize <> ImageDataSize then writeln('Warning: INF Bitmap size and allocated bitmap size are different. ', TotalSize, ' vs ', ImageDataSize); Move(BitmapData^, ImageData^, TotalSize); -- cgit v1.2.3-70-g09d2 From d4144394608a6f12e1f82529d7ffb5da3f098a41 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Fri, 5 Apr 2013 10:12:37 +0100 Subject: docview: Enabled support for reading images from INF files. (WIP) This is still Work-In-Progress because the images are displayed, but sometimes incorrectly, or with a wrong color palette. Either way, this is progress, and very long overdue. ;-) --- docview/src/HelpBitmap.pas | 284 +++++------------------------------------- docview/src/docview.lpi | 8 +- docview/src/docview.lpr | 2 +- docview/src/frm_main.pas | 3 +- docview/src/lzwdecompress.pas | 263 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 304 insertions(+), 256 deletions(-) create mode 100644 docview/src/lzwdecompress.pas (limited to 'docview/src') diff --git a/docview/src/HelpBitmap.pas b/docview/src/HelpBitmap.pas index ecce808f..692bf64d 100644 --- a/docview/src/HelpBitmap.pas +++ b/docview/src/HelpBitmap.pas @@ -26,7 +26,7 @@ unit HelpBitmap; interface uses - Classes, SysUtils, fpg_main, ctypes, + Classes, SysUtils, fpg_main, IPFFileFormatUnit; type @@ -83,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); @@ -91,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' @@ -120,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 ); @@ -137,7 +136,6 @@ var BytesRead: longint; Block: TBitmapBlock; - p: pointer; Blocks: TList; BlockIndex: longint; ImageType: uint16; @@ -172,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 @@ -192,7 +191,7 @@ 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 @@ -204,7 +203,7 @@ begin 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.' ); @@ -268,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 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); @@ -600,10 +380,10 @@ begin writeln('------------- END -------------'); {$ENDIF} - if TotalSize <> ImageDataSize then - writeln('Warning: INF Bitmap size and allocated bitmap size are different. ', TotalSize, ' vs ', ImageDataSize); - Move(BitmapData^, ImageData^, TotalSize); +// Move(BitmapOutputPointer^, ImageData^, ImageDataSize); + Move(img.ImageData^, self.ImageData^, img.ImageDataSize); UpdateImage; + img.Free; FreeMem( BitmapData, TotalSize ); end; diff --git a/docview/src/docview.lpi b/docview/src/docview.lpi index aa570406..6fc2c4cb 100644 --- a/docview/src/docview.lpi +++ b/docview/src/docview.lpi @@ -23,6 +23,7 @@ + @@ -31,7 +32,7 @@ - + @@ -206,6 +207,11 @@ + + + + + diff --git a/docview/src/docview.lpr b/docview/src/docview.lpr index ad71b43a..0bee1dbe 100644 --- a/docview/src/docview.lpr +++ b/docview/src/docview.lpr @@ -13,7 +13,7 @@ uses RichTextStyleUnit, CanvasFontManager, ACLStringUtility, RichTextDocumentUnit, RichTextView, RichTextLayoutUnit, RichTextDisplayUnit, dvconstants, dvHelpers, frm_configuration, HelpBitmap, frm_text, frm_note, HelpNote, HelpBookmark, - frm_bookmarks; + frm_bookmarks, LZWDecompress; {$IFDEF WINDOWS} {$R docview.rc} diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index 090916a3..b88b9206 100644 --- a/docview/src/frm_main.pas +++ b/docview/src/frm_main.pas @@ -2508,8 +2508,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; diff --git a/docview/src/lzwdecompress.pas b/docview/src/lzwdecompress.pas new file mode 100644 index 00000000..5f886f23 --- /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 ) << ( 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. -- cgit v1.2.3-70-g09d2 From d57b60d1be8da6d7f98bf503a5d4096a175daa54 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sat, 6 Apr 2013 02:38:29 +0100 Subject: code syntax consistency. Changes << to shl --- docview/src/lzwdecompress.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'docview/src') diff --git a/docview/src/lzwdecompress.pas b/docview/src/lzwdecompress.pas index 5f886f23..0ebba38c 100644 --- a/docview/src/lzwdecompress.pas +++ b/docview/src/lzwdecompress.pas @@ -142,7 +142,7 @@ begin else input_bit_buffer:= input_bit_buffer or - ( longword( 0 ) << ( 24 - input_bit_count ) ); + ( longword( 0 ) shl ( 24 - input_bit_count ) ); inc( bytes_out ); inc( input_bit_count, 8 ); end; -- cgit v1.2.3-70-g09d2 From 45267b49c16de0fd08e21dbfa774332b68dd93dd Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Mon, 8 Apr 2013 18:01:40 +0100 Subject: docview: added lots of keyboard shortcuts --- docview/src/frm_main.pas | 99 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 87 insertions(+), 12 deletions(-) (limited to 'docview/src') diff --git a/docview/src/frm_main.pas b/docview/src/frm_main.pas index b88b9206..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,6 +130,15 @@ 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); @@ -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 @@ -606,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; @@ -3121,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 @@ -3145,8 +3217,10 @@ begin begin Name := 'miBookmarks'; SetPosition(292, 144, 132, 20); - AddMenuItem('Add', '', @btnBookmarkClick); - AddMenuItem('Edit...', '', @miOpenBookmarksMenuClicked); + 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); @@ -3156,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; @@ -3180,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; @@ -3418,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; -- cgit v1.2.3-70-g09d2