You've already forked lazarus-ccr
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
This commit is contained in:
sekelsenmat
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -32,17 +32,16 @@
|
||||
</RunParams>
|
||||
<RequiredPackages Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="Printer4Lazarus"/>
|
||||
<PackageName Value="TurboPowerIPro"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="laz_synapse"/>
|
||||
<PackageName Value="Printer4Lazarus"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
<PackageName Value="laz_synapse"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="htmlcomp"/>
|
||||
<DefaultFilename Value="../../components/thtmlport/package/htmlcomp.lpk" Prefer="True"/>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="7">
|
||||
|
||||
@ -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 :='<body bgcolor="ffffeb" text="000080">'+
|
||||
|
||||
'</center>'+
|
||||
'</body>';
|
||||
Viewer.LoadFromBuffer(@S[1], Length(S), '');
|
||||
Viewer.LoadFromBuffer(@S[1], Length(S), '');*)
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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;
|
||||
|
||||
Reference in New Issue
Block a user