pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpbrowser: Changes from thtmlcomp to turbopoweripro, but leaves defines for htmlcomp

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1924 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-09-08 14:12:42 +00:00
parent 6c92813485
commit 9f5841738c
8 changed files with 354 additions and 273 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
applications/fpbrowser/fontdlg.pas
View File

@@ -3,9 +3,10 @@ unit Fontdlg;
interface interface
uses uses
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF} LclIntf, LMessages, LclType, LResources,
SysUtils, Classes, Graphics, Controls, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, {$IFNDEF LCL} ColorGrd, {$ENDIF} Htmlview, Spin; Htmlview
Forms, Dialogs, StdCtrls, ColorGrd, Spin;
type type
TFontForm = class(TForm) TFontForm = class(TForm)

11
applications/fpbrowser/fpbrowser.dpr
View File

@@ -1,23 +1,20 @@
program fpbrowser; program fpbrowser;
{A program to demonstrate the ThtmlViewer component}
uses uses
{$IFDEF UNIX} {$IFDEF UNIX}
cthreads, cthreads,
{$ENDIF} {$ENDIF}
{$IFDEF LCL}
Interfaces, Interfaces,
{$ENDIF} Forms,
Forms, printer4lazarus, laz_synapse, printer4lazarus, turbopoweripro, laz_synapse,
mainform {Form1}, mainform {Form1},
Submit in 'Submit.pas' {SubmitForm}, Submit in 'Submit.pas' {SubmitForm},
Fontdlg in 'Fontdlg.pas' {FontForm},
Htmlabt in 'Htmlabt.pas' {AboutBox}, Htmlabt in 'Htmlabt.pas' {AboutBox},
{$IFNDEF LCL} (* Fontdlg in 'Fontdlg.pas' {FontForm},
PreviewForm in 'PreviewForm.pas' {PreviewForm}, PreviewForm in 'PreviewForm.pas' {PreviewForm},
Gopage in 'Gopage.pas' {GoPageForm}, Gopage in 'Gopage.pas' {GoPageForm},
PrintStatusForm in 'PrintStatusForm.pas' {PrnStatusForm}, PrintStatusForm in 'PrintStatusForm.pas' {PrnStatusForm},
{$ENDIF} *)
ImgForm in 'ImgForm.pas', pageloader, browsermodules {ImageForm}; ImgForm in 'ImgForm.pas', pageloader, browsermodules {ImageForm};
begin begin

9
applications/fpbrowser/fpbrowser.lpi
View File

@@ -32,17 +32,16 @@
</RunParams> </RunParams>
<RequiredPackages Count="4"> <RequiredPackages Count="4">
<Item1> <Item1>
<PackageName Value="Printer4Lazarus"/> <PackageName Value="TurboPowerIPro"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="laz_synapse"/> <PackageName Value="Printer4Lazarus"/>
</Item2> </Item2>
<Item3> <Item3>
<PackageName Value="LCL"/> <PackageName Value="laz_synapse"/>
</Item3> </Item3>
<Item4> <Item4>
<PackageName Value="htmlcomp"/> <PackageName Value="LCL"/>
<DefaultFilename Value="../../components/thtmlport/package/htmlcomp.lpk" Prefer="True"/>
</Item4> </Item4>
</RequiredPackages> </RequiredPackages>
<Units Count="7"> <Units Count="7">

9
applications/fpbrowser/htmlabt.pas
View File

@@ -3,9 +3,9 @@ unit HTMLAbt;
interface interface
uses uses
{$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, LCLVersion, {$ENDIF} LclIntf, LMessages, LclType, LResources, LCLVersion,
SysUtils, Classes, Graphics, Controls, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, Htmlview, ExtCtrls; Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;
const const
Version = '9.45'; Version = '9.45';
@@ -14,7 +14,6 @@ type
TAboutBox = class(TForm) TAboutBox = class(TForm)
BitBtn1: TBitBtn; BitBtn1: TBitBtn;
Panel1: TPanel; Panel1: TPanel;
Viewer: THTMLViewer;
private private
{ Private declarations } { Private declarations }
public public
@@ -36,7 +35,7 @@ var
S: string[210]; S: string[210];
begin begin
inherited Create(Owner); inherited Create(Owner);
//Viewer.DefFontName := 'MS Sans Serif'; //Windows-only font (*//Viewer.DefFontName := 'MS Sans Serif'; //Windows-only font
Viewer.DefFontName := 'Arial'; Viewer.DefFontName := 'Arial';
Viewer.DefFontSize := 9; Viewer.DefFontSize := 9;
Viewer.DefFontColor := clNavy; Viewer.DefFontColor := clNavy;
@@ -81,7 +80,7 @@ S :='<body bgcolor="ffffeb" text="000080">'+
'</center>'+ '</center>'+
'</body>'; '</body>';
Viewer.LoadFromBuffer(@S[1], Length(S), ''); Viewer.LoadFromBuffer(@S[1], Length(S), '');*)
end; end;
initialization initialization

22
applications/fpbrowser/mainform.lfm
View File

@@ -3,7 +3,7 @@ object formBrowser: TformBrowser
Height = 439 Height = 439
Top = 186 Top = 186
Width = 621 Width = 621
ClientHeight = 439 ClientHeight = 412
ClientWidth = 621 ClientWidth = 621
Color = clBtnFace Color = clBtnFace
Font.Color = clWindowText Font.Color = clWindowText
@@ -18,7 +18,7 @@ object formBrowser: TformBrowser
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 18 Height = 18
Top = 421 Top = 394
Width = 621 Width = 621
Align = alBottom Align = alBottom
Alignment = taLeftJustify Alignment = taLeftJustify
@@ -90,7 +90,7 @@ object formBrowser: TformBrowser
end end
object pageBrowser: TPageControl object pageBrowser: TPageControl
Left = 0 Left = 0
Height = 388 Height = 361
Top = 33 Top = 33
Width = 621 Width = 621
ActivePage = tabBrowser ActivePage = tabBrowser
@@ -100,13 +100,13 @@ object formBrowser: TformBrowser
TabOrder = 2 TabOrder = 2
object tabBrowser: TTabSheet object tabBrowser: TTabSheet
Caption = 'Browser' Caption = 'Browser'
ClientHeight = 381 ClientHeight = 359
ClientWidth = 613 ClientWidth = 619
object Panel3: TPanel object Panel3: TPanel
Left = 0 Left = 0
Height = 381 Height = 359
Top = 0 Top = 0
Width = 613 Width = 619
Align = alClient Align = alClient
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
@@ -116,8 +116,8 @@ object formBrowser: TformBrowser
end end
object tabDebug: TTabSheet object tabDebug: TTabSheet
Caption = 'Debug' Caption = 'Debug'
ClientHeight = 360 ClientHeight = 359
ClientWidth = 613 ClientWidth = 619
object memoDebug: TMemo object memoDebug: TMemo
Left = 0 Left = 0
Height = 360 Height = 360
@@ -132,8 +132,8 @@ object formBrowser: TformBrowser
end end
object tabSource: TTabSheet object tabSource: TTabSheet
Caption = 'tabSource' Caption = 'tabSource'
ClientHeight = 360 ClientHeight = 359
ClientWidth = 613 ClientWidth = 619
object memoSource: TMemo object memoSource: TMemo
Left = 0 Left = 0
Height = 360 Height = 360

80
applications/fpbrowser/mainform.lrs
View File

@@ -2,12 +2,12 @@
LazarusResources.Add('TformBrowser','FORMDATA',[ LazarusResources.Add('TformBrowser','FORMDATA',[
'TPF0'#12'TformBrowser'#11'formBrowser'#4'Left'#3'G'#1#6'Height'#3#183#1#3'To' '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 +'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' +#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 +'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 +'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 +'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' +'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' +'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' +'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 +'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' +'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 +'r'#2#2#0#0#0#12'TPageControl'#11'pageBrowser'#4'Left'#2#0#6'Height'#3'i'#1#3
+#3'Top'#2'!'#5'Width'#3'm'#2#10'ActivePage'#7#10'tabBrowser'#5'Align'#7#8'al' +'Top'#2'!'#5'Width'#3'm'#2#10'ActivePage'#7#10'tabBrowser'#5'Align'#7#8'alCl'
+'Client'#8'ShowTabs'#8#8'TabIndex'#2#0#8'TabOrder'#2#2#0#9'TTabSheet'#10'tab' +'ient'#8'ShowTabs'#8#8'TabIndex'#2#0#8'TabOrder'#2#2#0#9'TTabSheet'#10'tabBr'
+'Browser'#7'Caption'#6#7'Browser'#12'ClientHeight'#3'}'#1#11'ClientWidth'#3 +'owser'#7'Caption'#6#7'Browser'#12'ClientHeight'#3'g'#1#11'ClientWidth'#3'k'
+'e'#2#0#6'TPanel'#6'Panel3'#4'Left'#2#0#6'Height'#3'}'#1#3'Top'#2#0#5'Width' +#2#0#6'TPanel'#6'Panel3'#4'Left'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3
+#3'e'#2#5'Align'#7#8'alClient'#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7 +'k'#2#5'Align'#7#8'alClient'#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7#6
+#6'bvNone'#7'Caption'#6#6'Panel3'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tabDe' +'bvNone'#7'Caption'#6#6'Panel3'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tabDebu'
+'bug'#7'Caption'#6#5'Debug'#12'ClientHeight'#3'h'#1#11'ClientWidth'#3'e'#2#0 +'g'#7'Caption'#6#5'Debug'#12'ClientHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#5
+#5'TMemo'#9'memoDebug'#4'Left'#2#0#6'Height'#3'h'#1#3'Top'#2#0#5'Width'#3'e' +'TMemo'#9'memoDebug'#4'Left'#2#0#6'Height'#3'h'#1#3'Top'#2#0#5'Width'#3'e'#2
+#2#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#9'memoDebug'#0#8'TabOrder'#2 +#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#9'memoDebug'#0#8'TabOrder'#2#0
+#0#0#0#0#9'TTabSheet'#9'tabSource'#7'Caption'#6#9'tabSource'#12'ClientHeight' +#0#0#0#9'TTabSheet'#9'tabSource'#7'Caption'#6#9'tabSource'#12'ClientHeight'#3
+#3'h'#1#11'ClientWidth'#3'e'#2#0#5'TMemo'#10'memoSource'#4'Left'#2#0#6'Heigh' +'g'#1#11'ClientWidth'#3'k'#2#0#5'TMemo'#10'memoSource'#4'Left'#2#0#6'Height'
+'t'#3'h'#1#3'Top'#2#0#5'Width'#3'e'#2#5'Align'#7#8'alClient'#13'Lines.String' +#3'h'#1#3'Top'#2#0#5'Width'#3'e'#2#5'Align'#7#8'alClient'#13'Lines.Strings'#1
+'s'#1#6#10'memoSource'#0#8'TabOrder'#2#0#0#0#0#0#11'TOpenDialog'#10'OpenDial' +#6#10'memoSource'#0#8'TabOrder'#2#0#0#0#0#0#11'TOpenDialog'#10'OpenDialog'#10
+'og'#10'DefaultExt'#6#4'.htm'#6'Filter'#6'%html files|*.htm;*.html|all files' +'DefaultExt'#6#4'.htm'#6'Filter'#6'%html files|*.htm;*.html|all files|*.*'#7
+'|*.*'#7'Options'#11#14'ofHideReadOnly'#15'ofPathMustExist'#15'ofFileMustExi' +'Options'#11#14'ofHideReadOnly'#15'ofPathMustExist'#15'ofFileMustExist'#0#4
+'st'#0#4'left'#3'I'#1#3'top'#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3'#'#1 +'left'#3'I'#1#3'top'#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3'#'#1#3'top'#2
+#3'top'#2#4#0#9'TMenuItem'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'O' +#4#0#9'TMenuItem'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'Open'#7'Ca'
+'pen'#7'Caption'#6#5'&Open'#8'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0 +'ption'#6#5'&Open'#8'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0#0#9'TMe'
+#0#9'TMenuItem'#12'OpenTextFile'#7'Caption'#6#15'Open &Text File'#7'OnClick' +'nuItem'#12'OpenTextFile'#7'Caption'#6#15'Open &Text File'#7'OnClick'#7#17'O'
+#7#17'OpenTextFileClick'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16 +'penTextFileClick'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16'Open &'
+'Open &Image File'#7'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'P' +'Image File'#7'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'Printer'
+'rinterSetup1'#7'Caption'#6#16'Printer Setup...'#7'OnClick'#7#18'PrinterSetu' +'Setup1'#7'Caption'#6#16'Printer Setup...'#7'OnClick'#7#18'PrinterSetup1Clic'
+'p1Click'#0#0#9'TMenuItem'#12'Printpreview'#7'Caption'#6#14'Print pre&view'#7 +'k'#0#0#9'TMenuItem'#12'Printpreview'#7'Caption'#6#14'Print pre&view'#7'Enab'
+'Enabled'#8#7'OnClick'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7 +'led'#8#7'OnClick'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7'Capt'
+'Caption'#6#9'&Print...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMe' +'ion'#6#9'&Print...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMenuIt'
+'nuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'E&' +'em'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'E&xit'
+'xit'#7'OnClick'#7#10'Exit1Click'#0#0#0#9'TMenuItem'#5'Edit2'#7'Caption'#6#5 +#7'OnClick'#7#10'Exit1Click'#0#0#0#9'TMenuItem'#5'Edit2'#7'Caption'#6#5'&Edi'
+'&Edit'#7'OnClick'#7#10'Edit2Click'#0#9'TMenuItem'#5'Find1'#7'Caption'#6#5'&' +'t'#7'OnClick'#7#10'Edit2Click'#0#9'TMenuItem'#5'Find1'#7'Caption'#6#5'&Find'
+'Find'#7'Enabled'#8#7'OnClick'#7#10'Find1Click'#0#0#9'TMenuItem'#8'CopyItem' +#7'Enabled'#8#7'OnClick'#7#10'Find1Click'#0#0#9'TMenuItem'#8'CopyItem'#7'Cap'
+#7'Caption'#6#5'&Copy'#8'ShortCut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9 +'tion'#6#5'&Copy'#8'ShortCut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9'TMe'
+'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Cap' +'nuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Captio'
+'tion'#6#11'Select &All'#7'Enabled'#8#7'OnClick'#7#18'SelectAllItemClick'#0#0 +'n'#6#11'Select &All'#7'Enabled'#8#7'OnClick'#7#18'SelectAllItemClick'#0#0#0
+#0#9'TMenuItem'#8'options1'#7'Caption'#6#6'&Tools'#0#9'TMenuItem'#10'ShowIma' +#9'TMenuItem'#8'options1'#7'Caption'#6#6'&Tools'#0#9'TMenuItem'#10'ShowImage'
+'ges'#7'Caption'#6#12'&Show images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'T' +'s'#7'Caption'#6#12'&Show images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMe'
+'MenuItem'#5'Fonts'#7'Caption'#6#23'Default &Font/Colors...'#7'OnClick'#7#15 +'nuItem'#5'Fonts'#7'Caption'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'F'
+'FontColorsClick'#0#0#9'TMenuItem'#13'menuViewDebug'#7'Caption'#6#26'View So' +'ontColorsClick'#0#0#9'TMenuItem'#13'menuViewDebug'#7'Caption'#6#26'View Sou'
+'urce and Debug info'#7'OnClick'#7#18'menuViewDebugClick'#0#0#0#9'TMenuItem' +'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 +#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' +'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 +'Dialog'#11'PrintDialog'#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7

486
applications/fpbrowser/mainform.pas
View File

@@ -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; unit mainform;
{A program to demonstrate the ThtmlViewer component}
{$define FPBROWSER_TURBOPOWERIPRO}
{.$define FPBROWSER_THTMLCOMP}
interface interface
uses uses
{$IFNDEF LCL} Windows, Messages, MMSystem, MPlayer, {$ELSE} LclIntf, LMessages, LclType, LResources, FPimage, HtmlMisc, {$ENDIF} LclIntf, LMessages, LclType, LResources, FPimage,
SysUtils, Classes, Graphics, Controls, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, Menus, Htmlview, StdCtrls, Forms, Dialogs, ExtCtrls, Menus, StdCtrls, Clipbrd,
Clipbrd, HTMLsubs, {$IFDEF MSWINDOWS} ShellAPI, {$ELSE} Unix, {$ENDIF} PrintersDlgs,
{$IFDEF LCL} PrintersDlgs, {$ENDIF} ComCtrls,
{$ifdef UseXpMan} XpMan, {$endif} {$IFNDEF LCL} Gauges, {$ENDIF} 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;
const const
MaxHistories = 6; {size of History list} MaxHistories = 6; {size of History list}
type type
{$ifdef FPBROWSER_TURBOPOWERIPRO}
{ TMyIpHtmlDataProvider }
TMyIpHtmlDataProvider = class(TIpHtmlDataProvider)
protected
function DoGetStream(const URL: string): TStream; override;
end;
{$endif}
{ TformBrowser } { TformBrowser }
TformBrowser = class(TForm) TformBrowser = class(TForm)
@@ -81,9 +86,6 @@ type
procedure editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure menuViewDebugClick(Sender: TObject); procedure menuViewDebugClick(Sender: TObject);
procedure OpenFileClick(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 ShowImagesClick(Sender: TObject);
procedure ReloadButtonClick(Sender: TObject); procedure ReloadButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
@@ -105,9 +107,6 @@ type
procedure SelectAllItemClick(Sender: TObject); procedure SelectAllItemClick(Sender: TObject);
procedure OpenTextFileClick(Sender: TObject); procedure OpenTextFileClick(Sender: TObject);
procedure OpenImageFileClick(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 CopyImageToClipboardClick(Sender: TObject);
procedure ObjectClick(Sender, Obj: TObject; const OnClick: String); procedure ObjectClick(Sender, Obj: TObject; const OnClick: String);
procedure ViewerImageRequest(Sender: TObject; const SRC: string; procedure ViewerImageRequest(Sender: TObject; const SRC: string;
@@ -116,24 +115,12 @@ type
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure ViewerInclude(Sender: TObject; const Command: String; procedure ViewerInclude(Sender: TObject; const Command: String;
Params: TStrings; var S: string); Params: TStrings; var S: string);
procedure RightClick(Sender: TObject;
Parameters: TRightClickParameters);
procedure OpenInNewWindowClick(Sender: TObject); procedure OpenInNewWindowClick(Sender: TObject);
procedure MetaTimerTimer(Sender: TObject); procedure MetaTimerTimer(Sender: TObject);
procedure MetaRefreshEvent(Sender: TObject; Delay: Integer; procedure MetaRefreshEvent(Sender: TObject; Delay: Integer;
const URL: String); const URL: String);
procedure PrintpreviewClick(Sender: TObject); procedure PrintpreviewClick(Sender: TObject);
procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Timer1Timer(Sender: TObject); 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); procedure PrinterSetup1Click(Sender: TObject);
private private
{ Private declarations } { Private declarations }
@@ -142,7 +129,6 @@ type
{$ENDIF} {$ENDIF}
Histories: array[0..MaxHistories-1] of TMenuItem; Histories: array[0..MaxHistories-1] of TMenuItem;
MediaCount: integer; MediaCount: integer;
FoundObject: TImageObj;
NewWindowFile: string; NewWindowFile: string;
NextFile, PresentFile: string; NextFile, PresentFile: string;
TimerCount: integer; TimerCount: integer;
@@ -150,15 +136,45 @@ type
HintWindow: THintWindow; HintWindow: THintWindow;
HintVisible: boolean; HintVisible: boolean;
// //
Viewer: THTMLViewer;
{$IFNDEF LCL}
procedure wmDropFiles(var Message: TMessage); message wm_DropFiles;
{$ELSE}
procedure DropFiles( Sender : TObject; procedure DropFiles( Sender : TObject;
const FileNames: array of string); const FileNames: array of string);
{$ENDIF}
procedure CloseAll; 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
{ Public declarations } { Public declarations }
MyPageLoaderThread: TPageLoaderThread; MyPageLoaderThread: TPageLoaderThread;
@@ -174,11 +190,87 @@ var
implementation implementation
uses uses
{$IFNDEF LCL} PreviewForm, {$ENDIF} HTMLun2, HTMLabt, Submit, ImgForm, FontDlg; Submit, ImgForm;//, FontDlg;
{$IFNDEF LCL} {$ifdef FPBROWSER_TURBOPOWERIPRO}
{$R *.DFM} function TMyIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
{$ENDIF} 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); procedure TformBrowser.FormCreate(Sender: TObject);
var var
@@ -186,6 +278,28 @@ var
begin begin
MyPageLoader := TPageLoader.Create; 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 := THTMLViewer.Create(Self);
Viewer.Left := 1; Viewer.Left := 1;
Viewer.Height := 358; Viewer.Height := 358;
@@ -226,29 +340,25 @@ begin
Viewer.OnRightClick := RightClick; Viewer.OnRightClick := RightClick;
Viewer.Parent := Panel3; Viewer.Parent := Panel3;
{$IFNDEF LCL} ShowImages.Checked := Viewer.ViewImages;
if Screen.Width <= 640 then Viewer.HistoryMaxCount := MaxHistories; {defines size of history list}
Position := poDefault; {keeps form on screen better} {$endif}
{$ELSE}
Position := poScreenCenter; Position := poScreenCenter;
{$ENDIF}
{$IFNDEF DARWIN} {$IFDEF DARWIN} //Don't default to within app bundle.
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)); OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + '../../../';
{$ELSE} //Don't default to within app bundle. {$ELSE}
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + '../../../'; OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
{$ENDIF} {$ENDIF}
Caption := 'HTML Demo, Version '+HTMLAbt.Version; Caption := 'HTML Demo, Version '+HTMLAbt.Version;
ShowImages.Checked := Viewer.ViewImages; for I := 0 to MaxHistories-1 do
Viewer.HistoryMaxCount := MaxHistories; {defines size of history list}
for I := 0 to MaxHistories-1 do
begin {create the MenuItems for the history list} begin {create the MenuItems for the history list}
Histories[I] := TMenuItem.Create(HistoryMenuItem); Histories[I] := TMenuItem.Create(HistoryMenuItem);
HistoryMenuItem.Insert(I, Histories[I]); HistoryMenuItem.Insert(I, Histories[I]);
with Histories[I] do with Histories[I] do
begin begin
Visible := False; Visible := False;
OnClick := HistoryClick; OnClick := HistoryClick;
@@ -256,7 +366,7 @@ for I := 0 to MaxHistories-1 do
end; end;
end; end;
{$IFDEF LCLCarbon} {$IFDEF LCLCarbon}
AppMenu := TMenuItem.Create(Self); //Application menu AppMenu := TMenuItem.Create(Self); //Application menu
AppMenu.Caption := #$EF#$A3#$BF; //Unicode Apple logo char AppMenu.Caption := #$EF#$A3#$BF; //Unicode Apple logo char
MainMenu.Items.Insert(0, AppMenu); MainMenu.Items.Insert(0, AppMenu);
@@ -269,16 +379,13 @@ for I := 0 to MaxHistories-1 do
Find1.ShortCut := ShortCut(VK_F, [ssMeta]); Find1.ShortCut := ShortCut(VK_F, [ssMeta]);
CopyItem.ShortCut := ShortCut(VK_C, [ssMeta]); CopyItem.ShortCut := ShortCut(VK_C, [ssMeta]);
SelectAllItem.ShortCut := ShortCut(VK_A, [ssMeta]); SelectAllItem.ShortCut := ShortCut(VK_A, [ssMeta]);
{$ENDIF} {$ENDIF}
{$IFNDEF LCL} AllowDropFiles := True;
DragAcceptFiles(Handle, True); OnDropFiles := DropFiles;
{$ELSE}
AllowDropFiles := True; HintWindow := THintWindow.Create(Self);
OnDropFiles := DropFiles; HintWindow.Color := $C0FFFF;
{$ENDIF}
HintWindow := THintWindow.Create(Self);
HintWindow.Color := $C0FFFF;
end; end;
procedure TformBrowser.FormShow(Sender: TObject); procedure TformBrowser.FormShow(Sender: TObject);
@@ -289,27 +396,16 @@ begin
// With OS X app, ParamStr not meaningful unless launched with --args switch. // 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 if (ParamCount >= 1) {$IFDEF DARWIN} and (Copy(ParamStr(1), 1, 4) <> '-psn') {$ENDIF} then
begin {Parameter is file to load} begin {Parameter is file to load}
{$IFNDEF LCL} S := ParamStr(1);
S := CmdLine; {$ifdef FPBROWSER_THTMLCOMP}
I := Pos('" ', S); Viewer.LoadFromFile(HtmlToDos(Trim(S)));
if I > 0 then {$endif}
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)));
end; end;
end; end;
procedure TformBrowser.OpenFileClick(Sender: TObject); procedure TformBrowser.OpenFileClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'; //might have changed OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'; //might have changed
@@ -319,6 +415,7 @@ begin
Viewer.LoadFromFile(OpenDialog.Filename); Viewer.LoadFromFile(OpenDialog.Filename);
Caption := Viewer.DocumentTitle; Caption := Viewer.DocumentTitle;
end; end;
{$endif}
end; end;
procedure TformBrowser.editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TformBrowser.editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
@@ -335,6 +432,7 @@ begin
pageBrowser.ActivePageIndex := 2; pageBrowser.ActivePageIndex := 2;
end; end;
{$ifdef FPBROWSER_THTMLCOMP}
procedure TformBrowser.HotSpotChange(Sender: TObject; const URL: string); procedure TformBrowser.HotSpotChange(Sender: TObject; const URL: string);
{mouse moved over or away from a hot spot. Change the status line} {mouse moved over or away from a hot spot. Change the status line}
var var
@@ -471,30 +569,33 @@ begin
editURL.Text := URL; {other protocall} editURL.Text := URL; {other protocall}
end; end;
{$endif}
{The Show Images menu item was clicked} {The Show Images menu item was clicked}
procedure TformBrowser.ShowImagesClick(Sender: TObject); procedure TformBrowser.ShowImagesClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
Viewer.ViewImages := not Viewer.ViewImages; Viewer.ViewImages := not Viewer.ViewImages;
(Sender as TMenuItem).Checked := Viewer.ViewImages; (Sender as TMenuItem).Checked := Viewer.ViewImages;
{$endif}
end; end;
procedure TformBrowser.ReloadButtonClick(Sender: TObject); procedure TformBrowser.ReloadButtonClick(Sender: TObject);
{the Reload button was clicked} {the Reload button was clicked}
begin begin
with Viewer do {$ifdef FPBROWSER_THTMLCOMP}
begin Viewer.ReLoadButton.Enabled := False;
ReLoadButton.Enabled := False; Viewer.ReLoad;
ReLoad; Viewer.ReLoadButton.Enabled := CurrentFile <> '';
ReLoadButton.Enabled := CurrentFile <> '';
Viewer.SetFocus; Viewer.SetFocus;
end; {$endif}
end; end;
procedure TformBrowser.FwdBackClick(Sender: TObject); procedure TformBrowser.FwdBackClick(Sender: TObject);
{Either the Forward or Back button was clicked} {Either the Forward or Back button was clicked}
begin begin
with Viewer do {$ifdef FPBROWSER_THTMLCOMP}
with Viewer do
begin begin
if Sender = BackButton then if Sender = BackButton then
HistoryIndex := HistoryIndex +1 HistoryIndex := HistoryIndex +1
@@ -502,6 +603,7 @@ with Viewer do
HistoryIndex := HistoryIndex -1; HistoryIndex := HistoryIndex -1;
Self.Caption := DocumentTitle; Self.Caption := DocumentTitle;
end; end;
{$endif}
end; end;
procedure TformBrowser.HistoryChange(Sender: TObject); procedure TformBrowser.HistoryChange(Sender: TObject);
@@ -510,6 +612,7 @@ var
I: integer; I: integer;
Cap: string[80]; Cap: string[80];
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
with Sender as ThtmlViewer do with Sender as ThtmlViewer do
begin begin
{check to see which buttons are to be enabled} {check to see which buttons are to be enabled}
@@ -533,13 +636,16 @@ with Sender as ThtmlViewer do
Caption := DocumentTitle; {keep the caption updated} Caption := DocumentTitle; {keep the caption updated}
Viewer.SetFocus; Viewer.SetFocus;
end; end;
{$endif}
end; end;
procedure TformBrowser.HistoryClick(Sender: TObject);
{A history list menuitem got clicked on} {A history list menuitem got clicked on}
procedure TformBrowser.HistoryClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
{Changing the HistoryIndex loads and positions the appropriate document} {Changing the HistoryIndex loads and positions the appropriate document}
Viewer.HistoryIndex := (Sender as TMenuItem).Tag; Viewer.HistoryIndex := (Sender as TMenuItem).Tag;
{$endif}
end; end;
procedure TformBrowser.Exit1Click(Sender: TObject); procedure TformBrowser.Exit1Click(Sender: TObject);
@@ -548,10 +654,10 @@ Close;
end; end;
procedure TformBrowser.FontColorsClick(Sender: TObject); procedure TformBrowser.FontColorsClick(Sender: TObject);
var {var
FontForm: TFontForm; FontForm: TFontForm;}
begin begin
FontForm := TFontForm.Create(Self); (*FontForm := TFontForm.Create(Self);
try try
with FontForm do with FontForm do
begin begin
@@ -572,27 +678,29 @@ try
end; end;
finally finally
FontForm.Free; FontForm.Free;
end; end;*)
end; end;
procedure TformBrowser.Print1Click(Sender: TObject); procedure TformBrowser.Print1Click(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
with PrintDialog do with PrintDialog do
if Execute then if Execute then
if PrintRange = prAllPages then if PrintRange = prAllPages then
viewer.Print(1, 9999) viewer.Print(1, 9999)
else else
Viewer.Print(FromPage, ToPage); Viewer.Print(FromPage, ToPage);
{$endif}
end; end;
procedure TformBrowser.PrinterSetup1Click(Sender: TObject); procedure TformBrowser.PrinterSetup1Click(Sender: TObject);
begin begin
{$IFNDEF LCLCarbon} {$IFNDEF LCLCarbon}
PrinterSetupDialog.Execute; PrinterSetupDialog.Execute;
{$ELSE} {$ELSE}
MessageDlg('Not yet supported with Carbon widgetset.', MessageDlg('Not yet supported with Carbon widgetset.',
mtError, [mbOK], 0); mtError, [mbOK], 0);
{$ENDIF} {$ENDIF}
end; end;
procedure TformBrowser.About1Click(Sender: TObject); procedure TformBrowser.About1Click(Sender: TObject);
@@ -626,15 +734,18 @@ end;
procedure TformBrowser.FindDialogFind(Sender: TObject); procedure TformBrowser.FindDialogFind(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
with FindDialog do with FindDialog do
begin begin
if not Viewer.FindEx(FindText, frMatchCase in Options, not (frDown in Options)) then if not Viewer.FindEx(FindText, frMatchCase in Options, not (frDown in Options)) then
MessageDlg('No further occurances of "'+FindText+'"', mtInformation, [mbOK], 0); MessageDlg('No further occurances of "'+FindText+'"', mtInformation, [mbOK], 0);
end; end;
{$endif}
end; end;
procedure TformBrowser.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean); procedure TformBrowser.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
if ProcessingOn then if ProcessingOn then
begin {disable various buttons and menuitems during processing} begin {disable various buttons and menuitems during processing}
FwdButton.Enabled := False; FwdButton.Enabled := False;
@@ -658,25 +769,33 @@ else
SelectAllItem.Enabled := Viewer.CurrentFile <> ''; SelectAllItem.Enabled := Viewer.CurrentFile <> '';
Open.Enabled := True; Open.Enabled := True;
end; end;
{$endif}
end; end;
procedure TformBrowser.CopyItemClick(Sender: TObject); procedure TformBrowser.CopyItemClick(Sender: TObject);
begin begin
Viewer.CopyToClipboard; {$ifdef FPBROWSER_THTMLCOMP}
Viewer.CopyToClipboard;
{$endif}
end; end;
procedure TformBrowser.Edit2Click(Sender: TObject); procedure TformBrowser.Edit2Click(Sender: TObject);
begin begin
CopyItem.Enabled := Viewer.SelLength <> 0; {$ifdef FPBROWSER_THTMLCOMP}
CopyItem.Enabled := Viewer.SelLength <> 0;
{$endif}
end; end;
procedure TformBrowser.SelectAllItemClick(Sender: TObject); procedure TformBrowser.SelectAllItemClick(Sender: TObject);
begin begin
Viewer.SelectAll; {$ifdef FPBROWSER_THTMLCOMP}
Viewer.SelectAll;
{$endif}
end; end;
procedure TformBrowser.OpenTextFileClick(Sender: TObject); procedure TformBrowser.OpenTextFileClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'+ OpenDialog.Filter := 'HTML Files (*.htm,*.html)|*.htm;*.html'+
@@ -693,10 +812,12 @@ if OpenDialog.Execute then
ReLoadButton.Enabled := True; ReLoadButton.Enabled := True;
end; end;
end; end;
{$endif}
end; end;
procedure TformBrowser.OpenImageFileClick(Sender: TObject); procedure TformBrowser.OpenImageFileClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
OpenDialog.Filter := 'Graphics Files (*.bmp,*.gif,*.jpg,*.jpeg,*.png)|'+ OpenDialog.Filter := 'Graphics Files (*.bmp,*.gif,*.jpg,*.jpeg,*.png)|'+
@@ -712,29 +833,17 @@ if OpenDialog.Execute then
ReLoadButton.Enabled := True; ReLoadButton.Enabled := True;
end; end;
end; end;
{$endif}
end; 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; procedure TformBrowser.DropFiles( Sender : TObject;
const FileNames : array of string); const FileNames : array of string);
var var
S : string; S : string;
Ext: string; Ext: string;
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
S := FileNames[0]; S := FileNames[0];
{$ENDIF}
Ext := LowerCase(ExtractFileExt(S)); Ext := LowerCase(ExtractFileExt(S));
if (Ext = '.htm') or (Ext = '.html') then if (Ext = '.htm') or (Ext = '.html') then
Viewer.LoadFromFile(S) Viewer.LoadFromFile(S)
@@ -743,73 +852,33 @@ begin
else if (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.jpg') else if (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.jpg')
or (Ext = '.jpeg') or (Ext = '.png') then or (Ext = '.jpeg') or (Ext = '.png') then
Viewer.LoadImageFile(S); Viewer.LoadImageFile(S);
{$IFNDEF LCL} {$endif}
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}
end; end;
procedure TformBrowser.ViewimageClick(Sender: TObject); procedure TformBrowser.ViewimageClick(Sender: TObject);
var var
AForm: TImageForm; AForm: TImageForm;
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
AForm := TImageForm.Create(Self); AForm := TImageForm.Create(Self);
AForm.ImageFormBitmap := FoundObject.Bitmap; AForm.ImageFormBitmap := FoundObject.Bitmap;
AForm.Caption := ''; AForm.Caption := '';
AForm.Show; AForm.Show;
{$endif}
end; end;
procedure TformBrowser.CopyImageToClipboardClick(Sender: TObject); procedure TformBrowser.CopyImageToClipboardClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
Clipboard.Assign(FoundObject.Bitmap); Clipboard.Assign(FoundObject.Bitmap);
{$endif}
end; end;
procedure TformBrowser.ObjectClick(Sender, Obj: TObject; const OnClick: String); procedure TformBrowser.ObjectClick(Sender, Obj: TObject; const OnClick: String);
var var
S: string; S: string;
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
if OnClick = 'display' then if OnClick = 'display' then
begin begin
if Obj is TFormControlObj then if Obj is TFormControlObj then
@@ -833,6 +902,7 @@ if OnClick = 'display' then
end end
else if OnClick <> '' then else if OnClick <> '' then
MessageDlg(OnClick, mtCustom, [mbOK], 0); MessageDlg(OnClick, mtCustom, [mbOK], 0);
{$endif}
end; end;
{ In this event we should provide images for the html component } { In this event we should provide images for the html component }
@@ -895,6 +965,7 @@ begin
MyPageLoader.Free; MyPageLoader.Free;
end; end;
{$ifdef FPBROWSER_THTMLCOMP}
procedure TformBrowser.RightClick(Sender: TObject; Parameters: TRightClickParameters); procedure TformBrowser.RightClick(Sender: TObject; Parameters: TRightClickParameters);
var var
Pt: TPoint; Pt: TPoint;
@@ -943,6 +1014,7 @@ begin
else PopupMenu.Popup(Pt.X, Pt.Y); else PopupMenu.Popup(Pt.X, Pt.Y);
end; end;
end; end;
{$endif}
procedure TformBrowser.OpenInNewWindowClick(Sender: TObject); procedure TformBrowser.OpenInNewWindowClick(Sender: TObject);
var var
@@ -971,17 +1043,20 @@ end;
procedure TformBrowser.MetaTimerTimer(Sender: TObject); procedure TformBrowser.MetaTimerTimer(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
MetaTimer.Enabled := False; MetaTimer.Enabled := False;
if Viewer.CurrentFile = PresentFile then {don't load if current file has changed} if Viewer.CurrentFile = PresentFile then {don't load if current file has changed}
begin begin
Viewer.LoadFromFile(NextFile); Viewer.LoadFromFile(NextFile);
Caption := Viewer.DocumentTitle; Caption := Viewer.DocumentTitle;
end; end;
{$ENDIF}
end; end;
procedure TformBrowser.MetaRefreshEvent(Sender: TObject; Delay: Integer; procedure TformBrowser.MetaRefreshEvent(Sender: TObject; Delay: Integer;
const URL: String); const URL: String);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
NextFile := Viewer.HTMLExpandFilename(URL); NextFile := Viewer.HTMLExpandFilename(URL);
if FileExists(NextFile) then if FileExists(NextFile) then
begin begin
@@ -989,6 +1064,7 @@ begin
MetaTimer.Interval := Delay*1000; MetaTimer.Interval := Delay*1000;
MetaTimer.Enabled := True; MetaTimer.Enabled := True;
end; end;
{$ENDIF}
end; end;
procedure TformBrowser.PrintpreviewClick(Sender: TObject); procedure TformBrowser.PrintpreviewClick(Sender: TObject);
@@ -1011,6 +1087,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{$ifdef FPBROWSER_THTMLCOMP}
procedure TformBrowser.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure TformBrowser.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var var
TitleStr: string; TitleStr: string;
@@ -1028,6 +1105,7 @@ begin
end; end;
end; end;
end; end;
{$ENDIF}
procedure TformBrowser.CloseAll; procedure TformBrowser.CloseAll;
begin begin
@@ -1054,8 +1132,13 @@ end;
procedure TformBrowser.HandlePageLoaderTerminated(Sender: TObject); procedure TformBrowser.HandlePageLoaderTerminated(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP}
Viewer.LoadFromString(MyPageLoader.Contents); Viewer.LoadFromString(MyPageLoader.Contents);
Caption := Viewer.DocumentTitle; Caption := Viewer.DocumentTitle;
{$endif}
{$ifdef FPBROWSER_TURBOPOWERIPRO}
ShowHTML(MyPageLoader.Contents);
{$endif}
// Load source and debug info // Load source and debug info
memoSource.Lines.Clear(); memoSource.Lines.Clear();
@@ -1074,41 +1157,39 @@ var
TitleStr: string; TitleStr: string;
begin begin
Inc(TimerCount); {$ifdef FPBROWSER_THTMLCOMP}
GetCursorPos(Pt); Inc(TimerCount);
Pt1 := Viewer.ScreenToClient(Pt); GetCursorPos(Pt);
TitleStr := Viewer.TitleAttr; Pt1 := Viewer.ScreenToClient(Pt);
if (TitleStr = '') or not PtInRect(Viewer.ClientRect, Pt1)then TitleStr := Viewer.TitleAttr;
begin if (TitleStr = '') or not PtInRect(Viewer.ClientRect, Pt1)then
OldTitle := ''; begin
CloseAll; OldTitle := '';
Exit; CloseAll;
end; Exit;
if TitleStr <> OldTitle then end;
begin if TitleStr <> OldTitle then
TimerCount := 0; begin
OldTitle := TitleStr; TimerCount := 0;
HintWindow.ReleaseHandle; OldTitle := TitleStr;
HintVisible := False; HintWindow.ReleaseHandle;
Exit; HintVisible := False;
Exit;
end; end;
if TimerCount > EndCount then if TimerCount > EndCount then
CloseAll CloseAll
else if (TimerCount >= StartCount) and not HintVisible then else if (TimerCount >= StartCount) and not HintVisible then
begin begin
{$ifdef ver90} {Delphi 2} ARect := HintWindow.CalcHintRect(300, TitleStr, Nil);
ARect := Rect(0,0,0,0); with ARect do
DrawText(HintWindow.Canvas.Handle, PChar(TitleStr), Length(TitleStr), ARect, DT_CALCRECT); HintWindow.ActivateHint(Rect(Pt.X, Pt.Y+18, Pt.X+Right, Pt.Y+18+Bottom), TitleStr);
{$else} HintVisible := True;
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;
end; end;
{$endif}
end; end;
{$ifdef FPBROWSER_THTMLCOMP}
procedure TformBrowser.ViewerProgress(Sender: TObject; Stage: TProgressStage; procedure TformBrowser.ViewerProgress(Sender: TObject; Stage: TProgressStage;
PercentDone: Integer); PercentDone: Integer);
begin begin
@@ -1122,6 +1203,7 @@ case Stage of
end; end;
ProgressBar.Update; ProgressBar.Update;
end; end;
{$endif}
{HTML for print header and footer} {HTML for print header and footer}
const const
@@ -1150,6 +1232,7 @@ if I > 0 then
end; end;
end; end;
{$ifdef FPBROWSER_THTMLCOMP}
procedure TformBrowser.ViewerPrintHTMLHeader(Sender: TObject; procedure TformBrowser.ViewerPrintHTMLHeader(Sender: TObject;
HFViewer: THTMLViewer; NumPage: Integer; LastPage: boolean; var XL, XR: integer; var StopPrinting: Boolean); HFViewer: THTMLViewer; NumPage: Integer; LastPage: boolean; var XL, XR: integer; var StopPrinting: Boolean);
var var
@@ -1169,6 +1252,7 @@ S := ReplaceStr(HFText, '#left', DateToStr(Date));
S := ReplaceStr(S, '#right', 'Page '+IntToStr(NumPage)); S := ReplaceStr(S, '#right', 'Page '+IntToStr(NumPage));
HFViewer.LoadFromString(S); HFViewer.LoadFromString(S);
end; end;
{$endif}
initialization initialization
{$IFDEF LCL} {$IFDEF LCL}

5
applications/fpbrowser/pageloader.pas
View File

@@ -15,6 +15,7 @@ type
public public
Contents: string; Contents: string;
LastPageURL: string; LastPageURL: string;
UserAgent: string;
ContentsList: TStringList; ContentsList: TStringList;
DebugInfo: TStringList; DebugInfo: TStringList;
constructor Create; constructor Create;
@@ -68,6 +69,7 @@ constructor TPageLoader.Create;
begin begin
ContentsList := TStringList.Create; ContentsList := TStringList.Create;
DebugInfo := TStringList.Create; DebugInfo := TStringList.Create;
UserAgent := 'FPBrowser/1.0 (X11; Linux i686; Mobile; U; en-GB)';
end; end;
destructor TPageLoader.Destroy; destructor TPageLoader.Destroy;
@@ -93,8 +95,7 @@ begin
Client.Headers.Add('Accept-Language: en-gb,en;q=0.5'); Client.Headers.Add('Accept-Language: en-gb,en;q=0.5');
// Client.Headers.Add('Accept-Encoding: gzip,deflate'); // Client.Headers.Add('Accept-Encoding: gzip,deflate');
Client.Headers.Add('Accept-Charset: utf-8;q=0.7,*;q=0.7'); // ISO-8859-1, Client.Headers.Add('Accept-Charset: utf-8;q=0.7,*;q=0.7'); // ISO-8859-1,
Client.UserAgent := UserAgent;
// Client.UserAgent := AUserAgent;
Client.HttpMethod('GET', LastPageURL); Client.HttpMethod('GET', LastPageURL);
// Client.Headers; // Client.Headers;