lhelp: fixed compilation and cleanup

git-svn-id: trunk@17122 -
This commit is contained in:
vincents 2008-10-24 12:36:38 +00:00
parent 1a9b2d0eed
commit 20f5b2b4ad
4 changed files with 31 additions and 63 deletions

View File

@ -5,7 +5,8 @@ unit chmcontentprovider;
interface interface
uses uses
Classes, SysUtils, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus, Classes, SysUtils,
FileUtil, StdCtrls, ExtCtrls, ComCtrls, Controls, Buttons, Menus,
BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider; BaseContentProvider, FileContentProvider, IpHtml, ChmReader, ChmDataProvider;
type type
@ -95,9 +96,6 @@ begin
end; end;
procedure TChmContentProvider.DoOpenChm(AFile: String); procedure TChmContentProvider.DoOpenChm(AFile: String);
var
Stream: TStream;
Timer: TTimer;
begin begin
if (fChms <> nil) and fChms.IsAnOpenFile(AFile) then Exit; if (fChms <> nil) and fChms.IsAnOpenFile(AFile) then Exit;
DoCloseChm; DoCloseChm;
@ -350,7 +348,7 @@ end;
function TChmContentProvider.GetHistory: TStrings; function TChmContentProvider.GetHistory: TStrings;
begin begin
//Result:=inherited GetHistory; Result:= fHistory;
end; end;
function TChmContentProvider.LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean; function TChmContentProvider.LoadURL(const AURL: String; const AContext: THelpContext=-1): Boolean;

View File

@ -63,7 +63,7 @@ type
function GetDirsParents(ADir: String): TStringList; function GetDirsParents(ADir: String): TStringList;
function DoGetStream(const URL: string): TStream; override; function DoGetStream(const URL: string): TStream; override;
public public
constructor Create(var AChm: TChmFileList); constructor Create(var AChm: TChmFileList); reintroduce;
destructor Destroy; override; destructor Destroy; override;
property Chm: TChmFileList read fChm write fChm; property Chm: TChmFileList read fChm write fChm;
property OnHelpPopup: THelpPopupEvent read fOnHelpPopup write fOnHelpPopup; property OnHelpPopup: THelpPopupEvent read fOnHelpPopup write fOnHelpPopup;
@ -122,55 +122,30 @@ end;
procedure TIpChmDataProvider.DoGetImage(Sender: TIpHtmlNode; const URL: string; procedure TIpChmDataProvider.DoGetImage(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture); var Picture: TPicture);
var var
Stream: TMemoryStream = nil; Stream: TMemoryStream;
ImageClass: TFPCustomImageReaderClass; FileExt: String;
ImageReader: TFPCustomImageReader;
OutImage: TFPWriterBMP= nil;
Img : TFPMemoryImage = nil;
FileExt: String;
begin begin
//DebugLn('Getting Image ',(Url)); //DebugLn('Getting Image ',(Url));
Picture := nil;
FileExt := ExtractFileExt(URL); FileExt := ExtractFileExt(URL);
if FileExt[1] = '.' then Delete(FileExt,1,1);
ImageClass := GetFPImageReaderForFileExtension(FileExt);
if ImageClass <> nil then begin
ImageReader := ImageClass.Create;
try
Picture := TPicture.Create;
Picture.Graphic := TBitmap.Create;
Stream := TMemoryStream(fChm.GetObject('/'+URL));
if Stream = nil then exit;
Img := TFPMemoryImage.Create(0,0);
Img.UsePalette:=False;
Img.LoadFromStream(Stream, ImageReader);
Stream.Free;
Stream := TMemoryStream.Create;
OutImage := TFPWriterBMP.Create;
Img.SaveToStream(Stream, OutImage);
Picture := TPicture.Create;
try
Stream := fChm.GetObject('/'+URL);
if Assigned(Stream) then
begin
Stream.Position := 0; Stream.Position := 0;
Picture.Graphic.LoadFromStream(Stream); Picture.LoadFromStreamWithFileExt(Stream, FileExt);
finally
if Assigned(OutImage) then OutImage.Free;
if Assigned(Img) then Img.Free;
if Assigned(ImageReader) then ImageReader.Free;
if Assigned(Stream) then Stream.Free;
end; end;
end finally
else begin Stream.Free;
// Couldn't find the picture we wanted.
Picture := nil;
end; end;
end; end;
function TIpChmDataProvider.CanHandle(const URL: string): Boolean; function TIpChmDataProvider.CanHandle(const URL: string): Boolean;
var var
HelpFile, HelpFile: String;
Link: String;
begin begin
Result := True; Result := True;
if Pos('Java', URL) =1 then Result := False; if Pos('Java', URL) =1 then Result := False;
@ -188,10 +163,9 @@ end;
function TIpChmDataProvider.BuildURL(const OldURL, NewURL: string): string; function TIpChmDataProvider.BuildURL(const OldURL, NewURL: string): string;
var var
tmp: String; tmp: String;
X: LongInt; X: LongInt;
RelURL: String = ''; fOldUrl: String;
fOldUrl: String;
begin begin
if Pos('ms-its:', OldURL) > 0 then begin if Pos('ms-its:', OldURL) > 0 then begin

View File

@ -1,23 +1,23 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="/"/> <PathDelim Value="\"/>
<Version Value="6"/> <Version Value="6"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/> <TargetFileExt Value=""/>
</General> </General>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)/tools/runwait.sh $(TargetCmdLine)'"/> <LaunchingApplication PathPlusParams="\usr\bin\gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)\tools\runwait.sh $(TargetCmdLine)'"/>
<Display Value="192.168.0.250:0"/> <Display Value="192.168.0.250:0"/>
</local> </local>
</RunParams> </RunParams>
@ -33,7 +33,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item3> </Item3>
</RequiredPackages> </RequiredPackages>
<Units Count="10"> <Units Count="9">
<Unit0> <Unit0>
<Filename Value="lhelp.lpr"/> <Filename Value="lhelp.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -84,21 +84,16 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="HTTPContentProvider"/> <UnitName Value="HTTPContentProvider"/>
</Unit8> </Unit8>
<Unit9>
<Filename Value="../packages/chm/chmpkg.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="chmpkg"/>
</Unit9>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="8"/>
<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\"/>
<SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/> <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/>
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>

View File

@ -22,9 +22,10 @@ unit lhelpcore;
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, SimpleIPC,
Buttons, LCLProc, StdCtrls, IpHtml, ComCtrls, ExtCtrls, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Menus, SimpleIPC, BaseContentProvider, FileContentProvider, ChmContentProvider; Buttons, LCLProc, StdCtrls, IpHtml, ComCtrls, ExtCtrls, Menus,
BaseContentProvider, FileContentProvider, ChmContentProvider;
type type