You've already forked lazarus-ccr
fpbrowser: Moves the browser viewer to an isolated module, to support multiple viewers and starts preparing the ground for tabbed browsing
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1935 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
119
applications/fpbrowser/browserviewer.pas
Normal file
119
applications/fpbrowser/browserviewer.pas
Normal file
@ -0,0 +1,119 @@
|
||||
unit browserviewer;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Controls, Forms, Graphics,
|
||||
//
|
||||
pageloader;
|
||||
|
||||
type
|
||||
|
||||
{ TBrowserViewer }
|
||||
|
||||
TBrowserViewer = class
|
||||
public
|
||||
MyPageLoaderThread: TPageLoaderThread;
|
||||
MyPageLoader: TPageLoader;
|
||||
CurrentTab: Integer;
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
procedure CreateViewer(AParent, AOwner: TWinControl); virtual; abstract;
|
||||
procedure LoadFromFile(AFilename: string); virtual; abstract;
|
||||
procedure LoadFromURL(AURL: string); virtual;
|
||||
function GetDocumentTitle: string; virtual; abstract;
|
||||
procedure SetShowImages(AValue: Boolean); virtual; abstract;
|
||||
procedure HandlePageLoaderTerminated(Sender: TObject); virtual;
|
||||
end;
|
||||
|
||||
TBrowserViewerClass = class of TBrowserViewer;
|
||||
|
||||
procedure SetBrowserViewerClass(AViewerClass: TBrowserViewerClass);
|
||||
function GetBrowserViewer(AIndex: Integer): TBrowserViewer;
|
||||
function GetCurrentBrowserViewer: TBrowserViewer;
|
||||
procedure SetCurrentBrowserViewer(AIndex: Integer);
|
||||
function AddBrowserViewer(): TBrowserViewer;
|
||||
procedure RemoveBrowserViewer(AIndex: Integer);
|
||||
function GetBrowerViewerCount: Integer;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
gBrowserViewerClass: TBrowserViewerClass;
|
||||
gBrowserViewers: TFPList;
|
||||
gCurrentViewer: Integer;
|
||||
|
||||
procedure SetBrowserViewerClass(AViewerClass: TBrowserViewerClass);
|
||||
begin
|
||||
gBrowserViewerClass := AViewerClass;
|
||||
end;
|
||||
|
||||
function GetBrowserViewer(AIndex: Integer): TBrowserViewer;
|
||||
begin
|
||||
Result := gBrowserViewers.Items[AIndex];
|
||||
end;
|
||||
|
||||
function GetCurrentBrowserViewer: TBrowserViewer;
|
||||
begin
|
||||
Result := GetBrowserViewer(gCurrentViewer);
|
||||
end;
|
||||
|
||||
procedure SetCurrentBrowserViewer(AIndex: Integer);
|
||||
begin
|
||||
gCurrentViewer := AIndex;
|
||||
end;
|
||||
|
||||
function AddBrowserViewer(): TBrowserViewer;
|
||||
begin
|
||||
Result := gBrowserViewerClass.Create();
|
||||
gBrowserViewers.Add(Result);
|
||||
end;
|
||||
|
||||
procedure RemoveBrowserViewer(AIndex: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function GetBrowerViewerCount: Integer;
|
||||
begin
|
||||
Result := gBrowserViewers.Count;
|
||||
end;
|
||||
|
||||
{ TBrowserViewer }
|
||||
|
||||
constructor TBrowserViewer.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
MyPageLoader := TPageLoader.Create;
|
||||
end;
|
||||
|
||||
destructor TBrowserViewer.Destroy;
|
||||
begin
|
||||
MyPageLoader.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TBrowserViewer.LoadFromURL(AURL: string);
|
||||
begin
|
||||
MyPageLoaderThread := TPageLoaderThread.Create(True);
|
||||
MyPageLoaderThread.URL := AURL;
|
||||
MyPageLoaderThread.PageLoader := MyPageLoader;
|
||||
// MyPageLoaderThread.OnPageLoadProgress := @HandlePageLoaderProgress;
|
||||
MyPageLoaderThread.OnTerminate := HandlePageLoaderTerminated;
|
||||
MyPageLoaderThread.FreeOnTerminate := True;
|
||||
MyPageLoaderThread.Resume;
|
||||
end;
|
||||
|
||||
procedure TBrowserViewer.HandlePageLoaderTerminated(Sender: TObject);
|
||||
begin
|
||||
end;
|
||||
|
||||
initialization
|
||||
gBrowserViewers := TFPList.Create;
|
||||
finalization
|
||||
gBrowserViewers.Free;
|
||||
end.
|
||||
|
||||
@ -1,5 +1,8 @@
|
||||
program fpbrowser;
|
||||
|
||||
{$define FPBROWSER_TURBOPOWERIPRO}
|
||||
{.$define FPBROWSER_THTMLCOMP}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
@ -15,7 +18,14 @@ uses
|
||||
Gopage in 'Gopage.pas' {GoPageForm},
|
||||
PrintStatusForm in 'PrintStatusForm.pas' {PrnStatusForm},
|
||||
*)
|
||||
ImgForm in 'ImgForm.pas', pageloader, browsermodules {ImageForm};
|
||||
ImgForm in 'ImgForm.pas', pageloader, browsermodules,
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
viewer_thtmlcomp,
|
||||
{$endif}
|
||||
{$ifdef FPBROWSER_TURBOPOWERIPRO}
|
||||
viewer_ipro,
|
||||
{$endif}
|
||||
browserviewer;
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
|
||||
@ -44,7 +44,7 @@
|
||||
<PackageName Value="LCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="7">
|
||||
<Units Count="10">
|
||||
<Unit0>
|
||||
<Filename Value="fpbrowser.dpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -86,6 +86,21 @@
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="browsermodules"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="browserviewer.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="browserviewer"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="viewer_thtmlcomp.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="viewer_thtmlcomp"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="viewer_ipro.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="viewer_ipro"/>
|
||||
</Unit9>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -3,7 +3,7 @@ object formBrowser: TformBrowser
|
||||
Height = 439
|
||||
Top = 186
|
||||
Width = 621
|
||||
ClientHeight = 412
|
||||
ClientHeight = 439
|
||||
ClientWidth = 621
|
||||
Color = clBtnFace
|
||||
Font.Color = clWindowText
|
||||
@ -18,7 +18,7 @@ object formBrowser: TformBrowser
|
||||
object panelBottom: TPanel
|
||||
Left = 0
|
||||
Height = 18
|
||||
Top = 394
|
||||
Top = 421
|
||||
Width = 621
|
||||
Align = alBottom
|
||||
Alignment = taLeftJustify
|
||||
@ -39,7 +39,7 @@ object formBrowser: TformBrowser
|
||||
Left = 319
|
||||
Height = 16
|
||||
Top = 3
|
||||
Width = 21
|
||||
Width = 22
|
||||
Caption = 'Idle'
|
||||
ParentColor = False
|
||||
end
|
||||
@ -96,62 +96,11 @@ object formBrowser: TformBrowser
|
||||
end
|
||||
object pageBrowser: TPageControl
|
||||
Left = 0
|
||||
Height = 361
|
||||
Height = 388
|
||||
Top = 33
|
||||
Width = 621
|
||||
ActivePage = tabBrowser
|
||||
Align = alClient
|
||||
ShowTabs = False
|
||||
TabIndex = 0
|
||||
TabOrder = 2
|
||||
object tabBrowser: TTabSheet
|
||||
Caption = 'Browser'
|
||||
ClientHeight = 359
|
||||
ClientWidth = 619
|
||||
object panelBrowser: TPanel
|
||||
Left = 0
|
||||
Height = 359
|
||||
Top = 0
|
||||
Width = 619
|
||||
Align = alClient
|
||||
BevelInner = bvLowered
|
||||
BevelOuter = bvNone
|
||||
Caption = 'panelBrowser'
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object tabDebug: TTabSheet
|
||||
Caption = 'Debug'
|
||||
ClientHeight = 359
|
||||
ClientWidth = 619
|
||||
object memoDebug: TMemo
|
||||
Left = 0
|
||||
Height = 359
|
||||
Top = 0
|
||||
Width = 619
|
||||
Align = alClient
|
||||
Lines.Strings = (
|
||||
'memoDebug'
|
||||
)
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object tabSource: TTabSheet
|
||||
Caption = 'Source'
|
||||
ClientHeight = 359
|
||||
ClientWidth = 619
|
||||
object memoSource: TMemo
|
||||
Left = 0
|
||||
Height = 359
|
||||
Top = 0
|
||||
Width = 619
|
||||
Align = alClient
|
||||
Lines.Strings = (
|
||||
'memoSource'
|
||||
)
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
object OpenDialog: TOpenDialog
|
||||
DefaultExt = '.htm'
|
||||
|
||||
@ -2,17 +2,17 @@
|
||||
|
||||
LazarusResources.Add('TformBrowser','FORMDATA',[
|
||||
'TPF0'#12'TformBrowser'#11'formBrowser'#4'Left'#3'G'#1#6'Height'#3#183#1#3'To'
|
||||
+'p'#3#186#0#5'Width'#3'm'#2#12'ClientHeight'#3#156#1#11'ClientWidth'#3'm'#2#5
|
||||
+'p'#3#186#0#5'Width'#3'm'#2#12'ClientHeight'#3#183#1#11'ClientWidth'#3'm'#2#5
|
||||
+'Color'#7#9'clBtnFace'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2
|
||||
+#243#9'Font.Name'#6#5'Arial'#4'Menu'#7#8'MainMenu'#8'OnCreate'#7#10'FormCrea'
|
||||
+'te'#9'OnDestroy'#7#11'FormDestroy'#6'OnShow'#7#8'FormShow'#8'Position'#7#14
|
||||
+'poScreenCenter'#10'LCLVersion'#6#6'0.9.31'#0#6'TPanel'#11'panelBottom'#4'Le'
|
||||
+'ft'#2#0#6'Height'#2#18#3'Top'#3#138#1#5'Width'#3'm'#2#5'Align'#7#8'alBottom'
|
||||
+'ft'#2#0#6'Height'#2#18#3'Top'#3#165#1#5'Width'#3'm'#2#5'Align'#7#8'alBottom'
|
||||
+#9'Alignment'#7#13'taLeftJustify'#10'BevelInner'#7#9'bvLowered'#10'BevelOute'
|
||||
+'r'#7#6'bvNone'#12'ClientHeight'#2#18#11'ClientWidth'#3'm'#2#8'TabOrder'#2#0
|
||||
+#0#12'TProgressBar'#11'ProgressBar'#4'Left'#3#214#1#6'Height'#2#16#3'Top'#2#1
|
||||
+#5'Width'#3#150#0#5'Align'#7#7'alRight'#8'TabOrder'#2#0#0#0#6'TLabel'#13'lab'
|
||||
+'elProgress'#4'Left'#3'?'#1#6'Height'#2#16#3'Top'#2#3#5'Width'#2#21#7'Captio'
|
||||
+'elProgress'#4'Left'#3'?'#1#6'Height'#2#16#3'Top'#2#3#5'Width'#2#22#7'Captio'
|
||||
+'n'#6#4'Idle'#11'ParentColor'#8#0#0#0#6'TPanel'#8'panelTop'#4'Left'#2#0#6'He'
|
||||
+'ight'#2'!'#3'Top'#2#0#5'Width'#3'm'#2#5'Align'#7#5'alTop'#10'BevelOuter'#7#6
|
||||
+'bvNone'#12'ClientHeight'#2'!'#11'ClientWidth'#3'm'#2#8'TabOrder'#2#1#0#5'TE'
|
||||
@ -25,58 +25,46 @@ LazarusResources.Add('TformBrowser','FORMDATA',[
|
||||
+'ck'#8'TabOrder'#2#1#0#0#7'TButton'#13'buttonForward'#4'Left'#3#128#0#6'Heig'
|
||||
+'ht'#2#24#3'Top'#2#4#5'Width'#2';'#7'Caption'#6#8'&Forward'#7'Enabled'#8#7'O'
|
||||
+'nClick'#7#12'FwdBackClick'#8'TabOrder'#2#2#0#0#0#12'TPageControl'#11'pageBr'
|
||||
+'owser'#4'Left'#2#0#6'Height'#3'i'#1#3'Top'#2'!'#5'Width'#3'm'#2#10'ActivePa'
|
||||
+'ge'#7#10'tabBrowser'#5'Align'#7#8'alClient'#8'ShowTabs'#8#8'TabIndex'#2#0#8
|
||||
+'TabOrder'#2#2#0#9'TTabSheet'#10'tabBrowser'#7'Caption'#6#7'Browser'#12'Clie'
|
||||
+'ntHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#6'TPanel'#12'panelBrowser'#4'Left'
|
||||
+#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3'k'#2#5'Align'#7#8'alClient'#10'B'
|
||||
+'evelInner'#7#9'bvLowered'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#12'panelB'
|
||||
+'rowser'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tabDebug'#7'Caption'#6#5'Debug'
|
||||
+#12'ClientHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#5'TMemo'#9'memoDebug'#4'Le'
|
||||
+'ft'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3'k'#2#5'Align'#7#8'alClient'
|
||||
+#13'Lines.Strings'#1#6#9'memoDebug'#0#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#9't'
|
||||
+'abSource'#7'Caption'#6#6'Source'#12'ClientHeight'#3'g'#1#11'ClientWidth'#3
|
||||
+'k'#2#0#5'TMemo'#10'memoSource'#4'Left'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Wi'
|
||||
+'dth'#3'k'#2#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#10'memoSource'#0#8
|
||||
+'TabOrder'#2#0#0#0#0#0#11'TOpenDialog'#10'OpenDialog'#10'DefaultExt'#6#4'.ht'
|
||||
+'m'#6'Filter'#6'%html files|*.htm;*.html|all files|*.*'#7'Options'#11#14'ofH'
|
||||
+'ideReadOnly'#15'ofPathMustExist'#15'ofFileMustExist'#0#4'left'#3'I'#1#3'top'
|
||||
+#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3'#'#1#3'top'#2#4#0#9'TMenuItem'#5
|
||||
+'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'Open'#7'Caption'#6#5'&Open'#8
|
||||
+'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0#0#9'TMenuItem'#12'OpenTextF'
|
||||
+'ile'#7'Caption'#6#15'Open &Text File'#7'OnClick'#7#17'OpenTextFileClick'#0#0
|
||||
+#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16'Open &Image File'#7'OnClick'
|
||||
+#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'PrinterSetup1'#7'Caption'#6#16
|
||||
+'Printer Setup...'#7'OnClick'#7#18'PrinterSetup1Click'#0#0#9'TMenuItem'#12'P'
|
||||
+'rintpreview'#7'Caption'#6#14'Print pre&view'#7'Enabled'#8#7'OnClick'#7#17'P'
|
||||
+'rintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7'Caption'#6#9'&Print...'#7'En'
|
||||
+'abled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1
|
||||
+'-'#0#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'E&xit'#7'OnClick'#7#10'Exit1Cli'
|
||||
+'ck'#0#0#0#9'TMenuItem'#5'Edit2'#7'Caption'#6#5'&Edit'#7'OnClick'#7#10'Edit2'
|
||||
+'Click'#0#9'TMenuItem'#5'Find1'#7'Caption'#6#5'&Find'#7'Enabled'#8#7'OnClick'
|
||||
+#7#10'Find1Click'#0#0#9'TMenuItem'#8'CopyItem'#7'Caption'#6#5'&Copy'#8'Short'
|
||||
+'Cut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9'TMenuItem'#2'N2'#7'Caption'
|
||||
+#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Caption'#6#11'Select &All'#7'En'
|
||||
+'abled'#8#7'OnClick'#7#18'SelectAllItemClick'#0#0#0#9'TMenuItem'#8'options1'
|
||||
+#7'Caption'#6#6'&Tools'#0#9'TMenuItem'#10'ShowImages'#7'Caption'#6#12'&Show '
|
||||
+'images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMenuItem'#5'Fonts'#7'Captio'
|
||||
+'n'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'FontColorsClick'#0#0#9'TMe'
|
||||
+'nuItem'#13'menuViewDebug'#7'Caption'#6#26'View Source and Debug info'#7'OnC'
|
||||
+'lick'#7#18'menuViewDebugClick'#0#0#0#9'TMenuItem'#15'HistoryMenuItem'#7'Cap'
|
||||
+'tion'#6#8'&History'#7'Visible'#8#0#0#9'TMenuItem'#6'About1'#7'Caption'#6#6
|
||||
+'&About'#7'OnClick'#7#11'About1Click'#0#0#0#12'TPrintDialog'#11'PrintDialog'
|
||||
,#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7'Options'#11#10'poPageN'
|
||||
+'ums'#0#6'ToPage'#2#1#4'left'#3'j'#1#3'top'#2#1#0#0#11'TFindDialog'#10'FindD'
|
||||
+'ialog'#7'Options'#11#6'frDown'#15'frHideWholeWord'#18'frDisableWholeWord'#0
|
||||
+#6'OnFind'#7#14'FindDialogFind'#4'left'#3#248#0#3'top'#2#4#0#0#10'TPopupMenu'
|
||||
+#9'PopupMenu'#4'left'#3#144#1#3'top'#2#1#0#9'TMenuItem'#9'Viewimage'#7'Capti'
|
||||
+'on'#6#11'&View image'#7'OnClick'#7#14'ViewimageClick'#0#0#9'TMenuItem'#20'C'
|
||||
+'opyImageToClipboard'#7'Caption'#6#24'&Copy image to clipboard'#7'OnClick'#7
|
||||
+#25'CopyImageToClipboardClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'#6#1'-'#0#0#9
|
||||
+'TMenuItem'#15'OpenInNewWindow'#7'Caption'#6#19'&Open in new window'#7'OnCli'
|
||||
+'ck'#7#20'OpenInNewWindowClick'#0#0#0#6'TTimer'#9'MetaTimer'#7'Enabled'#8#7
|
||||
+'OnTimer'#7#14'MetaTimerTimer'#4'left'#3#242#0#3'top'#2'K'#0#0#6'TTimer'#6'T'
|
||||
+'imer1'#8'Interval'#3#200#0#7'OnTimer'#7#11'Timer1Timer'#4'left'#3'0'#1#3'to'
|
||||
+'p'#2'G'#0#0#19'TPrinterSetupDialog'#18'PrinterSetupDialog'#4'left'#3#192#1#0
|
||||
+#0#0
|
||||
+'owser'#4'Left'#2#0#6'Height'#3#132#1#3'Top'#2'!'#5'Width'#3'm'#2#5'Align'#7
|
||||
+#8'alClient'#8'TabOrder'#2#2#0#0#11'TOpenDialog'#10'OpenDialog'#10'DefaultEx'
|
||||
+'t'#6#4'.htm'#6'Filter'#6'%html files|*.htm;*.html|all files|*.*'#7'Options'
|
||||
+#11#14'ofHideReadOnly'#15'ofPathMustExist'#15'ofFileMustExist'#0#4'left'#3'I'
|
||||
+#1#3'top'#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3'#'#1#3'top'#2#4#0#9'TMe'
|
||||
+'nuItem'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'Open'#7'Caption'#6#5
|
||||
+'&Open'#8'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0#0#9'TMenuItem'#12
|
||||
+'OpenTextFile'#7'Caption'#6#15'Open &Text File'#7'OnClick'#7#17'OpenTextFile'
|
||||
+'Click'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16'Open &Image File'
|
||||
+#7'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'PrinterSetup1'#7'Ca'
|
||||
+'ption'#6#16'Printer Setup...'#7'OnClick'#7#18'PrinterSetup1Click'#0#0#9'TMe'
|
||||
+'nuItem'#12'Printpreview'#7'Caption'#6#14'Print pre&view'#7'Enabled'#8#7'OnC'
|
||||
+'lick'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7'Caption'#6#9'&Pr'
|
||||
+'int...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMenuItem'#2'N1'#7
|
||||
+'Caption'#6#1'-'#0#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'E&xit'#7'OnClick'#7
|
||||
+#10'Exit1Click'#0#0#0#9'TMenuItem'#5'Edit2'#7'Caption'#6#5'&Edit'#7'OnClick'
|
||||
+#7#10'Edit2Click'#0#9'TMenuItem'#5'Find1'#7'Caption'#6#5'&Find'#7'Enabled'#8
|
||||
+#7'OnClick'#7#10'Find1Click'#0#0#9'TMenuItem'#8'CopyItem'#7'Caption'#6#5'&Co'
|
||||
+'py'#8'ShortCut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9'TMenuItem'#2'N2'
|
||||
+#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Caption'#6#11'Select'
|
||||
+' &All'#7'Enabled'#8#7'OnClick'#7#18'SelectAllItemClick'#0#0#0#9'TMenuItem'#8
|
||||
+'options1'#7'Caption'#6#6'&Tools'#0#9'TMenuItem'#10'ShowImages'#7'Caption'#6
|
||||
+#12'&Show images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMenuItem'#5'Fonts'
|
||||
+#7'Caption'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'FontColorsClick'#0
|
||||
+#0#9'TMenuItem'#13'menuViewDebug'#7'Caption'#6#26'View Source and Debug info'
|
||||
+#7'OnClick'#7#18'menuViewDebugClick'#0#0#0#9'TMenuItem'#15'HistoryMenuItem'#7
|
||||
+'Caption'#6#8'&History'#7'Visible'#8#0#0#9'TMenuItem'#6'About1'#7'Caption'#6
|
||||
+#6'&About'#7'OnClick'#7#11'About1Click'#0#0#0#12'TPrintDialog'#11'PrintDialo'
|
||||
+'g'#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7'Options'#11#10'poPa'
|
||||
+'geNums'#0#6'ToPage'#2#1#4'left'#3'j'#1#3'top'#2#1#0#0#11'TFindDialog'#10'Fi'
|
||||
+'ndDialog'#7'Options'#11#6'frDown'#15'frHideWholeWord'#18'frDisableWholeWord'
|
||||
+#0#6'OnFind'#7#14'FindDialogFind'#4'left'#3#248#0#3'top'#2#4#0#0#10'TPopupMe'
|
||||
+'nu'#9'PopupMenu'#4'left'#3#144#1#3'top'#2#1#0#9'TMenuItem'#9'Viewimage'#7'C'
|
||||
+'aption'#6#11'&View image'#7'OnClick'#7#14'ViewimageClick'#0#0#9'TMenuItem'
|
||||
+#20'CopyImageToClipboard'#7'Caption'#6#24'&Copy image to clipboard'#7'OnClic'
|
||||
+'k'#7#25'CopyImageToClipboardClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'#6#1'-'
|
||||
+#0#0#9'TMenuItem'#15'OpenInNewWindow'#7'Caption'#6#19'&Open in new window'#7
|
||||
+'OnClick'#7#20'OpenInNewWindowClick'#0#0#0#6'TTimer'#9'MetaTimer'#7'Enabled'
|
||||
+#8#7'OnTimer'#7#14'MetaTimerTimer'#4'left'#3#242#0#3'top'#2'K'#0#0#6'TTimer'
|
||||
+#6'Timer1'#8'Interval'#3#200#0#7'OnTimer'#7#11'Timer1Timer'#4'left'#3'0'#1#3
|
||||
,'top'#2'G'#0#0#19'TPrinterSetupDialog'#18'PrinterSetupDialog'#4'left'#3#192#1
|
||||
+#0#0#0
|
||||
]);
|
||||
|
||||
@ -1,7 +1,5 @@
|
||||
unit mainform;
|
||||
|
||||
{$define FPBROWSER_TURBOPOWERIPRO}
|
||||
{.$define FPBROWSER_THTMLCOMP}
|
||||
|
||||
interface
|
||||
|
||||
@ -12,32 +10,16 @@ uses
|
||||
PrintersDlgs,
|
||||
ComCtrls,
|
||||
{$IFDEF MSWINDOWS} ShellAPI, {$ELSE} Unix, {$ENDIF}
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
HtmlMisc, HTMLsubs, Htmlview, HTMLun2,
|
||||
{$endif}
|
||||
{$ifdef FPBROWSER_TURBOPOWERIPRO}
|
||||
IPHtml, Ipfilebroker, IpMsg,
|
||||
{$endif}
|
||||
HTMLabt,
|
||||
pageloader;
|
||||
pageloader,
|
||||
browserviewer;
|
||||
|
||||
type
|
||||
|
||||
{$ifdef FPBROWSER_TURBOPOWERIPRO}
|
||||
{ TMyIpHtmlDataProvider }
|
||||
|
||||
TMyIpHtmlDataProvider = class(TIpHtmlDataProvider)
|
||||
protected
|
||||
function DoGetStream(const URL: string): TStream; override;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{ TformBrowser }
|
||||
|
||||
TformBrowser = class(TForm)
|
||||
labelProgress: TLabel;
|
||||
memoSource: TMemo;
|
||||
memoDebug: TMemo;
|
||||
menuViewDebug: TMenuItem;
|
||||
N1: TMenuItem;
|
||||
OpenDialog: TOpenDialog;
|
||||
@ -48,7 +30,6 @@ type
|
||||
File1: TMenuItem;
|
||||
Open: TMenuItem;
|
||||
options1: TMenuItem;
|
||||
panelBrowser: TPanel;
|
||||
ShowImages: TMenuItem;
|
||||
Fonts: TMenuItem;
|
||||
editURL: TEdit;
|
||||
@ -69,9 +50,6 @@ type
|
||||
OpenImageFile: TMenuItem;
|
||||
PopupMenu: TPopupMenu;
|
||||
CopyImageToClipboard: TMenuItem;
|
||||
tabBrowser: TTabSheet;
|
||||
tabDebug: TTabSheet;
|
||||
tabSource: TTabSheet;
|
||||
Viewimage: TMenuItem;
|
||||
N3: TMenuItem;
|
||||
OpenInNewWindow: TMenuItem;
|
||||
@ -108,8 +86,6 @@ type
|
||||
procedure OpenImageFileClick(Sender: TObject);
|
||||
procedure CopyImageToClipboardClick(Sender: TObject);
|
||||
procedure ObjectClick(Sender, Obj: TObject; const OnClick: String);
|
||||
procedure ViewerImageRequest(Sender: TObject; const SRC: string;
|
||||
var Stream: TMemoryStream);
|
||||
procedure ViewimageClick(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure ViewerInclude(Sender: TObject; const Command: String;
|
||||
@ -139,47 +115,11 @@ type
|
||||
procedure DropFiles( Sender : TObject;
|
||||
const FileNames: array of string);
|
||||
procedure CloseAll;
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
private
|
||||
Viewer: THTMLViewer;
|
||||
FoundObject: TImageObj;
|
||||
procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||
Y: Integer);
|
||||
procedure ViewerProgress(Sender: TObject; Stage: TProgressStage;
|
||||
PercentDone: Integer);
|
||||
procedure ViewerPrintHTMLFooter(Sender: TObject; HFViewer: THTMLViewer;
|
||||
NumPage: Integer; LastPage: Boolean; var XL, XR: Integer;
|
||||
var StopPrinting: Boolean);
|
||||
procedure ViewerPrintHTMLHeader(Sender: TObject; HFViewer: THTMLViewer;
|
||||
NumPage: Integer; LastPage: Boolean; var XL, XR: Integer;
|
||||
var StopPrinting: Boolean);
|
||||
procedure HotSpotChange(Sender: TObject; const URL: string);
|
||||
procedure HotSpotClick(Sender: TObject; const URL: string;
|
||||
var Handled: boolean);
|
||||
procedure RightClick(Sender: TObject;
|
||||
Parameters: TRightClickParameters);
|
||||
{$endif}
|
||||
{$ifdef FPBROWSER_TURBOPOWERIPRO}
|
||||
private
|
||||
IpHtmlPanel1: TIpHtmlPanel;
|
||||
DataProvider1: TMyIpHtmlDataProvider;
|
||||
function DataProvider1CanHandle(Sender: TObject; const URL: string
|
||||
): Boolean;
|
||||
procedure DataProvider1CheckURL(Sender: TObject; const URL: string;
|
||||
var Available: Boolean; var ContentType: string);
|
||||
procedure DataProvider1GetHtml(Sender: TObject; const URL: string;
|
||||
const PostData: TIpFormDataEntity; var Stream: TStream);
|
||||
procedure DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string;
|
||||
var Picture: TPicture);
|
||||
procedure DataProvider1Leave(Sender: TIpHtml);
|
||||
procedure DataProvider1ReportReference(Sender: TObject; const URL: string);
|
||||
procedure ShowHTML(Src: string);
|
||||
{$endif}
|
||||
public
|
||||
{ Public declarations }
|
||||
MyPageLoaderThread: TPageLoaderThread;
|
||||
MyPageLoader: TPageLoader;
|
||||
CurrentTab: Integer;
|
||||
procedure LoadURL(AURL: string);
|
||||
procedure AddBrowserTab(AURL: string; AGoToTab: Boolean);
|
||||
procedure AddURLToHistory(AURL: string);
|
||||
procedure HandlePageLoaderProgress(APercent: Integer);
|
||||
procedure HandlePageLoaderTerminated(Sender: TObject);
|
||||
@ -193,181 +133,13 @@ implementation
|
||||
uses
|
||||
Submit, ImgForm;//, FontDlg;
|
||||
|
||||
{$ifdef FPBROWSER_TURBOPOWERIPRO}
|
||||
function TMyIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
|
||||
var
|
||||
ms: TMemoryStream;
|
||||
begin
|
||||
Result:=nil;
|
||||
WriteLn('TMyIpHtmlDataProvider.DoGetStream '+URL);
|
||||
|
||||
if URL='fpdoc.css' then begin
|
||||
//debugln(['TMyIpHtmlDataProvider.DoGetStream ',FileExists(URL)]);
|
||||
ms:=TMemoryStream.Create;
|
||||
try
|
||||
ms.LoadFromFile(URL);
|
||||
ms.Position:=0;
|
||||
except
|
||||
ms.Free;
|
||||
end;
|
||||
Result:=ms;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TformBrowser.DataProvider1CanHandle(Sender: TObject; const URL: string
|
||||
): Boolean;
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1CanHandle ',URL);
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
procedure TformBrowser.DataProvider1CheckURL(Sender: TObject; const URL: string;
|
||||
var Available: Boolean; var ContentType: string);
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1CheckURL ',URL);
|
||||
Available:=True;
|
||||
ContentType:='text/html';
|
||||
end;
|
||||
|
||||
procedure TformBrowser.DataProvider1GetHtml(Sender: TObject; const URL: string;
|
||||
const PostData: TIpFormDataEntity; var Stream: TStream);
|
||||
var
|
||||
lStream: TMemoryStream;
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1GetHtml ',URL);
|
||||
{ MyPageLoader.LoadBinaryResource(URL, lStream);
|
||||
Stream := lStream;
|
||||
lStream.Position := 0;}
|
||||
Stream := nil;
|
||||
LoadURL(URL);
|
||||
end;
|
||||
|
||||
procedure TformBrowser.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string;
|
||||
var Picture: TPicture);
|
||||
var
|
||||
lStream: TMemoryStream = nil;
|
||||
lStr: String;
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1GetImage ',URL);
|
||||
lStr := ExtractFileExt(URL);
|
||||
if (lStr = '.jpeg') or (lStr = '.jpg') then
|
||||
begin
|
||||
try
|
||||
MyPageLoader.LoadBinaryResource(URL, lStream);
|
||||
Picture := TPicture.Create;
|
||||
Picture.Jpeg.LoadFromStream(lStream);
|
||||
finally
|
||||
lStream.Free
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1GetImage Unsupported format: ', lStr);
|
||||
Picture := nil;
|
||||
Exit;
|
||||
end;
|
||||
// and (lStr <> '.bmp') and (lStr <> '.png')
|
||||
end;
|
||||
|
||||
procedure TformBrowser.DataProvider1Leave(Sender: TIpHtml);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TformBrowser.DataProvider1ReportReference(Sender: TObject; const URL: string
|
||||
);
|
||||
begin
|
||||
//debugln(['TForm1.DataProvider1ReportReference ',URL]);
|
||||
end;
|
||||
|
||||
procedure TformBrowser.ShowHTML(Src: string);
|
||||
var
|
||||
ss: TStringStream;
|
||||
NewHTML: TIpHtml;
|
||||
begin
|
||||
ss := TStringStream.Create(Src);
|
||||
try
|
||||
NewHTML := TIpHtml.Create; // Beware: Will be freed automatically by IpHtmlPanel1
|
||||
//debugln(['TForm1.ShowHTML BEFORE SETHTML']);
|
||||
IpHtmlPanel1.SetHtml(NewHTML);
|
||||
//debugln(['TForm1.ShowHTML BEFORE LOADFROMSTREAM']);
|
||||
NewHTML.LoadFromStream(ss);
|
||||
//if Anchor <> '' then IpHtmlPanel1.MakeAnchorVisible(Anchor);
|
||||
finally
|
||||
ss.Free;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure TformBrowser.FormCreate(Sender: TObject);
|
||||
var
|
||||
I: integer;
|
||||
begin
|
||||
MyPageLoader := TPageLoader.Create;
|
||||
History := TStringList.Create;
|
||||
|
||||
{$ifdef FPBROWSER_TURBOPOWERIPRO}
|
||||
DataProvider1:=TMyIpHtmlDataProvider.Create(Self);
|
||||
DataProvider1.Name:='DataProvider1';
|
||||
DataProvider1.OnCanHandle:=DataProvider1CanHandle;
|
||||
DataProvider1.OnGetHtml:=DataProvider1GetHtml;
|
||||
DataProvider1.OnGetImage:=DataProvider1GetImage;
|
||||
DataProvider1.OnLeave:=DataProvider1Leave;
|
||||
DataProvider1.OnCheckURL:=DataProvider1CheckURL;
|
||||
DataProvider1.OnReportReference:=DataProvider1ReportReference;
|
||||
|
||||
IpHtmlPanel1:=TIpHtmlPanel.Create(Self);
|
||||
IpHtmlPanel1.Name:='IpHtmlPanel1';
|
||||
IpHtmlPanel1.Parent:=panelBrowser;
|
||||
IpHtmlPanel1.Align:=alClient;
|
||||
IpHtmlPanel1.DefaultFontSize:=10;
|
||||
IpHtmlPanel1.DataProvider:=DataProvider1;
|
||||
{$endif}
|
||||
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
Viewer := THTMLViewer.Create(Self);
|
||||
Viewer.Left := 1;
|
||||
Viewer.Height := 358;
|
||||
Viewer.Top := 1;
|
||||
Viewer.Width := 611;
|
||||
Viewer.OnHotSpotCovered := HotSpotChange;
|
||||
Viewer.OnHotSpotClick := HotSpotClick;
|
||||
Viewer.OnImageRequest := ViewerImageRequest;
|
||||
Viewer.OnFormSubmit := SubmitEvent;
|
||||
Viewer.OnHistoryChange := HistoryChange;
|
||||
Viewer.OnProgress := ViewerProgress;
|
||||
Viewer.TabStop := True;
|
||||
Viewer.TabOrder := 0;
|
||||
Viewer.Align := alClient;
|
||||
Viewer.DefBackground := clWindow;
|
||||
Viewer.BorderStyle := htFocused;
|
||||
Viewer.HistoryMaxCount := 6;
|
||||
Viewer.DefFontName := 'Times New Roman';
|
||||
Viewer.DefPreFontName := 'Courier New';
|
||||
Viewer.DefFontColor := clWindowText;
|
||||
Viewer.DefOverLinkColor := clFuchsia;
|
||||
Viewer.ImageCacheCount := 6;
|
||||
Viewer.NoSelect := False;
|
||||
Viewer.CharSet := DEFAULT_CHARSET;
|
||||
Viewer.PrintMarginLeft := 2;
|
||||
Viewer.PrintMarginRight := 2;
|
||||
Viewer.PrintMarginTop := 2;
|
||||
Viewer.PrintMarginBottom := 2;
|
||||
Viewer.PrintScale := 1;
|
||||
Viewer.OnMouseMove := ViewerMouseMove;
|
||||
Viewer.OnProcessing := ProcessingHandler;
|
||||
Viewer.OnPrintHTMLHeader := ViewerPrintHTMLHeader;
|
||||
Viewer.OnPrintHTMLFooter := ViewerPrintHTMLFooter;
|
||||
Viewer.OnInclude := ViewerInclude;
|
||||
//Viewer.OnSoundRequest := SoundRequest;
|
||||
Viewer.OnMetaRefresh := MetaRefreshEvent;
|
||||
Viewer.OnObjectClick := ObjectClick;
|
||||
Viewer.OnRightClick := RightClick;
|
||||
Viewer.Parent := panelBrowser;
|
||||
|
||||
ShowImages.Checked := Viewer.ViewImages;
|
||||
Viewer.HistoryMaxCount := MaxHistories; {defines size of history list}
|
||||
{$endif}
|
||||
AddBrowserTab('', True);
|
||||
|
||||
Position := poScreenCenter;
|
||||
|
||||
@ -422,25 +194,21 @@ begin
|
||||
if (ParamCount >= 1) {$IFDEF DARWIN} and (Copy(ParamStr(1), 1, 4) <> '-psn') {$ENDIF} then
|
||||
begin {Parameter is file to load}
|
||||
S := ParamStr(1);
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
Viewer.LoadFromFile(HtmlToDos(Trim(S)));
|
||||
{$endif}
|
||||
GetCurrentBrowserViewer.LoadFromFile(S);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TformBrowser.OpenFileClick(Sender: TObject);
|
||||
begin
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
if Viewer.CurrentFile <> '' then
|
||||
OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
|
||||
// if Viewer.CurrentFile <> '' then
|
||||
// OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
|
||||
OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'; //might have changed
|
||||
if OpenDialog.Execute then
|
||||
begin
|
||||
Update;
|
||||
Viewer.LoadFromFile(OpenDialog.Filename);
|
||||
Caption := Viewer.DocumentTitle;
|
||||
GetCurrentBrowserViewer().LoadFromFile(OpenDialog.Filename);
|
||||
Caption := GetCurrentBrowserViewer().GetDocumentTitle();
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TformBrowser.editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
@ -457,152 +225,10 @@ begin
|
||||
pageBrowser.ActivePageIndex := 2;
|
||||
end;
|
||||
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
procedure TformBrowser.HotSpotChange(Sender: TObject; const URL: string);
|
||||
{mouse moved over or away from a hot spot. Change the status line}
|
||||
var
|
||||
Caption: string;
|
||||
begin
|
||||
Caption := '';
|
||||
if URL <> '' then
|
||||
Caption := Caption+'URL: '+URL+' ';
|
||||
if Viewer.TitleAttr <> '' then
|
||||
Caption := Caption+'Title: '+Viewer.TitleAttr;
|
||||
panelBottom.Caption := Caption;
|
||||
end;
|
||||
|
||||
{This routine handles what happens when a hot spot is clicked. The assumption
|
||||
is made that DOS filenames are being used. .EXE, .WAV, .MID, and .AVI files are
|
||||
handled here, but other file types could be easily added.
|
||||
|
||||
If the URL is handled here, set Handled to True. If not handled here, set it
|
||||
to False and ThtmlViewer will handle it.}
|
||||
procedure TformBrowser.HotSpotClick(Sender: TObject; const URL: string;
|
||||
var Handled: boolean);
|
||||
const
|
||||
snd_Async = $0001; { play asynchronously }
|
||||
var
|
||||
PC: array[0..255] of char;
|
||||
{$IFDEF LCL}
|
||||
PC2: array[0..255] of char;
|
||||
{$ENDIF}
|
||||
S, Params: string[255];
|
||||
Ext: string[5];
|
||||
ID: string;
|
||||
AbsURL: string;
|
||||
I, J, K: integer;
|
||||
begin
|
||||
Handled := False;
|
||||
|
||||
{The following looks for a link of the form, "IDExpand_XXX". This is interpreted
|
||||
as meaning a block with an ID="XXXPlus" or ID="XXXMinus" attribute should
|
||||
have its Display property toggled.
|
||||
}
|
||||
I := Pos('IDEXPAND_', Uppercase(URL));
|
||||
if I=1 then
|
||||
begin
|
||||
ID := Copy(URL, 10, Length(URL)-9);
|
||||
Viewer.IDDisplay[ID+'Plus'] := not Viewer.IDDisplay[ID+'Plus'];
|
||||
Viewer.IDDisplay[ID+'Minus'] := not Viewer.IDDisplay[ID+'Minus'];
|
||||
Viewer.Reformat;
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
AbsURL := MyPageLoader.URLToAbsoluteURL(URL);
|
||||
J := Pos('HTTP:', UpperCase(AbsURL));
|
||||
if (J > 0) then
|
||||
begin
|
||||
LoadURL(AbsURL);
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
I := Pos(':', URL);
|
||||
J := Pos('FILE:', UpperCase(URL));
|
||||
if (I <= 2) or (J > 0) then
|
||||
begin {apparently the URL is a filename}
|
||||
S := URL;
|
||||
K := Pos(' ', S); {look for parameters}
|
||||
if K = 0 then K := Pos('?', S); {could be '?x,y' , etc}
|
||||
if K > 0 then
|
||||
begin
|
||||
Params := Copy(S, K+1, 255); {save any parameters}
|
||||
S[0] := chr(K-1); {truncate S}
|
||||
end
|
||||
else Params := '';
|
||||
S := Viewer.HTMLExpandFileName(S);
|
||||
Ext := Uppercase(ExtractFileExt(S));
|
||||
if Ext = '.WAV' then
|
||||
begin
|
||||
Handled := True;
|
||||
{$IFNDEF LCL}
|
||||
sndPlaySound(StrPCopy(PC, S), snd_ASync);
|
||||
{$ENDIF}
|
||||
end
|
||||
else if Ext = '.EXE' then
|
||||
begin
|
||||
Handled := True;
|
||||
{$IFNDEF LCL}
|
||||
WinExec(StrPCopy(PC, S+' '+Params), sw_Show);
|
||||
{$ELSE}
|
||||
{$IFDEF MSWINDOWS}
|
||||
ShellExecute(Handle, nil, StrPCopy(PC, S), StrPCopy(PC2, Params),
|
||||
nil, SW_SHOWNORMAL);
|
||||
{$ELSE} //Not sure if this makes any sense since executable won't have .exe.
|
||||
{$IFDEF DARWIN}
|
||||
Shell('open -n "' + S + '" --args "' + Params + '"');
|
||||
{$ELSE}
|
||||
Shell('"' + S + '" "' + Params + '"');
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
end
|
||||
else if (Ext = '.MID') or (Ext = '.AVI') then
|
||||
begin
|
||||
Handled := True;
|
||||
{$IFNDEF LCL}
|
||||
WinExec(StrPCopy(PC, 'MPlayer.exe /play /close '+S), sw_Show);
|
||||
{$ELSE}
|
||||
{$IFDEF MSWINDOWS}
|
||||
ShellExecute(Handle, nil, 'MPlayer.exe', '/play /close',
|
||||
nil, SW_SHOWNORMAL);
|
||||
{$ELSE} //No equivalent to MPlayer?
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
end;
|
||||
{else ignore other extensions}
|
||||
editURL.Text := URL;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
I := Pos('MAILTO:', UpperCase(URL));
|
||||
if (I > 0) then
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
ShellExecute(0, nil, pchar(URL), nil, nil, SW_SHOWNORMAL);
|
||||
{$ELSE}
|
||||
{$IFDEF DARWIN}
|
||||
Shell('open "' + URL + '"');
|
||||
{$ELSE}
|
||||
Shell('"' + URL + '"'); //use LCL's OpenURL?
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
editURL.Text := URL; {other protocall}
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{The Show Images menu item was clicked}
|
||||
procedure TformBrowser.ShowImagesClick(Sender: TObject);
|
||||
begin
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
Viewer.ViewImages := not Viewer.ViewImages;
|
||||
(Sender as TMenuItem).Checked := Viewer.ViewImages;
|
||||
{$endif}
|
||||
GetCurrentBrowserViewer().SetShowImages((Sender as TMenuItem).Checked);
|
||||
end;
|
||||
|
||||
procedure TformBrowser.buttonReloadClick(Sender: TObject);
|
||||
@ -936,24 +562,6 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{ In this event we should provide images for the html component }
|
||||
procedure TformBrowser.ViewerImageRequest(Sender: TObject; const SRC: string;
|
||||
var Stream: TMemoryStream);
|
||||
var
|
||||
J: Integer;
|
||||
URL: string;
|
||||
begin
|
||||
URL := MyPageLoader.URLToAbsoluteURL(SRC);
|
||||
|
||||
J := Pos('http:', LowerCase(URL));
|
||||
if (J > 0) then
|
||||
begin
|
||||
MyPageLoader.LoadBinaryResource(URL, Stream);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TformBrowser.ViewerInclude(Sender: TObject; const Command: String;
|
||||
Params: TStrings; var S: string);
|
||||
{OnInclude handler}
|
||||
@ -993,7 +601,6 @@ end;
|
||||
procedure TformBrowser.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
HintWindow.Free;
|
||||
MyPageLoader.Free;
|
||||
History.Free;
|
||||
end;
|
||||
|
||||
@ -1148,13 +755,24 @@ end;
|
||||
|
||||
procedure TformBrowser.LoadURL(AURL: string);
|
||||
begin
|
||||
MyPageLoaderThread := TPageLoaderThread.Create(True);
|
||||
MyPageLoaderThread.URL := AURL;
|
||||
MyPageLoaderThread.PageLoader := MyPageLoader;
|
||||
MyPageLoaderThread.OnPageLoadProgress := HandlePageLoaderProgress;
|
||||
MyPageLoaderThread.OnTerminate := HandlePageLoaderTerminated;
|
||||
MyPageLoaderThread.FreeOnTerminate := True;
|
||||
MyPageLoaderThread.Resume;
|
||||
GetCurrentBrowserViewer.LoadFromURL(AURL);
|
||||
end;
|
||||
|
||||
procedure TformBrowser.AddBrowserTab(AURL: string; AGoToTab: Boolean);
|
||||
var
|
||||
lViewer: TBrowserViewer;
|
||||
lTabSheet: TTabSheet;
|
||||
begin
|
||||
lTabSheet := pageBrowser.AddTabSheet(); // This call requires Lazarus 0.9.31+
|
||||
|
||||
lViewer := AddBrowserViewer();
|
||||
lViewer.CreateViewer(lTabSheet, Self);
|
||||
|
||||
if AGoToTab then
|
||||
begin
|
||||
CurrentTab := GetBrowerViewerCount() - 1;
|
||||
SetCurrentBrowserViewer(CurrentTab);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TformBrowser.AddURLToHistory(AURL: string);
|
||||
@ -1172,23 +790,15 @@ end;
|
||||
|
||||
procedure TformBrowser.HandlePageLoaderTerminated(Sender: TObject);
|
||||
begin
|
||||
labelProgress.Caption := 'Finished Loading';
|
||||
{ labelProgress.Caption := 'Finished Loading';
|
||||
progressBar.Position := 100;
|
||||
|
||||
{$ifdef FPBROWSER_THTMLCOMP}
|
||||
Viewer.LoadFromString(MyPageLoader.Contents);
|
||||
Caption := Viewer.DocumentTitle;
|
||||
{$endif}
|
||||
{$ifdef FPBROWSER_TURBOPOWERIPRO}
|
||||
ShowHTML(MyPageLoader.Contents);
|
||||
{$endif}
|
||||
|
||||
// Load source and debug info
|
||||
memoSource.Lines.Clear();
|
||||
memoSource.Lines.AddStrings(MyPageLoader.ContentsList);
|
||||
memoDebug.Lines.Clear();
|
||||
memoDebug.Lines.AddStrings(MyPageLoader.DebugInfo);
|
||||
AddURLToHistory(MyPageLoader.LastPageURL);
|
||||
AddURLToHistory(MyPageLoader.LastPageURL);}
|
||||
end;
|
||||
|
||||
procedure TformBrowser.Timer1Timer(Sender: TObject);
|
||||
|
||||
198
applications/fpbrowser/viewer_ipro.pas
Normal file
198
applications/fpbrowser/viewer_ipro.pas
Normal file
@ -0,0 +1,198 @@
|
||||
unit viewer_ipro;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, Forms, Controls,
|
||||
//
|
||||
browserviewer,
|
||||
//
|
||||
IPHtml, Ipfilebroker, IpMsg;
|
||||
|
||||
type
|
||||
{ TMyIpHtmlDataProvider }
|
||||
|
||||
TMyIpHtmlDataProvider = class(TIpHtmlDataProvider)
|
||||
protected
|
||||
function DoGetStream(const URL: string): TStream; override;
|
||||
end;
|
||||
|
||||
{ TiProViewer }
|
||||
|
||||
TiProViewer = class(TBrowserViewer)
|
||||
private
|
||||
IpHtmlPanel1: TIpHtmlPanel;
|
||||
DataProvider1: TMyIpHtmlDataProvider;
|
||||
function DataProvider1CanHandle(Sender: TObject; const URL: string
|
||||
): Boolean;
|
||||
procedure DataProvider1CheckURL(Sender: TObject; const URL: string;
|
||||
var Available: Boolean; var ContentType: string);
|
||||
procedure DataProvider1GetHtml(Sender: TObject; const URL: string;
|
||||
const PostData: TIpFormDataEntity; var Stream: TStream);
|
||||
procedure DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string;
|
||||
var Picture: TPicture);
|
||||
procedure DataProvider1Leave(Sender: TIpHtml);
|
||||
procedure DataProvider1ReportReference(Sender: TObject; const URL: string);
|
||||
procedure ShowHTML(Src: string);
|
||||
public
|
||||
procedure CreateViewer(AParent, AOwner: TWinControl); override;
|
||||
procedure LoadFromFile(AFilename: string); override;
|
||||
// procedure LoadFromURL(AURL: string); override;
|
||||
function GetDocumentTitle: string; override;
|
||||
procedure SetShowImages(AValue: Boolean); override;
|
||||
procedure HandlePageLoaderTerminated(Sender: TObject); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TMyIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
|
||||
var
|
||||
ms: TMemoryStream;
|
||||
begin
|
||||
Result:=nil;
|
||||
WriteLn('TMyIpHtmlDataProvider.DoGetStream '+URL);
|
||||
|
||||
if URL='fpdoc.css' then begin
|
||||
//debugln(['TMyIpHtmlDataProvider.DoGetStream ',FileExists(URL)]);
|
||||
ms:=TMemoryStream.Create;
|
||||
try
|
||||
ms.LoadFromFile(URL);
|
||||
ms.Position:=0;
|
||||
except
|
||||
ms.Free;
|
||||
end;
|
||||
Result:=ms;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TiProViewer.DataProvider1CanHandle(Sender: TObject; const URL: string
|
||||
): Boolean;
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1CanHandle ',URL);
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
procedure TiProViewer.DataProvider1CheckURL(Sender: TObject; const URL: string;
|
||||
var Available: Boolean; var ContentType: string);
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1CheckURL ',URL);
|
||||
Available:=True;
|
||||
ContentType:='text/html';
|
||||
end;
|
||||
|
||||
procedure TiProViewer.DataProvider1GetHtml(Sender: TObject; const URL: string;
|
||||
const PostData: TIpFormDataEntity; var Stream: TStream);
|
||||
var
|
||||
lStream: TMemoryStream;
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1GetHtml ',URL);
|
||||
{ MyPageLoader.LoadBinaryResource(URL, lStream);
|
||||
Stream := lStream;
|
||||
lStream.Position := 0;}
|
||||
Stream := nil;
|
||||
LoadFromURL(URL);
|
||||
end;
|
||||
|
||||
procedure TiProViewer.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string;
|
||||
var Picture: TPicture);
|
||||
var
|
||||
lStream: TMemoryStream = nil;
|
||||
lStr: String;
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1GetImage ',URL);
|
||||
lStr := ExtractFileExt(URL);
|
||||
if (lStr = '.jpeg') or (lStr = '.jpg') then
|
||||
begin
|
||||
try
|
||||
MyPageLoader.LoadBinaryResource(URL, lStream);
|
||||
Picture := TPicture.Create;
|
||||
Picture.Jpeg.LoadFromStream(lStream);
|
||||
finally
|
||||
lStream.Free
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteLn('TformBrowser.DataProvider1GetImage Unsupported format: ', lStr);
|
||||
Picture := nil;
|
||||
Exit;
|
||||
end;
|
||||
// and (lStr <> '.bmp') and (lStr <> '.png')
|
||||
end;
|
||||
|
||||
procedure TiProViewer.DataProvider1Leave(Sender: TIpHtml);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TiProViewer.DataProvider1ReportReference(Sender: TObject; const URL: string
|
||||
);
|
||||
begin
|
||||
//debugln(['TForm1.DataProvider1ReportReference ',URL]);
|
||||
end;
|
||||
|
||||
procedure TiProViewer.ShowHTML(Src: string);
|
||||
var
|
||||
ss: TStringStream;
|
||||
NewHTML: TIpHtml;
|
||||
begin
|
||||
ss := TStringStream.Create(Src);
|
||||
try
|
||||
NewHTML := TIpHtml.Create; // Beware: Will be freed automatically by IpHtmlPanel1
|
||||
//debugln(['TForm1.ShowHTML BEFORE SETHTML']);
|
||||
IpHtmlPanel1.SetHtml(NewHTML);
|
||||
//debugln(['TForm1.ShowHTML BEFORE LOADFROMSTREAM']);
|
||||
NewHTML.LoadFromStream(ss);
|
||||
//if Anchor <> '' then IpHtmlPanel1.MakeAnchorVisible(Anchor);
|
||||
finally
|
||||
ss.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TiProViewer.CreateViewer(AParent, AOwner: TWinControl);
|
||||
begin
|
||||
DataProvider1:=TMyIpHtmlDataProvider.Create(AOwner);
|
||||
DataProvider1.Name:='DataProvider1';
|
||||
DataProvider1.OnCanHandle:=DataProvider1CanHandle;
|
||||
DataProvider1.OnGetHtml:=DataProvider1GetHtml;
|
||||
DataProvider1.OnGetImage:=DataProvider1GetImage;
|
||||
DataProvider1.OnLeave:=DataProvider1Leave;
|
||||
DataProvider1.OnCheckURL:=DataProvider1CheckURL;
|
||||
DataProvider1.OnReportReference:=DataProvider1ReportReference;
|
||||
|
||||
IpHtmlPanel1:=TIpHtmlPanel.Create(AOwner);
|
||||
IpHtmlPanel1.Name:='IpHtmlPanel1';
|
||||
IpHtmlPanel1.Parent:=AParent;
|
||||
IpHtmlPanel1.Align:=alClient;
|
||||
IpHtmlPanel1.DefaultFontSize:=10;
|
||||
IpHtmlPanel1.DataProvider:=DataProvider1;
|
||||
end;
|
||||
|
||||
procedure TiProViewer.LoadFromFile(AFilename: string);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TiProViewer.GetDocumentTitle: string;
|
||||
begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
procedure TiProViewer.SetShowImages(AValue: Boolean);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TiProViewer.HandlePageLoaderTerminated(Sender: TObject);
|
||||
begin
|
||||
inherited HandlePageLoaderTerminated(Sender);
|
||||
|
||||
ShowHTML(MyPageLoader.Contents);
|
||||
end;
|
||||
|
||||
initialization
|
||||
SetBrowserViewerClass(TiProViewer);
|
||||
end.
|
||||
|
||||
311
applications/fpbrowser/viewer_thtmlcomp.pas
Normal file
311
applications/fpbrowser/viewer_thtmlcomp.pas
Normal file
@ -0,0 +1,311 @@
|
||||
unit viewer_thtmlcomp;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
//
|
||||
browserviewer,
|
||||
//
|
||||
HtmlMisc, HTMLsubs, Htmlview, HTMLun2;
|
||||
|
||||
type
|
||||
|
||||
{ THtmlCompViewer }
|
||||
|
||||
THtmlCompViewer = class(TBrowserViewer)
|
||||
private
|
||||
Viewer: THTMLViewer;
|
||||
FoundObject: TImageObj;
|
||||
procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||
Y: Integer);
|
||||
procedure ViewerProgress(Sender: TObject; Stage: TProgressStage;
|
||||
PercentDone: Integer);
|
||||
procedure ViewerPrintHTMLFooter(Sender: TObject; HFViewer: THTMLViewer;
|
||||
NumPage: Integer; LastPage: Boolean; var XL, XR: Integer;
|
||||
var StopPrinting: Boolean);
|
||||
procedure ViewerPrintHTMLHeader(Sender: TObject; HFViewer: THTMLViewer;
|
||||
NumPage: Integer; LastPage: Boolean; var XL, XR: Integer;
|
||||
var StopPrinting: Boolean);
|
||||
procedure HotSpotChange(Sender: TObject; const URL: string);
|
||||
procedure HotSpotClick(Sender: TObject; const URL: string;
|
||||
var Handled: boolean);
|
||||
procedure RightClick(Sender: TObject;
|
||||
Parameters: TRightClickParameters);
|
||||
procedure ViewerImageRequest(Sender: TObject; const SRC: string;
|
||||
var Stream: TMemoryStream);
|
||||
public
|
||||
procedure CreateViewer(AParent, AOwner: TWinControl); override;
|
||||
procedure LoadFromFile(AFilename: string); override;
|
||||
// procedure LoadFromURL(AURL: string); override;
|
||||
function GetDocumentTitle: string; override;
|
||||
procedure SetShowImages(AValue: Boolean); override;
|
||||
procedure HandlePageLoaderTerminated(Sender: TObject); override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ THtmlCompViewer }
|
||||
|
||||
procedure THtmlCompViewer.ViewerMouseMove(Sender: TObject; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.ViewerProgress(Sender: TObject;
|
||||
Stage: TProgressStage; PercentDone: Integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.ViewerPrintHTMLFooter(Sender: TObject;
|
||||
HFViewer: THTMLViewer; NumPage: Integer; LastPage: Boolean; var XL,
|
||||
XR: Integer; var StopPrinting: Boolean);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.ViewerPrintHTMLHeader(Sender: TObject;
|
||||
HFViewer: THTMLViewer; NumPage: Integer; LastPage: Boolean; var XL,
|
||||
XR: Integer; var StopPrinting: Boolean);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.HotSpotChange(Sender: TObject; const URL: string);
|
||||
{mouse moved over or away from a hot spot. Change the status line}
|
||||
var
|
||||
Caption: string;
|
||||
begin
|
||||
Caption := '';
|
||||
if URL <> '' then
|
||||
Caption := Caption+'URL: '+URL+' ';
|
||||
if Viewer.TitleAttr <> '' then
|
||||
Caption := Caption+'Title: '+Viewer.TitleAttr;
|
||||
panelBottom.Caption := Caption;
|
||||
end;
|
||||
|
||||
{This routine handles what happens when a hot spot is clicked. The assumption
|
||||
is made that DOS filenames are being used. .EXE, .WAV, .MID, and .AVI files are
|
||||
handled here, but other file types could be easily added.
|
||||
|
||||
If the URL is handled here, set Handled to True. If not handled here, set it
|
||||
to False and ThtmlViewer will handle it.}
|
||||
procedure THtmlCompViewer.HotSpotClick(Sender: TObject; const URL: string;
|
||||
var Handled: boolean);
|
||||
const
|
||||
snd_Async = $0001; { play asynchronously }
|
||||
var
|
||||
PC: array[0..255] of char;
|
||||
{$IFDEF LCL}
|
||||
PC2: array[0..255] of char;
|
||||
{$ENDIF}
|
||||
S, Params: string[255];
|
||||
Ext: string[5];
|
||||
ID: string;
|
||||
AbsURL: string;
|
||||
I, J, K: integer;
|
||||
begin
|
||||
Handled := False;
|
||||
|
||||
{The following looks for a link of the form, "IDExpand_XXX". This is interpreted
|
||||
as meaning a block with an ID="XXXPlus" or ID="XXXMinus" attribute should
|
||||
have its Display property toggled.
|
||||
}
|
||||
I := Pos('IDEXPAND_', Uppercase(URL));
|
||||
if I=1 then
|
||||
begin
|
||||
ID := Copy(URL, 10, Length(URL)-9);
|
||||
Viewer.IDDisplay[ID+'Plus'] := not Viewer.IDDisplay[ID+'Plus'];
|
||||
Viewer.IDDisplay[ID+'Minus'] := not Viewer.IDDisplay[ID+'Minus'];
|
||||
Viewer.Reformat;
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
AbsURL := MyPageLoader.URLToAbsoluteURL(URL);
|
||||
J := Pos('HTTP:', UpperCase(AbsURL));
|
||||
if (J > 0) then
|
||||
begin
|
||||
LoadURL(AbsURL);
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
I := Pos(':', URL);
|
||||
J := Pos('FILE:', UpperCase(URL));
|
||||
if (I <= 2) or (J > 0) then
|
||||
begin {apparently the URL is a filename}
|
||||
S := URL;
|
||||
K := Pos(' ', S); {look for parameters}
|
||||
if K = 0 then K := Pos('?', S); {could be '?x,y' , etc}
|
||||
if K > 0 then
|
||||
begin
|
||||
Params := Copy(S, K+1, 255); {save any parameters}
|
||||
S[0] := chr(K-1); {truncate S}
|
||||
end
|
||||
else Params := '';
|
||||
S := Viewer.HTMLExpandFileName(S);
|
||||
Ext := Uppercase(ExtractFileExt(S));
|
||||
if Ext = '.WAV' then
|
||||
begin
|
||||
Handled := True;
|
||||
{$IFNDEF LCL}
|
||||
sndPlaySound(StrPCopy(PC, S), snd_ASync);
|
||||
{$ENDIF}
|
||||
end
|
||||
else if Ext = '.EXE' then
|
||||
begin
|
||||
Handled := True;
|
||||
{$IFNDEF LCL}
|
||||
WinExec(StrPCopy(PC, S+' '+Params), sw_Show);
|
||||
{$ELSE}
|
||||
{$IFDEF MSWINDOWS}
|
||||
ShellExecute(Handle, nil, StrPCopy(PC, S), StrPCopy(PC2, Params),
|
||||
nil, SW_SHOWNORMAL);
|
||||
{$ELSE} //Not sure if this makes any sense since executable won't have .exe.
|
||||
{$IFDEF DARWIN}
|
||||
Shell('open -n "' + S + '" --args "' + Params + '"');
|
||||
{$ELSE}
|
||||
Shell('"' + S + '" "' + Params + '"');
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
end
|
||||
else if (Ext = '.MID') or (Ext = '.AVI') then
|
||||
begin
|
||||
Handled := True;
|
||||
{$IFNDEF LCL}
|
||||
WinExec(StrPCopy(PC, 'MPlayer.exe /play /close '+S), sw_Show);
|
||||
{$ELSE}
|
||||
{$IFDEF MSWINDOWS}
|
||||
ShellExecute(Handle, nil, 'MPlayer.exe', '/play /close',
|
||||
nil, SW_SHOWNORMAL);
|
||||
{$ELSE} //No equivalent to MPlayer?
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
end;
|
||||
{else ignore other extensions}
|
||||
editURL.Text := URL;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
I := Pos('MAILTO:', UpperCase(URL));
|
||||
if (I > 0) then
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
ShellExecute(0, nil, pchar(URL), nil, nil, SW_SHOWNORMAL);
|
||||
{$ELSE}
|
||||
{$IFDEF DARWIN}
|
||||
Shell('open "' + URL + '"');
|
||||
{$ELSE}
|
||||
Shell('"' + URL + '"'); //use LCL's OpenURL?
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
editURL.Text := URL; {other protocall}
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.RightClick(Sender: TObject;
|
||||
Parameters: TRightClickParameters);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ In this event we should provide images for the html component }
|
||||
procedure THtmlCompViewer.ViewerImageRequest(Sender: TObject;
|
||||
const SRC: string; var Stream: TMemoryStream);
|
||||
var
|
||||
J: Integer;
|
||||
URL: string;
|
||||
begin
|
||||
URL := MyPageLoader.URLToAbsoluteURL(SRC);
|
||||
|
||||
J := Pos('http:', LowerCase(URL));
|
||||
if (J > 0) then
|
||||
begin
|
||||
MyPageLoader.LoadBinaryResource(URL, Stream);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.CreateViewer(AParent, AOwner: TWinControl);
|
||||
begin
|
||||
Viewer := THTMLViewer.Create(AOwner);
|
||||
Viewer.Left := 1;
|
||||
Viewer.Height := 358;
|
||||
Viewer.Top := 1;
|
||||
Viewer.Width := 611;
|
||||
Viewer.OnHotSpotCovered := HotSpotChange;
|
||||
Viewer.OnHotSpotClick := HotSpotClick;
|
||||
Viewer.OnImageRequest := ViewerImageRequest;
|
||||
Viewer.OnFormSubmit := SubmitEvent;
|
||||
Viewer.OnHistoryChange := HistoryChange;
|
||||
Viewer.OnProgress := ViewerProgress;
|
||||
Viewer.TabStop := True;
|
||||
Viewer.TabOrder := 0;
|
||||
Viewer.Align := alClient;
|
||||
Viewer.DefBackground := clWindow;
|
||||
Viewer.BorderStyle := htFocused;
|
||||
Viewer.HistoryMaxCount := 6;
|
||||
Viewer.DefFontName := 'Times New Roman';
|
||||
Viewer.DefPreFontName := 'Courier New';
|
||||
Viewer.DefFontColor := clWindowText;
|
||||
Viewer.DefOverLinkColor := clFuchsia;
|
||||
Viewer.ImageCacheCount := 6;
|
||||
Viewer.NoSelect := False;
|
||||
Viewer.CharSet := DEFAULT_CHARSET;
|
||||
Viewer.PrintMarginLeft := 2;
|
||||
Viewer.PrintMarginRight := 2;
|
||||
Viewer.PrintMarginTop := 2;
|
||||
Viewer.PrintMarginBottom := 2;
|
||||
Viewer.PrintScale := 1;
|
||||
Viewer.OnMouseMove := ViewerMouseMove;
|
||||
Viewer.OnProcessing := ProcessingHandler;
|
||||
Viewer.OnPrintHTMLHeader := ViewerPrintHTMLHeader;
|
||||
Viewer.OnPrintHTMLFooter := ViewerPrintHTMLFooter;
|
||||
Viewer.OnInclude := ViewerInclude;
|
||||
//Viewer.OnSoundRequest := SoundRequest;
|
||||
Viewer.OnMetaRefresh := MetaRefreshEvent;
|
||||
Viewer.OnObjectClick := ObjectClick;
|
||||
Viewer.OnRightClick := RightClick;
|
||||
Viewer.Parent := AParent;
|
||||
|
||||
// ShowImages.Checked := Viewer.ViewImages;
|
||||
Viewer.HistoryMaxCount := MaxHistories; {defines size of history list}
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.LoadFromFile(AFilename: string);
|
||||
begin
|
||||
Viewer.LoadFromFile(HtmlToDos(Trim(AFilename)));
|
||||
end;
|
||||
|
||||
function THtmlCompViewer.GetDocumentTitle: string;
|
||||
begin
|
||||
Result := Viewer.DocumentTitle;
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.SetShowImages(AValue: Boolean);
|
||||
begin
|
||||
Viewer.ViewImages := AValue;
|
||||
end;
|
||||
|
||||
procedure THtmlCompViewer.HandlePageLoaderTerminated(Sender: TObject);
|
||||
begin
|
||||
inherited HandlePageLoaderTerminated(Sender);
|
||||
|
||||
Viewer.LoadFromString(MyPageLoader.Contents);
|
||||
Caption := Viewer.DocumentTitle;
|
||||
end;
|
||||
|
||||
initialization
|
||||
SetBrowserViewerClass(THtmlCompViewer);
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user