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

View File

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

View File

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

View File

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