mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 09:16:13 +02:00
lhelp: fixed compilation and cleanup
git-svn-id: trunk@17122 -
This commit is contained in:
parent
1a9b2d0eed
commit
20f5b2b4ad
@ -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;
|
||||
|
@ -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
|
||||
|
@ -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>
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user