* Fixed most parts of bug #16997

git-svn-id: trunk@26913 -
This commit is contained in:
andrew 2010-07-30 19:40:09 +00:00
parent ee2a4b6481
commit c426de02a7
5 changed files with 55 additions and 7 deletions

View File

@ -303,7 +303,7 @@ begin
exit; exit;
end; end;
fFillingToc := True; fFillingToc := True;
fContentsTree.Visible := False; //fContentsTree.Visible := False;
fContentsPanel.Caption := 'Table of Contents Loading. Please Wait...'; fContentsPanel.Caption := 'Table of Contents Loading. Please Wait...';
Application.ProcessMessages; Application.ProcessMessages;
fChm := TChmReader(Data); fChm := TChmReader(Data);
@ -705,7 +705,7 @@ begin
if (Length(DocURL) > 0) and (DocURL[1] <> '/') then if (Length(DocURL) > 0) and (DocURL[1] <> '/') then
Insert('/', DocURL, 1); Insert('/', DocURL, 1);
if DocTitle = '' then if DocTitle = '' then
Doctitle := 'untitled'; DocTitle := 'untitled';
ListItem := fSearchResults.Items.Add; ListItem := fSearchResults.Items.Add;
ListItem.Caption := DocTitle; ListItem.Caption := DocTitle;
ListItem.Data := fChms.Chm[i]; ListItem.Data := fChms.Chm[i];

View File

@ -97,6 +97,7 @@
<PathDelim Value="\"/> <PathDelim Value="\"/>
<SearchPaths> <SearchPaths>
<Libraries Value="\emul\linux\x86\lib\;\emul\linux\x86\usr\lib32\"/> <Libraries Value="\emul\linux\x86\lib\;\emul\linux\x86\usr\lib32\"/>
<OtherUnitFiles Value="..\..\..\..\fpc\packages\chm\src\"/>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/> <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>

View File

@ -26,7 +26,7 @@ uses
Controls, Controls,
Dialogs, Dialogs,
Forms Forms
{ add your units here }, TurboPowerIPro, chmpopup, lhelpcontrolpkg, lhelpcore; { add your units here }, SimpleIPC, TurboPowerIPro, chmpopup, lhelpcontrolpkg, lhelpcore;
var var
X: Integer; X: Integer;
@ -60,6 +60,15 @@ begin
end; end;
Application.CreateForm(THelpForm, HelpForm); Application.CreateForm(THelpForm, HelpForm);
Application.CreateForm(THelpPopupForm, HelpPopupForm); Application.CreateForm(THelpPopupForm, HelpPopupForm);
try
Application.Run; Application.Run;
except
// try to remove stale names pipes so that a new instance can use them
if IPCServer <> nil then
try
FreeAndNil(IPCServer);
except
end;
end;
end. end.

View File

@ -5,7 +5,7 @@ object HelpForm: THelpForm
Width = 758 Width = 758
ActiveControl = Panel1 ActiveControl = Panel1
Caption = 'LHelp' Caption = 'LHelp'
ClientHeight = 515 ClientHeight = 512
ClientWidth = 758 ClientWidth = 758
Icon.Data = { Icon.Data = {
7E04000000000100010010100000010020006804000016000000280000001000 7E04000000000100010010100000010020006804000016000000280000001000
@ -49,9 +49,11 @@ object HelpForm: THelpForm
Menu = MainMenu1 Menu = MainMenu1
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnKeyUp = FormKeyUp
Position = poScreenCenter Position = poScreenCenter
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '0.9.29' LCLVersion = '0.9.29'
Visible = True
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 32 Height = 32
@ -242,7 +244,7 @@ object HelpForm: THelpForm
end end
object PageControl: TPageControl object PageControl: TPageControl
Left = 0 Left = 0
Height = 483 Height = 503
Top = 32 Top = 32
Width = 758 Width = 758
Align = alClient Align = alClient

View File

@ -30,7 +30,7 @@ interface
uses uses
Classes, SysUtils, SimpleIPC, Classes, SysUtils, SimpleIPC,
FileUtil, LResources, Forms, Controls, Graphics, Dialogs, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Buttons, LCLProc, StdCtrls, IpHtml, ComCtrls, ExtCtrls, Menus, Buttons, LCLProc, StdCtrls, IpHtml, ComCtrls, ExtCtrls, Menus, LCLType,
BaseContentProvider, FileContentProvider, ChmContentProvider{$IFDEF USE_LNET}, HTTPContentProvider{$ENDIF}; BaseContentProvider, FileContentProvider, ChmContentProvider{$IFDEF USE_LNET}, HTTPContentProvider{$ENDIF};
type type
@ -78,6 +78,7 @@ type
procedure FileMenuOpenURLItemClick(Sender: TObject); procedure FileMenuOpenURLItemClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ForwardToolBtnClick(Sender: TObject); procedure ForwardToolBtnClick(Sender: TObject);
procedure HomeToolBtnClick(Sender: TObject); procedure HomeToolBtnClick(Sender: TObject);
procedure PageControlChange(Sender: TObject); procedure PageControlChange(Sender: TObject);
@ -101,6 +102,7 @@ type
function ActivePage: TContentTab; function ActivePage: TContentTab;
procedure RefreshState; procedure RefreshState;
procedure ShowError(AError: String); procedure ShowError(AError: String);
procedure SetKeyUp(AControl: TControl);
public public
{ public declarations } { public declarations }
end; end;
@ -108,6 +110,7 @@ type
var var
HelpForm: THelpForm; HelpForm: THelpForm;
IPCServer: TSimpleIPCServer;
const INVALID_FILE_TYPE = 1; const INVALID_FILE_TYPE = 1;
implementation implementation
@ -188,6 +191,8 @@ end;
procedure THelpForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure THelpForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin begin
Visible:= False;
Application.ProcessMessages;
FileMenuCloseItemClick(Sender); FileMenuCloseItemClick(Sender);
StopServer; StopServer;
end; end;
@ -200,6 +205,15 @@ begin
StartServer(fServerName); StartServer(fServerName);
end; end;
RefreshState; RefreshState;
SetKeyUp(Self);
end;
procedure THelpForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key = VK_ESCAPE then
Close;
end; end;
procedure THelpForm.ForwardToolBtnClick(Sender: TObject); procedure THelpForm.ForwardToolBtnClick(Sender: TObject);
@ -344,6 +358,8 @@ begin
fInputIPC.ServerID := ServerName; fInputIPC.ServerID := ServerName;
fInputIPC.Global := True; fInputIPC.Global := True;
fInputIPC.Active := True; fInputIPC.Active := True;
IPCServer := fInputIPC;
fServerTimer := TTimer.Create(nil); fServerTimer := TTimer.Create(nil);
fServerTimer.OnTimer := @ServerMessage; fServerTimer.OnTimer := @ServerMessage;
fServerTimer.Interval := 200; fServerTimer.Interval := 200;
@ -362,6 +378,7 @@ begin
fInputIPC.Active := False; fInputIPC.Active := False;
FreeAndNil(fInputIPC); FreeAndNil(fInputIPC);
IPCServer := nil;
FreeAndNil(fServerTimer); FreeAndNil(fServerTimer);
end; end;
@ -415,7 +432,7 @@ begin
fNewPage := TContentTab.Create(PageControl); fNewPage := TContentTab.Create(PageControl);
fNewPage.ContentProvider := fRealContentProvider.Create(fNewPage, ImageList1); fNewPage.ContentProvider := fRealContentProvider.Create(fNewPage, ImageList1);
fNewPage.Parent := PageControl; fNewPage.Parent := PageControl;
SetKeyUp(fNewPage);
ShowOnTop; ShowOnTop;
if fNewPage.ContentProvider.LoadURL(AURL, AContext) then if fNewPage.ContentProvider.LoadURL(AURL, AContext) then
@ -463,6 +480,18 @@ begin
ShowMessage(AError); ShowMessage(AError);
end; end;
procedure THelpForm.SetKeyUp(AControl: TControl);
var
WCont: TWinControl absolute AControl;
i: Integer;
begin
if (AControl = nil) or not (AControl.InheritsFrom(TWinControl)) then
Exit;
for i := 0 to WCont.ControlCount-1 do
SetKeyUp(WCont.Controls[i]);
WCont.OnKeyUp:=@FormKeyUp;
end;
{ TContentTab } { TContentTab }
constructor TContentTab.Create(AOwner: TComponent); constructor TContentTab.Create(AOwner: TComponent);
@ -476,5 +505,12 @@ begin
inherited Destroy; inherited Destroy;
end; end;
finalization
if IPCServer <> nil then
try
FreeAndNil(IPCServer);
except
end;
end. end.