From 9f5841738cb5281dd59f8d230ae14d1005078b74 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 8 Sep 2011 14:12:42 +0000 Subject: [PATCH] fpbrowser: Changes from thtmlcomp to turbopoweripro, but leaves defines for htmlcomp git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1924 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/fpbrowser/fontdlg.pas | 5 +- applications/fpbrowser/fpbrowser.dpr | 11 +- applications/fpbrowser/fpbrowser.lpi | 9 +- applications/fpbrowser/htmlabt.pas | 9 +- applications/fpbrowser/mainform.lfm | 22 +- applications/fpbrowser/mainform.lrs | 80 ++--- applications/fpbrowser/mainform.pas | 486 +++++++++++++++----------- applications/fpbrowser/pageloader.pas | 5 +- 8 files changed, 354 insertions(+), 273 deletions(-) diff --git a/applications/fpbrowser/fontdlg.pas b/applications/fpbrowser/fontdlg.pas index 8e3a49dd5..64740ea46 100755 --- a/applications/fpbrowser/fontdlg.pas +++ b/applications/fpbrowser/fontdlg.pas @@ -3,9 +3,10 @@ unit Fontdlg; interface uses - {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF} + LclIntf, LMessages, LclType, LResources, SysUtils, Classes, Graphics, Controls, - Forms, Dialogs, StdCtrls, {$IFNDEF LCL} ColorGrd, {$ENDIF} Htmlview, Spin; + Htmlview + Forms, Dialogs, StdCtrls, ColorGrd, Spin; type TFontForm = class(TForm) diff --git a/applications/fpbrowser/fpbrowser.dpr b/applications/fpbrowser/fpbrowser.dpr index efaff4e76..30e6f7ae1 100644 --- a/applications/fpbrowser/fpbrowser.dpr +++ b/applications/fpbrowser/fpbrowser.dpr @@ -1,23 +1,20 @@ program fpbrowser; -{A program to demonstrate the ThtmlViewer component} uses {$IFDEF UNIX} cthreads, {$ENDIF} -{$IFDEF LCL} Interfaces, -{$ENDIF} - Forms, printer4lazarus, laz_synapse, + Forms, + printer4lazarus, turbopoweripro, laz_synapse, mainform {Form1}, Submit in 'Submit.pas' {SubmitForm}, - Fontdlg in 'Fontdlg.pas' {FontForm}, Htmlabt in 'Htmlabt.pas' {AboutBox}, -{$IFNDEF LCL} +(* Fontdlg in 'Fontdlg.pas' {FontForm}, PreviewForm in 'PreviewForm.pas' {PreviewForm}, Gopage in 'Gopage.pas' {GoPageForm}, PrintStatusForm in 'PrintStatusForm.pas' {PrnStatusForm}, -{$ENDIF} +*) ImgForm in 'ImgForm.pas', pageloader, browsermodules {ImageForm}; begin diff --git a/applications/fpbrowser/fpbrowser.lpi b/applications/fpbrowser/fpbrowser.lpi index 171c8772a..3f0202fb8 100644 --- a/applications/fpbrowser/fpbrowser.lpi +++ b/applications/fpbrowser/fpbrowser.lpi @@ -32,17 +32,16 @@ - + - + - + - - + diff --git a/applications/fpbrowser/htmlabt.pas b/applications/fpbrowser/htmlabt.pas index 325cdfe29..fc28f140a 100755 --- a/applications/fpbrowser/htmlabt.pas +++ b/applications/fpbrowser/htmlabt.pas @@ -3,9 +3,9 @@ unit HTMLAbt; interface uses - {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, LCLVersion, {$ENDIF} + LclIntf, LMessages, LclType, LResources, LCLVersion, SysUtils, Classes, Graphics, Controls, - Forms, Dialogs, StdCtrls, Buttons, Htmlview, ExtCtrls; + Forms, Dialogs, StdCtrls, Buttons, ExtCtrls; const Version = '9.45'; @@ -14,7 +14,6 @@ type TAboutBox = class(TForm) BitBtn1: TBitBtn; Panel1: TPanel; - Viewer: THTMLViewer; private { Private declarations } public @@ -36,7 +35,7 @@ var S: string[210]; begin inherited Create(Owner); -//Viewer.DefFontName := 'MS Sans Serif'; //Windows-only font +(*//Viewer.DefFontName := 'MS Sans Serif'; //Windows-only font Viewer.DefFontName := 'Arial'; Viewer.DefFontSize := 9; Viewer.DefFontColor := clNavy; @@ -81,7 +80,7 @@ S :=''+ ''+ ''; -Viewer.LoadFromBuffer(@S[1], Length(S), ''); +Viewer.LoadFromBuffer(@S[1], Length(S), '');*) end; initialization diff --git a/applications/fpbrowser/mainform.lfm b/applications/fpbrowser/mainform.lfm index c51b81f5e..bfe4b0e20 100644 --- a/applications/fpbrowser/mainform.lfm +++ b/applications/fpbrowser/mainform.lfm @@ -3,7 +3,7 @@ object formBrowser: TformBrowser Height = 439 Top = 186 Width = 621 - ClientHeight = 439 + ClientHeight = 412 ClientWidth = 621 Color = clBtnFace Font.Color = clWindowText @@ -18,7 +18,7 @@ object formBrowser: TformBrowser object Panel1: TPanel Left = 0 Height = 18 - Top = 421 + Top = 394 Width = 621 Align = alBottom Alignment = taLeftJustify @@ -90,7 +90,7 @@ object formBrowser: TformBrowser end object pageBrowser: TPageControl Left = 0 - Height = 388 + Height = 361 Top = 33 Width = 621 ActivePage = tabBrowser @@ -100,13 +100,13 @@ object formBrowser: TformBrowser TabOrder = 2 object tabBrowser: TTabSheet Caption = 'Browser' - ClientHeight = 381 - ClientWidth = 613 + ClientHeight = 359 + ClientWidth = 619 object Panel3: TPanel Left = 0 - Height = 381 + Height = 359 Top = 0 - Width = 613 + Width = 619 Align = alClient BevelInner = bvLowered BevelOuter = bvNone @@ -116,8 +116,8 @@ object formBrowser: TformBrowser end object tabDebug: TTabSheet Caption = 'Debug' - ClientHeight = 360 - ClientWidth = 613 + ClientHeight = 359 + ClientWidth = 619 object memoDebug: TMemo Left = 0 Height = 360 @@ -132,8 +132,8 @@ object formBrowser: TformBrowser end object tabSource: TTabSheet Caption = 'tabSource' - ClientHeight = 360 - ClientWidth = 613 + ClientHeight = 359 + ClientWidth = 619 object memoSource: TMemo Left = 0 Height = 360 diff --git a/applications/fpbrowser/mainform.lrs b/applications/fpbrowser/mainform.lrs index df8b3f6ee..0b337294b 100644 --- a/applications/fpbrowser/mainform.lrs +++ b/applications/fpbrowser/mainform.lrs @@ -2,12 +2,12 @@ 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#183#1#11'ClientWidth'#3'm'#2#5 + +'p'#3#186#0#5'Width'#3'm'#2#12'ClientHeight'#3#156#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'#6'Panel1'#4'Left'#2#0 - +#6'Height'#2#18#3'Top'#3#165#1#5'Width'#3'm'#2#5'Align'#7#8'alBottom'#9'Alig' + +#6'Height'#2#18#3'Top'#3#138#1#5'Width'#3'm'#2#5'Align'#7#8'alBottom'#9'Alig' +'nment'#7#13'taLeftJustify'#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7#6 +'bvNone'#12'ClientHeight'#2#18#11'ClientWidth'#3'm'#2#8'TabOrder'#2#0#0#12'T' +'ProgressBar'#11'ProgressBar'#4'Left'#3#214#1#6'Height'#2#16#3'Top'#2#1#5'Wi' @@ -23,44 +23,44 @@ LazarusResources.Add('TformBrowser','FORMDATA',[ +'Back'#7'Enabled'#8#7'OnClick'#7#12'FwdBackClick'#8'TabOrder'#2#1#0#0#7'TBut' +'ton'#9'FwdButton'#4'Left'#3#128#0#6'Height'#2#24#3'Top'#2#4#5'Width'#2';'#7 +'Caption'#6#8'&Forward'#7'Enabled'#8#7'OnClick'#7#12'FwdBackClick'#8'TabOrde' - +'r'#2#2#0#0#0#12'TPageControl'#11'pageBrowser'#4'Left'#2#0#6'Height'#3#132#1 - +#3'Top'#2'!'#5'Width'#3'm'#2#10'ActivePage'#7#10'tabBrowser'#5'Align'#7#8'al' - +'Client'#8'ShowTabs'#8#8'TabIndex'#2#0#8'TabOrder'#2#2#0#9'TTabSheet'#10'tab' - +'Browser'#7'Caption'#6#7'Browser'#12'ClientHeight'#3'}'#1#11'ClientWidth'#3 - +'e'#2#0#6'TPanel'#6'Panel3'#4'Left'#2#0#6'Height'#3'}'#1#3'Top'#2#0#5'Width' - +#3'e'#2#5'Align'#7#8'alClient'#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7 - +#6'bvNone'#7'Caption'#6#6'Panel3'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tabDe' - +'bug'#7'Caption'#6#5'Debug'#12'ClientHeight'#3'h'#1#11'ClientWidth'#3'e'#2#0 - +#5'TMemo'#9'memoDebug'#4'Left'#2#0#6'Height'#3'h'#1#3'Top'#2#0#5'Width'#3'e' - +#2#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#9'memoDebug'#0#8'TabOrder'#2 - +#0#0#0#0#9'TTabSheet'#9'tabSource'#7'Caption'#6#9'tabSource'#12'ClientHeight' - +#3'h'#1#11'ClientWidth'#3'e'#2#0#5'TMemo'#10'memoSource'#4'Left'#2#0#6'Heigh' - +'t'#3'h'#1#3'Top'#2#0#5'Width'#3'e'#2#5'Align'#7#8'alClient'#13'Lines.String' - +'s'#1#6#10'memoSource'#0#8'TabOrder'#2#0#0#0#0#0#11'TOpenDialog'#10'OpenDial' - +'og'#10'DefaultExt'#6#4'.htm'#6'Filter'#6'%html files|*.htm;*.html|all files' - +'|*.*'#7'Options'#11#14'ofHideReadOnly'#15'ofPathMustExist'#15'ofFileMustExi' - +'st'#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'O' - +'pen'#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'OpenTextFileClick'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16 - +'Open &Image File'#7'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'P' - +'rinterSetup1'#7'Caption'#6#16'Printer Setup...'#7'OnClick'#7#18'PrinterSetu' - +'p1Click'#0#0#9'TMenuItem'#12'Printpreview'#7'Caption'#6#14'Print pre&view'#7 - +'Enabled'#8#7'OnClick'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7 - +'Caption'#6#9'&Print...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMe' - +'nuItem'#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'&Copy'#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'Cap' - +'tion'#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'ShowIma' - +'ges'#7'Caption'#6#12'&Show images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'T' - +'MenuItem'#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 So' - +'urce and Debug info'#7'OnClick'#7#18'menuViewDebugClick'#0#0#0#9'TMenuItem' + +'r'#2#2#0#0#0#12'TPageControl'#11'pageBrowser'#4'Left'#2#0#6'Height'#3'i'#1#3 + +'Top'#2'!'#5'Width'#3'm'#2#10'ActivePage'#7#10'tabBrowser'#5'Align'#7#8'alCl' + +'ient'#8'ShowTabs'#8#8'TabIndex'#2#0#8'TabOrder'#2#2#0#9'TTabSheet'#10'tabBr' + +'owser'#7'Caption'#6#7'Browser'#12'ClientHeight'#3'g'#1#11'ClientWidth'#3'k' + +#2#0#6'TPanel'#6'Panel3'#4'Left'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3 + +'k'#2#5'Align'#7#8'alClient'#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7#6 + +'bvNone'#7'Caption'#6#6'Panel3'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tabDebu' + +'g'#7'Caption'#6#5'Debug'#12'ClientHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#5 + +'TMemo'#9'memoDebug'#4'Left'#2#0#6'Height'#3'h'#1#3'Top'#2#0#5'Width'#3'e'#2 + +#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#9'memoDebug'#0#8'TabOrder'#2#0 + +#0#0#0#9'TTabSheet'#9'tabSource'#7'Caption'#6#9'tabSource'#12'ClientHeight'#3 + +'g'#1#11'ClientWidth'#3'k'#2#0#5'TMemo'#10'memoSource'#4'Left'#2#0#6'Height' + +#3'h'#1#3'Top'#2#0#5'Width'#3'e'#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'.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'TMenuItem'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'Open'#7'Ca' + +'ption'#6#5'&Open'#8'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0#0#9'TMe' + +'nuItem'#12'OpenTextFile'#7'Caption'#6#15'Open &Text File'#7'OnClick'#7#17'O' + +'penTextFileClick'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16'Open &' + +'Image File'#7'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'Printer' + +'Setup1'#7'Caption'#6#16'Printer Setup...'#7'OnClick'#7#18'PrinterSetup1Clic' + +'k'#0#0#9'TMenuItem'#12'Printpreview'#7'Caption'#6#14'Print pre&view'#7'Enab' + +'led'#8#7'OnClick'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7'Capt' + +'ion'#6#9'&Print...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMenuIt' + +'em'#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'&Edi' + +'t'#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'Cap' + +'tion'#6#5'&Copy'#8'ShortCut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9'TMe' + +'nuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Captio' + +'n'#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'ShowImage' + +'s'#7'Caption'#6#12'&Show images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMe' + +'nuItem'#5'Fonts'#7'Caption'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'F' + +'ontColorsClick'#0#0#9'TMenuItem'#13'menuViewDebug'#7'Caption'#6#26'View Sou' + +'rce 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'TPrint' +'Dialog'#11'PrintDialog'#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7 diff --git a/applications/fpbrowser/mainform.pas b/applications/fpbrowser/mainform.pas index b879829b3..ddf933c96 100644 --- a/applications/fpbrowser/mainform.pas +++ b/applications/fpbrowser/mainform.pas @@ -1,34 +1,39 @@ -{$IFNDEF LCL} -{$ifdef ver140} -{$warn Symbol_Platform Off} -{$endif} -{$ifdef ver150} -{$warn Symbol_Platform Off} -{$Define UseXpMan} -{$endif} -{$ifdef ver170} -{$warn Symbol_Platform Off} -{$Define UseXpMan} -{$endif} -{$ENDIF} - unit mainform; -{A program to demonstrate the ThtmlViewer component} + +{$define FPBROWSER_TURBOPOWERIPRO} +{.$define FPBROWSER_THTMLCOMP} interface uses - {$IFNDEF LCL} Windows, Messages, MMSystem, MPlayer, {$ELSE} LclIntf, LMessages, LclType, LResources, FPimage, HtmlMisc, {$ENDIF} + LclIntf, LMessages, LclType, LResources, FPimage, SysUtils, Classes, Graphics, Controls, - Forms, Dialogs, ExtCtrls, Menus, Htmlview, StdCtrls, - Clipbrd, HTMLsubs, {$IFDEF MSWINDOWS} ShellAPI, {$ELSE} Unix, {$ENDIF} - {$IFDEF LCL} PrintersDlgs, {$ENDIF} - {$ifdef UseXpMan} XpMan, {$endif} {$IFNDEF LCL} Gauges, {$ENDIF} ComCtrls, + Forms, Dialogs, ExtCtrls, Menus, StdCtrls, Clipbrd, + 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; const MaxHistories = 6; {size of History list} type + + {$ifdef FPBROWSER_TURBOPOWERIPRO} + { TMyIpHtmlDataProvider } + + TMyIpHtmlDataProvider = class(TIpHtmlDataProvider) + protected + function DoGetStream(const URL: string): TStream; override; + end; + {$endif} + { TformBrowser } TformBrowser = class(TForm) @@ -81,9 +86,6 @@ type procedure editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure menuViewDebugClick(Sender: TObject); procedure OpenFileClick(Sender: TObject); - procedure HotSpotChange(Sender: TObject; const URL: string); - procedure HotSpotClick(Sender: TObject; const URL: string; - var Handled: boolean); procedure ShowImagesClick(Sender: TObject); procedure ReloadButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -105,9 +107,6 @@ type procedure SelectAllItemClick(Sender: TObject); procedure OpenTextFileClick(Sender: TObject); procedure OpenImageFileClick(Sender: TObject); - procedure MediaPlayerNotify(Sender: TObject); - procedure SoundRequest(Sender: TObject; const SRC: String; - Loop: Integer; Terminate: Boolean); procedure CopyImageToClipboardClick(Sender: TObject); procedure ObjectClick(Sender, Obj: TObject; const OnClick: String); procedure ViewerImageRequest(Sender: TObject; const SRC: string; @@ -116,24 +115,12 @@ type procedure FormDestroy(Sender: TObject); procedure ViewerInclude(Sender: TObject; const Command: String; Params: TStrings; var S: string); - procedure RightClick(Sender: TObject; - Parameters: TRightClickParameters); procedure OpenInNewWindowClick(Sender: TObject); procedure MetaTimerTimer(Sender: TObject); procedure MetaRefreshEvent(Sender: TObject; Delay: Integer; const URL: String); procedure PrintpreviewClick(Sender: TObject); - procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); procedure Timer1Timer(Sender: TObject); - 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 PrinterSetup1Click(Sender: TObject); private { Private declarations } @@ -142,7 +129,6 @@ type {$ENDIF} Histories: array[0..MaxHistories-1] of TMenuItem; MediaCount: integer; - FoundObject: TImageObj; NewWindowFile: string; NextFile, PresentFile: string; TimerCount: integer; @@ -150,15 +136,45 @@ type HintWindow: THintWindow; HintVisible: boolean; // - Viewer: THTMLViewer; - -{$IFNDEF LCL} - procedure wmDropFiles(var Message: TMessage); message wm_DropFiles; -{$ELSE} procedure DropFiles( Sender : TObject; const FileNames: array of string); -{$ENDIF} 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; @@ -174,11 +190,87 @@ var implementation uses - {$IFNDEF LCL} PreviewForm, {$ENDIF} HTMLun2, HTMLabt, Submit, ImgForm, FontDlg; + Submit, ImgForm;//, FontDlg; -{$IFNDEF LCL} -{$R *.DFM} -{$ENDIF} +{$ifdef FPBROWSER_TURBOPOWERIPRO} +function TMyIpHtmlDataProvider.DoGetStream(const URL: string): TStream; +var + ms: TMemoryStream; +begin + Result:=nil; + //debugln(['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 + //debugln(['TForm1.DataProvider1CanHandle ',URL]); + Result:=false; +end; + +procedure TformBrowser.DataProvider1CheckURL(Sender: TObject; const URL: string; + var Available: Boolean; var ContentType: string); +begin + //debugln(['TForm1.DataProvider1CheckURL ',URL]); + Available:=false; + ContentType:=''; +end; + +procedure TformBrowser.DataProvider1GetHtml(Sender: TObject; const URL: string; + const PostData: TIpFormDataEntity; var Stream: TStream); +begin + //debugln(['TForm1.DataProvider1GetHtml ',URL]); + Stream:=nil; +end; + +procedure TformBrowser.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string; + var Picture: TPicture); +begin + //debugln(['TForm1.DataProvider1GetImage ',URL]); + Picture:=nil; +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 @@ -186,6 +278,28 @@ var begin MyPageLoader := TPageLoader.Create; + {$ifdef FPBROWSER_TURBOPOWERIPRO} + DataProvider1:=TMyIpHtmlDataProvider.Create(Self); + with DataProvider1 do begin + Name:='DataProvider1'; + OnCanHandle:=DataProvider1CanHandle; + OnGetHtml:=DataProvider1GetHtml; + OnGetImage:=DataProvider1GetImage; + OnLeave:=DataProvider1Leave; + OnCheckURL:=DataProvider1CheckURL; + OnReportReference:=DataProvider1ReportReference; + end; + IpHtmlPanel1:=TIpHtmlPanel.Create(Self); + with IpHtmlPanel1 do begin + Name:='IpHtmlPanel1'; + Parent:=Self; + Align:=alClient; + DefaultFontSize:=10; + DataProvider:=DataProvider1; + end; + {$endif} + + {$ifdef FPBROWSER_THTMLCOMP} Viewer := THTMLViewer.Create(Self); Viewer.Left := 1; Viewer.Height := 358; @@ -226,29 +340,25 @@ begin Viewer.OnRightClick := RightClick; Viewer.Parent := Panel3; -{$IFNDEF LCL} -if Screen.Width <= 640 then - Position := poDefault; {keeps form on screen better} -{$ELSE} + ShowImages.Checked := Viewer.ViewImages; + Viewer.HistoryMaxCount := MaxHistories; {defines size of history list} + {$endif} + Position := poScreenCenter; -{$ENDIF} -{$IFNDEF DARWIN} -OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)); -{$ELSE} //Don't default to within app bundle. -OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + '../../../'; -{$ENDIF} + {$IFDEF DARWIN} //Don't default to within app bundle. + OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + '../../../'; + {$ELSE} + OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)); + {$ENDIF} -Caption := 'HTML Demo, Version '+HTMLAbt.Version; + Caption := 'HTML Demo, Version '+HTMLAbt.Version; -ShowImages.Checked := Viewer.ViewImages; -Viewer.HistoryMaxCount := MaxHistories; {defines size of history list} - -for I := 0 to MaxHistories-1 do + for I := 0 to MaxHistories-1 do begin {create the MenuItems for the history list} - Histories[I] := TMenuItem.Create(HistoryMenuItem); - HistoryMenuItem.Insert(I, Histories[I]); - with Histories[I] do + Histories[I] := TMenuItem.Create(HistoryMenuItem); + HistoryMenuItem.Insert(I, Histories[I]); + with Histories[I] do begin Visible := False; OnClick := HistoryClick; @@ -256,7 +366,7 @@ for I := 0 to MaxHistories-1 do end; end; -{$IFDEF LCLCarbon} + {$IFDEF LCLCarbon} AppMenu := TMenuItem.Create(Self); //Application menu AppMenu.Caption := #$EF#$A3#$BF; //Unicode Apple logo char MainMenu.Items.Insert(0, AppMenu); @@ -269,16 +379,13 @@ for I := 0 to MaxHistories-1 do Find1.ShortCut := ShortCut(VK_F, [ssMeta]); CopyItem.ShortCut := ShortCut(VK_C, [ssMeta]); SelectAllItem.ShortCut := ShortCut(VK_A, [ssMeta]); -{$ENDIF} + {$ENDIF} -{$IFNDEF LCL} -DragAcceptFiles(Handle, True); -{$ELSE} -AllowDropFiles := True; -OnDropFiles := DropFiles; -{$ENDIF} -HintWindow := THintWindow.Create(Self); -HintWindow.Color := $C0FFFF; + AllowDropFiles := True; + OnDropFiles := DropFiles; + + HintWindow := THintWindow.Create(Self); + HintWindow.Color := $C0FFFF; end; procedure TformBrowser.FormShow(Sender: TObject); @@ -289,27 +396,16 @@ begin // With OS X app, ParamStr not meaningful unless launched with --args switch. if (ParamCount >= 1) {$IFDEF DARWIN} and (Copy(ParamStr(1), 1, 4) <> '-psn') {$ENDIF} then begin {Parameter is file to load} - {$IFNDEF LCL} - S := CmdLine; - I := Pos('" ', S); - if I > 0 then - Delete(S, 1, I+1) {delete EXE name in quotes} - else Delete(S, 1, Length(ParamStr(0))); {in case no quote marks} - I := Pos('"', S); - while I > 0 do {remove any quotes from parameter} - begin - Delete(S, I, 1); - I := Pos('"', S); - end; - {$ELSE} - S := ParamStr(1); - {$ENDIF} - Viewer.LoadFromFile(HtmlToDos(Trim(S))); + S := ParamStr(1); + {$ifdef FPBROWSER_THTMLCOMP} + Viewer.LoadFromFile(HtmlToDos(Trim(S))); + {$endif} end; end; procedure TformBrowser.OpenFileClick(Sender: TObject); begin + {$ifdef FPBROWSER_THTMLCOMP} if Viewer.CurrentFile <> '' then OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'; //might have changed @@ -319,6 +415,7 @@ begin Viewer.LoadFromFile(OpenDialog.Filename); Caption := Viewer.DocumentTitle; end; + {$endif} end; procedure TformBrowser.editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); @@ -335,6 +432,7 @@ 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 @@ -471,30 +569,33 @@ begin 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} end; procedure TformBrowser.ReloadButtonClick(Sender: TObject); {the Reload button was clicked} begin -with Viewer do - begin - ReLoadButton.Enabled := False; - ReLoad; - ReLoadButton.Enabled := CurrentFile <> ''; + {$ifdef FPBROWSER_THTMLCOMP} + Viewer.ReLoadButton.Enabled := False; + Viewer.ReLoad; + Viewer.ReLoadButton.Enabled := CurrentFile <> ''; Viewer.SetFocus; - end; + {$endif} end; procedure TformBrowser.FwdBackClick(Sender: TObject); {Either the Forward or Back button was clicked} begin -with Viewer do + {$ifdef FPBROWSER_THTMLCOMP} + with Viewer do begin if Sender = BackButton then HistoryIndex := HistoryIndex +1 @@ -502,6 +603,7 @@ with Viewer do HistoryIndex := HistoryIndex -1; Self.Caption := DocumentTitle; end; + {$endif} end; procedure TformBrowser.HistoryChange(Sender: TObject); @@ -510,6 +612,7 @@ var I: integer; Cap: string[80]; begin +{$ifdef FPBROWSER_THTMLCOMP} with Sender as ThtmlViewer do begin {check to see which buttons are to be enabled} @@ -533,13 +636,16 @@ with Sender as ThtmlViewer do Caption := DocumentTitle; {keep the caption updated} Viewer.SetFocus; end; +{$endif} end; -procedure TformBrowser.HistoryClick(Sender: TObject); {A history list menuitem got clicked on} +procedure TformBrowser.HistoryClick(Sender: TObject); begin +{$ifdef FPBROWSER_THTMLCOMP} {Changing the HistoryIndex loads and positions the appropriate document} Viewer.HistoryIndex := (Sender as TMenuItem).Tag; +{$endif} end; procedure TformBrowser.Exit1Click(Sender: TObject); @@ -548,10 +654,10 @@ Close; end; procedure TformBrowser.FontColorsClick(Sender: TObject); -var - FontForm: TFontForm; +{var + FontForm: TFontForm;} begin -FontForm := TFontForm.Create(Self); +(*FontForm := TFontForm.Create(Self); try with FontForm do begin @@ -572,27 +678,29 @@ try end; finally FontForm.Free; - end; + end;*) end; procedure TformBrowser.Print1Click(Sender: TObject); begin +{$ifdef FPBROWSER_THTMLCOMP} with PrintDialog do if Execute then if PrintRange = prAllPages then viewer.Print(1, 9999) else Viewer.Print(FromPage, ToPage); +{$endif} end; procedure TformBrowser.PrinterSetup1Click(Sender: TObject); begin -{$IFNDEF LCLCarbon} -PrinterSetupDialog.Execute; -{$ELSE} + {$IFNDEF LCLCarbon} + PrinterSetupDialog.Execute; + {$ELSE} MessageDlg('Not yet supported with Carbon widgetset.', mtError, [mbOK], 0); -{$ENDIF} + {$ENDIF} end; procedure TformBrowser.About1Click(Sender: TObject); @@ -626,15 +734,18 @@ end; procedure TformBrowser.FindDialogFind(Sender: TObject); begin +{$ifdef FPBROWSER_THTMLCOMP} with FindDialog do begin if not Viewer.FindEx(FindText, frMatchCase in Options, not (frDown in Options)) then MessageDlg('No further occurances of "'+FindText+'"', mtInformation, [mbOK], 0); end; +{$endif} end; procedure TformBrowser.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean); begin +{$ifdef FPBROWSER_THTMLCOMP} if ProcessingOn then begin {disable various buttons and menuitems during processing} FwdButton.Enabled := False; @@ -658,25 +769,33 @@ else SelectAllItem.Enabled := Viewer.CurrentFile <> ''; Open.Enabled := True; end; + {$endif} end; procedure TformBrowser.CopyItemClick(Sender: TObject); begin -Viewer.CopyToClipboard; + {$ifdef FPBROWSER_THTMLCOMP} + Viewer.CopyToClipboard; + {$endif} end; procedure TformBrowser.Edit2Click(Sender: TObject); begin -CopyItem.Enabled := Viewer.SelLength <> 0; + {$ifdef FPBROWSER_THTMLCOMP} + CopyItem.Enabled := Viewer.SelLength <> 0; + {$endif} end; procedure TformBrowser.SelectAllItemClick(Sender: TObject); begin -Viewer.SelectAll; + {$ifdef FPBROWSER_THTMLCOMP} + Viewer.SelectAll; + {$endif} end; procedure TformBrowser.OpenTextFileClick(Sender: TObject); begin +{$ifdef FPBROWSER_THTMLCOMP} if Viewer.CurrentFile <> '' then OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'+ @@ -693,10 +812,12 @@ if OpenDialog.Execute then ReLoadButton.Enabled := True; end; end; +{$endif} end; procedure TformBrowser.OpenImageFileClick(Sender: TObject); begin +{$ifdef FPBROWSER_THTMLCOMP} if Viewer.CurrentFile <> '' then OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.Filter := 'Graphics Files (*.bmp,*.gif,*.jpg,*.jpeg,*.png)|'+ @@ -712,29 +833,17 @@ if OpenDialog.Execute then ReLoadButton.Enabled := True; end; end; +{$endif} end; -{$IFNDEF LCL} -procedure TformBrowser.wmDropFiles(var Message: TMessage); -var - S: string[200]; - Ext: string; - Count: integer; -begin -Count := DragQueryFile(Message.WParam, 0, @S[1], 200); -Length(S) := Count; -DragFinish(Message.WParam); -if Count >0 then - begin -{$ELSE} procedure TformBrowser.DropFiles( Sender : TObject; const FileNames : array of string); var S : string; Ext: string; begin +{$ifdef FPBROWSER_THTMLCOMP} S := FileNames[0]; -{$ENDIF} Ext := LowerCase(ExtractFileExt(S)); if (Ext = '.htm') or (Ext = '.html') then Viewer.LoadFromFile(S) @@ -743,73 +852,33 @@ begin else if (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.jpg') or (Ext = '.jpeg') or (Ext = '.png') then Viewer.LoadImageFile(S); -{$IFNDEF LCL} - end; -Message.Result := 0; -{$ENDIF} -end; - -procedure TformBrowser.MediaPlayerNotify(Sender: TObject); -begin -{$IFNDEF LCL} -try - With MediaPlayer do - if NotifyValue = nvSuccessful then - begin - if MediaCount > 0 then - begin - Play; - Dec(MediaCount); - end - else - Close; - end; -except - end; -{$ENDIF} -end; - -procedure TformBrowser.SoundRequest(Sender: TObject; const SRC: String; - Loop: Integer; Terminate: Boolean); -begin -{$IFNDEF LCL} -try - with MediaPlayer do - if Terminate then - Close - else - begin - Filename := (Sender as ThtmlViewer).HTMLExpandFilename(SRC); - Notify := True; - Open; - if Loop < 0 then MediaCount := 9999 - else if Loop = 0 then MediaCount := 1 - else MediaCount := Loop; - end; -except - end; -{$ENDIF} + {$endif} end; procedure TformBrowser.ViewimageClick(Sender: TObject); var AForm: TImageForm; begin + {$ifdef FPBROWSER_THTMLCOMP} AForm := TImageForm.Create(Self); AForm.ImageFormBitmap := FoundObject.Bitmap; AForm.Caption := ''; AForm.Show; + {$endif} end; procedure TformBrowser.CopyImageToClipboardClick(Sender: TObject); begin + {$ifdef FPBROWSER_THTMLCOMP} Clipboard.Assign(FoundObject.Bitmap); + {$endif} end; procedure TformBrowser.ObjectClick(Sender, Obj: TObject; const OnClick: String); var S: string; begin +{$ifdef FPBROWSER_THTMLCOMP} if OnClick = 'display' then begin if Obj is TFormControlObj then @@ -833,6 +902,7 @@ if OnClick = 'display' then end else if OnClick <> '' then MessageDlg(OnClick, mtCustom, [mbOK], 0); +{$endif} end; { In this event we should provide images for the html component } @@ -895,6 +965,7 @@ begin MyPageLoader.Free; end; +{$ifdef FPBROWSER_THTMLCOMP} procedure TformBrowser.RightClick(Sender: TObject; Parameters: TRightClickParameters); var Pt: TPoint; @@ -943,6 +1014,7 @@ begin else PopupMenu.Popup(Pt.X, Pt.Y); end; end; +{$endif} procedure TformBrowser.OpenInNewWindowClick(Sender: TObject); var @@ -971,17 +1043,20 @@ end; procedure TformBrowser.MetaTimerTimer(Sender: TObject); begin +{$ifdef FPBROWSER_THTMLCOMP} MetaTimer.Enabled := False; if Viewer.CurrentFile = PresentFile then {don't load if current file has changed} begin Viewer.LoadFromFile(NextFile); Caption := Viewer.DocumentTitle; end; + {$ENDIF} end; procedure TformBrowser.MetaRefreshEvent(Sender: TObject; Delay: Integer; const URL: String); begin +{$ifdef FPBROWSER_THTMLCOMP} NextFile := Viewer.HTMLExpandFilename(URL); if FileExists(NextFile) then begin @@ -989,6 +1064,7 @@ begin MetaTimer.Interval := Delay*1000; MetaTimer.Enabled := True; end; + {$ENDIF} end; procedure TformBrowser.PrintpreviewClick(Sender: TObject); @@ -1011,6 +1087,7 @@ begin {$ENDIF} end; +{$ifdef FPBROWSER_THTMLCOMP} procedure TformBrowser.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var TitleStr: string; @@ -1028,6 +1105,7 @@ begin end; end; end; +{$ENDIF} procedure TformBrowser.CloseAll; begin @@ -1054,8 +1132,13 @@ end; procedure TformBrowser.HandlePageLoaderTerminated(Sender: TObject); begin + {$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(); @@ -1074,41 +1157,39 @@ var TitleStr: string; begin -Inc(TimerCount); -GetCursorPos(Pt); -Pt1 := Viewer.ScreenToClient(Pt); -TitleStr := Viewer.TitleAttr; -if (TitleStr = '') or not PtInRect(Viewer.ClientRect, Pt1)then - begin - OldTitle := ''; - CloseAll; - Exit; - end; -if TitleStr <> OldTitle then - begin - TimerCount := 0; - OldTitle := TitleStr; - HintWindow.ReleaseHandle; - HintVisible := False; - Exit; +{$ifdef FPBROWSER_THTMLCOMP} + Inc(TimerCount); + GetCursorPos(Pt); + Pt1 := Viewer.ScreenToClient(Pt); + TitleStr := Viewer.TitleAttr; + if (TitleStr = '') or not PtInRect(Viewer.ClientRect, Pt1)then + begin + OldTitle := ''; + CloseAll; + Exit; + end; + if TitleStr <> OldTitle then + begin + TimerCount := 0; + OldTitle := TitleStr; + HintWindow.ReleaseHandle; + HintVisible := False; + Exit; end; -if TimerCount > EndCount then - CloseAll -else if (TimerCount >= StartCount) and not HintVisible then + if TimerCount > EndCount then + CloseAll + else if (TimerCount >= StartCount) and not HintVisible then begin - {$ifdef ver90} {Delphi 2} - ARect := Rect(0,0,0,0); - DrawText(HintWindow.Canvas.Handle, PChar(TitleStr), Length(TitleStr), ARect, DT_CALCRECT); - {$else} - ARect := HintWindow.CalcHintRect(300, TitleStr, Nil); - {$endif} - with ARect do - HintWindow.ActivateHint(Rect(Pt.X, Pt.Y+18, Pt.X+Right, Pt.Y+18+Bottom), TitleStr); - HintVisible := True; + ARect := HintWindow.CalcHintRect(300, TitleStr, Nil); + with ARect do + HintWindow.ActivateHint(Rect(Pt.X, Pt.Y+18, Pt.X+Right, Pt.Y+18+Bottom), TitleStr); + HintVisible := True; end; +{$endif} end; +{$ifdef FPBROWSER_THTMLCOMP} procedure TformBrowser.ViewerProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Integer); begin @@ -1122,6 +1203,7 @@ case Stage of end; ProgressBar.Update; end; +{$endif} {HTML for print header and footer} const @@ -1150,6 +1232,7 @@ if I > 0 then end; end; +{$ifdef FPBROWSER_THTMLCOMP} procedure TformBrowser.ViewerPrintHTMLHeader(Sender: TObject; HFViewer: THTMLViewer; NumPage: Integer; LastPage: boolean; var XL, XR: integer; var StopPrinting: Boolean); var @@ -1169,6 +1252,7 @@ S := ReplaceStr(HFText, '#left', DateToStr(Date)); S := ReplaceStr(S, '#right', 'Page '+IntToStr(NumPage)); HFViewer.LoadFromString(S); end; +{$endif} initialization {$IFDEF LCL} diff --git a/applications/fpbrowser/pageloader.pas b/applications/fpbrowser/pageloader.pas index 29109a1b9..c5c82449e 100644 --- a/applications/fpbrowser/pageloader.pas +++ b/applications/fpbrowser/pageloader.pas @@ -15,6 +15,7 @@ type public Contents: string; LastPageURL: string; + UserAgent: string; ContentsList: TStringList; DebugInfo: TStringList; constructor Create; @@ -68,6 +69,7 @@ constructor TPageLoader.Create; begin ContentsList := TStringList.Create; DebugInfo := TStringList.Create; + UserAgent := 'FPBrowser/1.0 (X11; Linux i686; Mobile; U; en-GB)'; end; destructor TPageLoader.Destroy; @@ -93,8 +95,7 @@ begin Client.Headers.Add('Accept-Language: en-gb,en;q=0.5'); // Client.Headers.Add('Accept-Encoding: gzip,deflate'); Client.Headers.Add('Accept-Charset: utf-8;q=0.7,*;q=0.7'); // ISO-8859-1, - -// Client.UserAgent := AUserAgent; + Client.UserAgent := UserAgent; Client.HttpMethod('GET', LastPageURL); // Client.Headers;