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

fpbrowser: Starts the code to load images

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1726 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-07-01 07:04:46 +00:00
parent 67e9c9c02c
commit ead2a75db2
6 changed files with 255 additions and 182 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
applications/fpbrowser/fpbrowser.dpr
View File

@ -19,7 +19,7 @@ uses
begin begin
Application.Initialize; Application.Initialize;
Application.CreateForm(TForm1, Form1); Application.CreateForm(TformBrowser, formBrowser);
Application.CreateForm(TSubmitForm, SubmitForm); Application.CreateForm(TSubmitForm, SubmitForm);
Application.Run; Application.Run;
end. end.

7
applications/fpbrowser/fpbrowser.lpi
View File

@ -51,7 +51,7 @@
<Unit1> <Unit1>
<Filename Value="mainform.pas"/> <Filename Value="mainform.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/> <ComponentName Value="formBrowser"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/> <UnitName Value="mainform"/>
@ -120,13 +120,16 @@
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="2"> <Exceptions Count="3">
<Item1> <Item1>
<Name Value="ECodetoolError"/> <Name Value="ECodetoolError"/>
</Item1> </Item1>
<Item2> <Item2>
<Name Value="EFOpenError"/> <Name Value="EFOpenError"/>
</Item2> </Item2>
<Item3>
<Name Value="EConvertError"/>
</Item3>
</Exceptions> </Exceptions>
</Debugging> </Debugging>
</CONFIG> </CONFIG>

15
applications/fpbrowser/mainform.lfm
View File

@ -1,9 +1,9 @@
object Form1: TForm1 object formBrowser: TformBrowser
Left = 372 Left = 372
Height = 439 Height = 439
Top = 267 Top = 267
Width = 621 Width = 621
ClientHeight = 412 ClientHeight = 439
ClientWidth = 621 ClientWidth = 621
Color = clBtnFace Color = clBtnFace
Font.Color = clWindowText Font.Color = clWindowText
@ -17,7 +17,7 @@ object Form1: TForm1
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 18 Height = 18
Top = 394 Top = 421
Width = 621 Width = 621
Align = alBottom Align = alBottom
Alignment = taLeftJustify Alignment = taLeftJustify
@ -48,7 +48,7 @@ object Form1: TForm1
TabOrder = 1 TabOrder = 1
object editURL: TEdit object editURL: TEdit
Left = 190 Left = 190
Height = 23 Height = 22
Top = 4 Top = 4
Width = 337 Width = 337
OnKeyDown = editURLKeyDown OnKeyDown = editURLKeyDown
@ -88,23 +88,24 @@ object Form1: TForm1
end end
object Panel3: TPanel object Panel3: TPanel
Left = 0 Left = 0
Height = 361 Height = 388
Top = 33 Top = 33
Width = 621 Width = 621
Align = alClient Align = alClient
BevelInner = bvLowered BevelInner = bvLowered
BevelOuter = bvNone BevelOuter = bvNone
Caption = 'Panel3' Caption = 'Panel3'
ClientHeight = 361 ClientHeight = 388
ClientWidth = 621 ClientWidth = 621
TabOrder = 2 TabOrder = 2
object Viewer: THTMLViewer object Viewer: THTMLViewer
Left = 1 Left = 1
Height = 359 Height = 386
Top = 1 Top = 1
Width = 619 Width = 619
OnHotSpotCovered = HotSpotChange OnHotSpotCovered = HotSpotChange
OnHotSpotClick = HotSpotClick OnHotSpotClick = HotSpotClick
OnImageRequest = ViewerImageRequest
OnFormSubmit = SubmitEvent OnFormSubmit = SubmitEvent
OnHistoryChange = HistoryChange OnHistoryChange = HistoryChange
OnProgress = ViewerProgress OnProgress = ViewerProgress

162
applications/fpbrowser/mainform.lrs
View File

@ -1,84 +1,84 @@
{ This is an automatically generated lazarus resource file } { This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[ LazarusResources.Add('TformBrowser','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3't'#1#6'Height'#3#183#1#3'Top'#3#11#1#5'Wi' 'TPF0'#12'TformBrowser'#11'formBrowser'#4'Left'#3't'#1#6'Height'#3#183#1#3'To'
+'dth'#3'm'#2#12'ClientHeight'#3#156#1#11'ClientWidth'#3'm'#2#5'Color'#7#9'cl' +'p'#3#11#1#5'Width'#3'm'#2#12'ClientHeight'#3#183#1#11'ClientWidth'#3'm'#2#5
+'BtnFace'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#243#9'Font.Nam' +'Color'#7#9'clBtnFace'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2
+'e'#6#5'Arial'#4'Menu'#7#8'MainMenu'#8'OnCreate'#7#10'FormCreate'#9'OnDestro' +#243#9'Font.Name'#6#5'Arial'#4'Menu'#7#8'MainMenu'#8'OnCreate'#7#10'FormCrea'
+'y'#7#11'FormDestroy'#6'OnShow'#7#8'FormShow'#10'LCLVersion'#6#6'0.9.31'#0#6 +'te'#9'OnDestroy'#7#11'FormDestroy'#6'OnShow'#7#8'FormShow'#10'LCLVersion'#6
+'TPanel'#6'Panel1'#4'Left'#2#0#6'Height'#2#18#3'Top'#3#138#1#5'Width'#3'm'#2 +#6'0.9.31'#0#6'TPanel'#6'Panel1'#4'Left'#2#0#6'Height'#2#18#3'Top'#3#165#1#5
+#5'Align'#7#8'alBottom'#9'Alignment'#7#13'taLeftJustify'#10'BevelInner'#7#9 +'Width'#3'm'#2#5'Align'#7#8'alBottom'#9'Alignment'#7#13'taLeftJustify'#10'Be'
+'bvLowered'#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#2#18#11'ClientWidth' +'velInner'#7#9'bvLowered'#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#2#18#11
+#3'm'#2#8'TabOrder'#2#0#0#12'TProgressBar'#11'ProgressBar'#4'Left'#3#214#1#6 +'ClientWidth'#3'm'#2#8'TabOrder'#2#0#0#12'TProgressBar'#11'ProgressBar'#4'Le'
+'Height'#2#16#3'Top'#2#1#5'Width'#3#150#0#5'Align'#7#7'alRight'#8'TabOrder'#2 +'ft'#3#214#1#6'Height'#2#16#3'Top'#2#1#5'Width'#3#150#0#5'Align'#7#7'alRight'
+#0#7'Visible'#8#0#0#0#6'TPanel'#6'Panel2'#4'Left'#2#0#6'Height'#2'!'#3'Top'#2 +#8'TabOrder'#2#0#7'Visible'#8#0#0#0#6'TPanel'#6'Panel2'#4'Left'#2#0#6'Height'
+#0#5'Width'#3'm'#2#5'Align'#7#5'alTop'#10'BevelOuter'#7#6'bvNone'#12'ClientH' +#2'!'#3'Top'#2#0#5'Width'#3'm'#2#5'Align'#7#5'alTop'#10'BevelOuter'#7#6'bvNo'
+'eight'#2'!'#11'ClientWidth'#3'm'#2#8'TabOrder'#2#1#0#5'TEdit'#7'editURL'#4 +'ne'#12'ClientHeight'#2'!'#11'ClientWidth'#3'm'#2#8'TabOrder'#2#1#0#5'TEdit'
+'Left'#3#190#0#6'Height'#2#23#3'Top'#2#4#5'Width'#3'Q'#1#9'OnKeyDown'#7#14'e' +#7'editURL'#4'Left'#3#190#0#6'Height'#2#22#3'Top'#2#4#5'Width'#3'Q'#1#9'OnKe'
+'ditURLKeyDown'#7'TabStop'#8#8'TabOrder'#2#3#0#0#7'TButton'#12'ReloadButton' +'yDown'#7#14'editURLKeyDown'#7'TabStop'#8#8'TabOrder'#2#3#0#0#7'TButton'#12
+#4'Left'#2#10#6'Height'#2#24#3'Top'#2#4#5'Width'#2';'#7'Caption'#6#7'&Reload' +'ReloadButton'#4'Left'#2#10#6'Height'#2#24#3'Top'#2#4#5'Width'#2';'#7'Captio'
+#7'Enabled'#8#7'OnClick'#7#17'ReloadButtonClick'#8'TabOrder'#2#0#0#0#7'TButt' +'n'#6#7'&Reload'#7'Enabled'#8#7'OnClick'#7#17'ReloadButtonClick'#8'TabOrder'
+'on'#10'BackButton'#4'Left'#2'E'#6'Height'#2#24#3'Top'#2#4#5'Width'#2';'#7'C' +#2#0#0#0#7'TButton'#10'BackButton'#4'Left'#2'E'#6'Height'#2#24#3'Top'#2#4#5
+'aption'#6#5'&Back'#7'Enabled'#8#7'OnClick'#7#12'FwdBackClick'#8'TabOrder'#2 +'Width'#2';'#7'Caption'#6#5'&Back'#7'Enabled'#8#7'OnClick'#7#12'FwdBackClick'
+#1#0#0#7'TButton'#9'FwdButton'#4'Left'#3#128#0#6'Height'#2#24#3'Top'#2#4#5'W' +#8'TabOrder'#2#1#0#0#7'TButton'#9'FwdButton'#4'Left'#3#128#0#6'Height'#2#24#3
+'idth'#2';'#7'Caption'#6#8'&Forward'#7'Enabled'#8#7'OnClick'#7#12'FwdBackCli' +'Top'#2#4#5'Width'#2';'#7'Caption'#6#8'&Forward'#7'Enabled'#8#7'OnClick'#7#12
+'ck'#8'TabOrder'#2#2#0#0#0#6'TPanel'#6'Panel3'#4'Left'#2#0#6'Height'#3'i'#1#3 +'FwdBackClick'#8'TabOrder'#2#2#0#0#0#6'TPanel'#6'Panel3'#4'Left'#2#0#6'Heigh'
+'Top'#2'!'#5'Width'#3'm'#2#5'Align'#7#8'alClient'#10'BevelInner'#7#9'bvLower' +'t'#3#132#1#3'Top'#2'!'#5'Width'#3'm'#2#5'Align'#7#8'alClient'#10'BevelInner'
+'ed'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#6'Panel3'#12'ClientHeight'#3'i' +#7#9'bvLowered'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#6'Panel3'#12'ClientH'
+#1#11'ClientWidth'#3'm'#2#8'TabOrder'#2#2#0#11'THTMLViewer'#6'Viewer'#4'Left' +'eight'#3#132#1#11'ClientWidth'#3'm'#2#8'TabOrder'#2#2#0#11'THTMLViewer'#6'V'
+#2#1#6'Height'#3'g'#1#3'Top'#2#1#5'Width'#3'k'#2#16'OnHotSpotCovered'#7#13'H' +'iewer'#4'Left'#2#1#6'Height'#3#130#1#3'Top'#2#1#5'Width'#3'k'#2#16'OnHotSpo'
+'otSpotChange'#14'OnHotSpotClick'#7#12'HotSpotClick'#12'OnFormSubmit'#7#11'S' +'tCovered'#7#13'HotSpotChange'#14'OnHotSpotClick'#7#12'HotSpotClick'#14'OnIm'
+'ubmitEvent'#15'OnHistoryChange'#7#13'HistoryChange'#10'OnProgress'#7#14'Vie' +'ageRequest'#7#18'ViewerImageRequest'#12'OnFormSubmit'#7#11'SubmitEvent'#15
+'werProgress'#7'TabStop'#9#8'TabOrder'#2#0#5'Align'#7#8'alClient'#13'DefBack' +'OnHistoryChange'#7#13'HistoryChange'#10'OnProgress'#7#14'ViewerProgress'#7
+'ground'#7#8'clWindow'#11'BorderStyle'#7#9'htFocused'#15'HistoryMaxCount'#2#6 +'TabStop'#9#8'TabOrder'#2#0#5'Align'#7#8'alClient'#13'DefBackground'#7#8'clW'
+#11'DefFontName'#6#15'Times New Roman'#14'DefPreFontName'#6#11'Courier New' +'indow'#11'BorderStyle'#7#9'htFocused'#15'HistoryMaxCount'#2#6#11'DefFontNam'
+#12'DefFontColor'#7#12'clWindowText'#16'DefOverLinkColor'#7#9'clFuchsia'#15 +'e'#6#15'Times New Roman'#14'DefPreFontName'#6#11'Courier New'#12'DefFontCol'
+'ImageCacheCount'#2#6#8'NoSelect'#8#7'CharSet'#7#15'DEFAULT_CHARSET'#15'Prin' +'or'#7#12'clWindowText'#16'DefOverLinkColor'#7#9'clFuchsia'#15'ImageCacheCou'
+'tMarginLeft'#5#0#0#0#0#0#0#0#128#0'@'#16'PrintMarginRight'#5#0#0#0#0#0#0#0 +'nt'#2#6#8'NoSelect'#8#7'CharSet'#7#15'DEFAULT_CHARSET'#15'PrintMarginLeft'#5
+#128#0'@'#14'PrintMarginTop'#5#0#0#0#0#0#0#0#128#0'@'#17'PrintMarginBottom'#5 +#0#0#0#0#0#0#0#128#0'@'#16'PrintMarginRight'#5#0#0#0#0#0#0#0#128#0'@'#14'Pri'
+#0#0#0#0#0#0#0#128#0'@'#10'PrintScale'#5#0#0#0#0#0#0#0#128#255'?'#11'OnMouse' +'ntMarginTop'#5#0#0#0#0#0#0#0#128#0'@'#17'PrintMarginBottom'#5#0#0#0#0#0#0#0
+'Move'#7#15'ViewerMouseMove'#12'OnProcessing'#7#17'ProcessingHandler'#17'OnP' +#128#0'@'#10'PrintScale'#5#0#0#0#0#0#0#0#128#255'?'#11'OnMouseMove'#7#15'Vie'
+'rintHTMLHeader'#7#21'ViewerPrintHTMLHeader'#17'OnPrintHTMLFooter'#7#21'View' +'werMouseMove'#12'OnProcessing'#7#17'ProcessingHandler'#17'OnPrintHTMLHeader'
+'erPrintHTMLFooter'#9'OnInclude'#7#13'ViewerInclude'#14'OnSoundRequest'#7#12 +#7#21'ViewerPrintHTMLHeader'#17'OnPrintHTMLFooter'#7#21'ViewerPrintHTMLFoote'
+'SoundRequest'#13'OnMetaRefresh'#7#16'MetaRefreshEvent'#13'OnObjectClick'#7 +'r'#9'OnInclude'#7#13'ViewerInclude'#14'OnSoundRequest'#7#12'SoundRequest'#13
+#11'ObjectClick'#12'OnRightClick'#7#10'RightClick'#0#0#0#11'TOpenDialog'#10 +'OnMetaRefresh'#7#16'MetaRefreshEvent'#13'OnObjectClick'#7#11'ObjectClick'#12
+'OpenDialog'#10'DefaultExt'#6#4'.htm'#6'Filter'#6'%html files|*.htm;*.html|a' +'OnRightClick'#7#10'RightClick'#0#0#0#11'TOpenDialog'#10'OpenDialog'#10'Defa'
+'ll files|*.*'#7'Options'#11#14'ofHideReadOnly'#15'ofPathMustExist'#15'ofFil' +'ultExt'#6#4'.htm'#6'Filter'#6'%html files|*.htm;*.html|all files|*.*'#7'Opt'
+'eMustExist'#0#4'left'#3'I'#1#3'top'#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left' +'ions'#11#14'ofHideReadOnly'#15'ofPathMustExist'#15'ofFileMustExist'#0#4'lef'
+#3'#'#1#3'top'#2#4#0#9'TMenuItem'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuIt' +'t'#3'I'#1#3'top'#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3'#'#1#3'top'#2#4
+'em'#4'Open'#7'Caption'#6#5'&Open'#8'ShortCut'#2'r'#7'OnClick'#7#13'OpenFile' +#0#9'TMenuItem'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'Open'#7'Capt'
+'Click'#0#0#9'TMenuItem'#12'OpenTextFile'#7'Caption'#6#15'Open &Text File'#7 +'ion'#6#5'&Open'#8'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0#0#9'TMenu'
+'OnClick'#7#17'OpenTextFileClick'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Capti' +'Item'#12'OpenTextFile'#7'Caption'#6#15'Open &Text File'#7'OnClick'#7#17'Ope'
+'on'#6#16'Open &Image File'#7'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuI' +'nTextFileClick'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16'Open &Im'
+'tem'#13'PrinterSetup1'#7'Caption'#6#16'Printer Setup...'#7'OnClick'#7#18'Pr' +'age File'#7'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'PrinterSe'
+'interSetup1Click'#0#0#9'TMenuItem'#12'Printpreview'#7'Caption'#6#14'Print p' +'tup1'#7'Caption'#6#16'Printer Setup...'#7'OnClick'#7#18'PrinterSetup1Click'
+'re&view'#7'Enabled'#8#7'OnClick'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6 +#0#0#9'TMenuItem'#12'Printpreview'#7'Caption'#6#14'Print pre&view'#7'Enabled'
+'Print1'#7'Caption'#6#9'&Print...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click' +#8#7'OnClick'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7'Caption'#6
+#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#5'Exit1'#7'Captio' +#9'&Print...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMenuItem'#2'N'
+'n'#6#5'E&xit'#7'OnClick'#7#10'Exit1Click'#0#0#0#9'TMenuItem'#5'Edit2'#7'Cap' +'1'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'E&xit'#7'OnCl'
+'tion'#6#5'&Edit'#7'OnClick'#7#10'Edit2Click'#0#9'TMenuItem'#5'Find1'#7'Capt' +'ick'#7#10'Exit1Click'#0#0#0#9'TMenuItem'#5'Edit2'#7'Caption'#6#5'&Edit'#7'O'
+'ion'#6#5'&Find'#7'Enabled'#8#7'OnClick'#7#10'Find1Click'#0#0#9'TMenuItem'#8 +'nClick'#7#10'Edit2Click'#0#9'TMenuItem'#5'Find1'#7'Caption'#6#5'&Find'#7'En'
+'CopyItem'#7'Caption'#6#5'&Copy'#8'ShortCut'#3'C@'#7'OnClick'#7#13'CopyItemC' +'abled'#8#7'OnClick'#7#10'Find1Click'#0#0#9'TMenuItem'#8'CopyItem'#7'Caption'
+'lick'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'SelectAl' +#6#5'&Copy'#8'ShortCut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9'TMenuItem'
+'lItem'#7'Caption'#6#11'Select &All'#7'Enabled'#8#7'OnClick'#7#18'SelectAllI' +#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Caption'#6#11
+'temClick'#0#0#0#9'TMenuItem'#8'options1'#7'Caption'#6#8'&Options'#0#9'TMenu' +'Select &All'#7'Enabled'#8#7'OnClick'#7#18'SelectAllItemClick'#0#0#0#9'TMenu'
+'Item'#10'ShowImages'#7'Caption'#6#12'&Show images'#7'OnClick'#7#15'ShowImag' +'Item'#8'options1'#7'Caption'#6#8'&Options'#0#9'TMenuItem'#10'ShowImages'#7
+'esClick'#0#0#9'TMenuItem'#5'Fonts'#7'Caption'#6#23'Default &Font/Colors...' +'Caption'#6#12'&Show images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMenuIte'
+#7'OnClick'#7#15'FontColorsClick'#0#0#0#9'TMenuItem'#15'HistoryMenuItem'#7'C' +'m'#5'Fonts'#7'Caption'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'FontCo'
,'aption'#6#8'&History'#7'Visible'#8#0#0#9'TMenuItem'#6'About1'#7'Caption'#6#6 ,'lorsClick'#0#0#0#9'TMenuItem'#15'HistoryMenuItem'#7'Caption'#6#8'&History'#7
+'&About'#7'OnClick'#7#11'About1Click'#0#0#0#12'TPrintDialog'#11'PrintDialog' +'Visible'#8#0#0#9'TMenuItem'#6'About1'#7'Caption'#6#6'&About'#7'OnClick'#7#11
+#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7'Options'#11#10'poPageN' +'About1Click'#0#0#0#12'TPrintDialog'#11'PrintDialog'#8'FromPage'#2#1#7'MinPa'
+'ums'#0#6'ToPage'#2#1#4'left'#3'j'#1#3'top'#2#1#0#0#11'TFindDialog'#10'FindD' +'ge'#2#1#7'MaxPage'#3#15''''#7'Options'#11#10'poPageNums'#0#6'ToPage'#2#1#4
+'ialog'#7'Options'#11#6'frDown'#15'frHideWholeWord'#18'frDisableWholeWord'#0 +'left'#3'j'#1#3'top'#2#1#0#0#11'TFindDialog'#10'FindDialog'#7'Options'#11#6
+#6'OnFind'#7#14'FindDialogFind'#4'left'#3#249#0#3'top'#4#255#255#0#0#0#0#10 +'frDown'#15'frHideWholeWord'#18'frDisableWholeWord'#0#6'OnFind'#7#14'FindDia'
+'TPopupMenu'#9'PopupMenu'#4'left'#3#144#1#3'top'#2#1#0#9'TMenuItem'#9'Viewim' +'logFind'#4'left'#3#249#0#3'top'#4#255#255#0#0#0#0#10'TPopupMenu'#9'PopupMen'
+'age'#7'Caption'#6#11'&View image'#7'OnClick'#7#14'ViewimageClick'#0#0#9'TMe' +'u'#4'left'#3#144#1#3'top'#2#1#0#9'TMenuItem'#9'Viewimage'#7'Caption'#6#11'&'
+'nuItem'#20'CopyImageToClipboard'#7'Caption'#6#24'&Copy image to clipboard'#7 +'View image'#7'OnClick'#7#14'ViewimageClick'#0#0#9'TMenuItem'#20'CopyImageTo'
+'OnClick'#7#25'CopyImageToClipboardClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'#6 +'Clipboard'#7'Caption'#6#24'&Copy image to clipboard'#7'OnClick'#7#25'CopyIm'
+#1'-'#0#0#9'TMenuItem'#15'OpenInNewWindow'#7'Caption'#6#19'&Open in new wind' +'ageToClipboardClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'#6#1'-'#0#0#9'TMenuIt'
+'ow'#7'OnClick'#7#20'OpenInNewWindowClick'#0#0#0#6'TTimer'#9'MetaTimer'#7'En' +'em'#15'OpenInNewWindow'#7'Caption'#6#19'&Open in new window'#7'OnClick'#7#20
+'abled'#8#7'OnTimer'#7#14'MetaTimerTimer'#4'left'#3#242#0#3'top'#2'K'#0#0#6 +'OpenInNewWindowClick'#0#0#0#6'TTimer'#9'MetaTimer'#7'Enabled'#8#7'OnTimer'#7
+'TTimer'#6'Timer1'#8'Interval'#3#200#0#7'OnTimer'#7#11'Timer1Timer'#4'left'#3 +#14'MetaTimerTimer'#4'left'#3#242#0#3'top'#2'K'#0#0#6'TTimer'#6'Timer1'#8'In'
+'#'#1#3'top'#2'G'#0#0#19'TPrinterSetupDialog'#18'PrinterSetupDialog'#4'left' +'terval'#3#200#0#7'OnTimer'#7#11'Timer1Timer'#4'left'#3'#'#1#3'top'#2'G'#0#0
+#3#192#1#0#0#0 +#19'TPrinterSetupDialog'#18'PrinterSetupDialog'#4'left'#3#192#1#0#0#0
]); ]);

201
applications/fpbrowser/mainform.pas
View File

@ -29,9 +29,9 @@ const
MaxHistories = 6; {size of History list} MaxHistories = 6; {size of History list}
type type
{ TForm1 } { TformBrowser }
TForm1 = class(TForm) TformBrowser = class(TForm)
OpenDialog: TOpenDialog; OpenDialog: TOpenDialog;
MainMenu: TMainMenu; MainMenu: TMainMenu;
Panel1: TPanel; Panel1: TPanel;
@ -105,6 +105,8 @@ type
Loop: Integer; Terminate: Boolean); 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;
var Stream: TMemoryStream);
procedure ViewimageClick(Sender: TObject); procedure ViewimageClick(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure ViewerInclude(Sender: TObject; const Command: String; procedure ViewerInclude(Sender: TObject; const Command: String;
@ -152,10 +154,11 @@ type
procedure CloseAll; procedure CloseAll;
public public
{ Public declarations } { Public declarations }
procedure LoadURL(AURL: string);
end; end;
var var
Form1: TForm1; formBrowser: TformBrowser;
implementation implementation
@ -166,7 +169,7 @@ uses
{$R *.DFM} {$R *.DFM}
{$ENDIF} {$ENDIF}
procedure TForm1.FormCreate(Sender: TObject); procedure TformBrowser.FormCreate(Sender: TObject);
var var
I: integer; I: integer;
begin begin
@ -225,13 +228,13 @@ HintWindow := THintWindow.Create(Self);
HintWindow.Color := $C0FFFF; HintWindow.Color := $C0FFFF;
end; end;
procedure TForm1.FormShow(Sender: TObject); procedure TformBrowser.FormShow(Sender: TObject);
var var
S: string; S: string;
I: integer; I: integer;
begin 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} {$IFNDEF LCL}
S := CmdLine; S := CmdLine;
@ -252,7 +255,7 @@ if (ParamCount >= 1) {$IFDEF DARWIN} and (Copy(ParamStr(1), 1, 4) <> '-psn') {$E
end; end;
end; end;
procedure TForm1.OpenFileClick(Sender: TObject); procedure TformBrowser.OpenFileClick(Sender: TObject);
begin begin
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
@ -265,37 +268,35 @@ begin
end; end;
end; end;
procedure TForm1.editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TformBrowser.editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin begin
if Key = VK_RETURN then if Key = VK_RETURN then
begin begin
MyPageLoader.LoadFromURL(editURL.Text); LoadURL(editURL.Text);
Viewer.LoadFromString(MyPageLoader.Contents);
Caption := Viewer.DocumentTitle;
end; end;
end; end;
procedure TForm1.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
Caption: string; Caption: string;
begin begin
Caption := ''; Caption := '';
if URL <> '' then if URL <> '' then
Caption := Caption+'URL: '+URL+' '; Caption := Caption+'URL: '+URL+' ';
if Viewer.TitleAttr <> '' then if Viewer.TitleAttr <> '' then
Caption := Caption+'Title: '+Viewer.TitleAttr; Caption := Caption+'Title: '+Viewer.TitleAttr;
Panel1.Caption := Caption; Panel1.Caption := Caption;
end; end;
procedure TForm1.HotSpotClick(Sender: TObject; const URL: string;
var Handled: boolean);
{This routine handles what happens when a hot spot is clicked. The assumption {This routine handles what happens when a hot spot is clicked. The assumption
is made that DOS filenames are being used. .EXE, .WAV, .MID, and .AVI files are is made that DOS filenames are being used. .EXE, .WAV, .MID, and .AVI files are
handled here, but other file types could be easily added. handled here, but other file types could be easily added.
If the URL is handled here, set Handled to True. If not handled here, set it If the URL is handled here, set Handled to True. If not handled here, set it
to False and ThtmlViewer will handle it.} to False and ThtmlViewer will handle it.}
procedure TformBrowser.HotSpotClick(Sender: TObject; const URL: string;
var Handled: boolean);
const const
snd_Async = $0001; { play asynchronously } snd_Async = $0001; { play asynchronously }
var var
@ -307,23 +308,30 @@ var
Ext: string[5]; Ext: string[5];
ID: string; ID: string;
I, J, K: integer; I, J, K: integer;
begin begin
Handled := False; Handled := False;
{The following looks for a link of the form, "IDExpand_XXX". This is interpreted {The following looks for a link of the form, "IDExpand_XXX". This is interpreted
as meaning a block with an ID="XXXPlus" or ID="XXXMinus" attribute should as meaning a block with an ID="XXXPlus" or ID="XXXMinus" attribute should
have its Display property toggled. have its Display property toggled.
} }
I := Pos('IDEXPAND_', Uppercase(URL)); I := Pos('IDEXPAND_', Uppercase(URL));
if I=1 then if I=1 then
begin begin
ID := Copy(URL, 10, Length(URL)-9); ID := Copy(URL, 10, Length(URL)-9);
Viewer.IDDisplay[ID+'Plus'] := not Viewer.IDDisplay[ID+'Plus']; Viewer.IDDisplay[ID+'Plus'] := not Viewer.IDDisplay[ID+'Plus'];
Viewer.IDDisplay[ID+'Minus'] := not Viewer.IDDisplay[ID+'Minus']; Viewer.IDDisplay[ID+'Minus'] := not Viewer.IDDisplay[ID+'Minus'];
Viewer.Reformat; Viewer.Reformat;
Handled := True; Handled := True;
Exit; Exit;
end;
J := Pos('HTTP:', UpperCase(URL));
if (J > 0) then
begin
LoadURL(URL);
Handled := True;
Exit;
end; end;
I := Pos(':', URL); I := Pos(':', URL);
@ -384,9 +392,8 @@ if (I <= 2) or (J > 0) then
Exit; Exit;
end; end;
I := Pos('MAILTO:', UpperCase(URL)); I := Pos('MAILTO:', UpperCase(URL));
J := Pos('HTTP:', UpperCase(URL)); if (I > 0) then
if (I > 0) or (J > 0) then
begin begin
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
ShellExecute(0, nil, pchar(URL), nil, nil, SW_SHOWNORMAL); ShellExecute(0, nil, pchar(URL), nil, nil, SW_SHOWNORMAL);
@ -401,20 +408,17 @@ if (I > 0) or (J > 0) then
Exit; Exit;
end; end;
editURL.Text := URL; {other protocall} editURL.Text := URL; {other protocall}
end; end;
procedure TForm1.ShowImagesClick(Sender: TObject);
{The Show Images menu item was clicked} {The Show Images menu item was clicked}
procedure TformBrowser.ShowImagesClick(Sender: TObject);
begin begin
With Viewer do Viewer.ViewImages := not Viewer.ViewImages;
begin (Sender as TMenuItem).Checked := Viewer.ViewImages;
ViewImages := not ViewImages;
(Sender as TMenuItem).Checked := ViewImages;
end;
end; end;
procedure TForm1.ReloadButtonClick(Sender: TObject); procedure TformBrowser.ReloadButtonClick(Sender: TObject);
{the Reload button was clicked} {the Reload button was clicked}
begin begin
with Viewer do with Viewer do
@ -426,7 +430,7 @@ with Viewer do
end; end;
end; end;
procedure TForm1.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 with Viewer do
@ -439,7 +443,7 @@ with Viewer do
end; end;
end; end;
procedure TForm1.HistoryChange(Sender: TObject); procedure TformBrowser.HistoryChange(Sender: TObject);
{This event occurs when something changes history list} {This event occurs when something changes history list}
var var
I: integer; I: integer;
@ -470,19 +474,19 @@ with Sender as ThtmlViewer do
end; end;
end; end;
procedure TForm1.HistoryClick(Sender: TObject); procedure TformBrowser.HistoryClick(Sender: TObject);
{A history list menuitem got clicked on} {A history list menuitem got clicked on}
begin begin
{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;
end; end;
procedure TForm1.Exit1Click(Sender: TObject); procedure TformBrowser.Exit1Click(Sender: TObject);
begin begin
Close; Close;
end; end;
procedure TForm1.FontColorsClick(Sender: TObject); procedure TformBrowser.FontColorsClick(Sender: TObject);
var var
FontForm: TFontForm; FontForm: TFontForm;
begin begin
@ -510,7 +514,7 @@ finally
end; end;
end; end;
procedure TForm1.Print1Click(Sender: TObject); procedure TformBrowser.Print1Click(Sender: TObject);
begin begin
with PrintDialog do with PrintDialog do
if Execute then if Execute then
@ -520,7 +524,7 @@ with PrintDialog do
Viewer.Print(FromPage, ToPage); Viewer.Print(FromPage, ToPage);
end; end;
procedure TForm1.PrinterSetup1Click(Sender: TObject); procedure TformBrowser.PrinterSetup1Click(Sender: TObject);
begin begin
{$IFNDEF LCLCarbon} {$IFNDEF LCLCarbon}
PrinterSetupDialog.Execute; PrinterSetupDialog.Execute;
@ -530,7 +534,7 @@ PrinterSetupDialog.Execute;
{$ENDIF} {$ENDIF}
end; end;
procedure TForm1.About1Click(Sender: TObject); procedure TformBrowser.About1Click(Sender: TObject);
begin begin
AboutBox := TAboutBox.CreateIt(Self, 'HTMLDemo', 'ThtmlViewer'); AboutBox := TAboutBox.CreateIt(Self, 'HTMLDemo', 'ThtmlViewer');
try try
@ -541,7 +545,7 @@ finally
end; end;
procedure TForm1.SubmitEvent(Sender: TObject; const AnAction, Target, EncType, Method: String; procedure TformBrowser.SubmitEvent(Sender: TObject; const AnAction, Target, EncType, Method: String;
Results: TStringList); Results: TStringList);
begin begin
with SubmitForm do with SubmitForm do
@ -554,12 +558,12 @@ with SubmitForm do
end; end;
end; end;
procedure TForm1.Find1Click(Sender: TObject); procedure TformBrowser.Find1Click(Sender: TObject);
begin begin
FindDialog.Execute; FindDialog.Execute;
end; end;
procedure TForm1.FindDialogFind(Sender: TObject); procedure TformBrowser.FindDialogFind(Sender: TObject);
begin begin
with FindDialog do with FindDialog do
begin begin
@ -568,7 +572,7 @@ with FindDialog do
end; end;
end; end;
procedure TForm1.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean); procedure TformBrowser.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
begin begin
if ProcessingOn then if ProcessingOn then
begin {disable various buttons and menuitems during processing} begin {disable various buttons and menuitems during processing}
@ -595,22 +599,22 @@ else
end; end;
end; end;
procedure TForm1.CopyItemClick(Sender: TObject); procedure TformBrowser.CopyItemClick(Sender: TObject);
begin begin
Viewer.CopyToClipboard; Viewer.CopyToClipboard;
end; end;
procedure TForm1.Edit2Click(Sender: TObject); procedure TformBrowser.Edit2Click(Sender: TObject);
begin begin
CopyItem.Enabled := Viewer.SelLength <> 0; CopyItem.Enabled := Viewer.SelLength <> 0;
end; end;
procedure TForm1.SelectAllItemClick(Sender: TObject); procedure TformBrowser.SelectAllItemClick(Sender: TObject);
begin begin
Viewer.SelectAll; Viewer.SelectAll;
end; end;
procedure TForm1.OpenTextFileClick(Sender: TObject); procedure TformBrowser.OpenTextFileClick(Sender: TObject);
begin begin
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
@ -630,7 +634,7 @@ if OpenDialog.Execute then
end; end;
end; end;
procedure TForm1.OpenImageFileClick(Sender: TObject); procedure TformBrowser.OpenImageFileClick(Sender: TObject);
begin begin
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile); OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
@ -650,7 +654,7 @@ if OpenDialog.Execute then
end; end;
{$IFNDEF LCL} {$IFNDEF LCL}
procedure TForm1.wmDropFiles(var Message: TMessage); procedure TformBrowser.wmDropFiles(var Message: TMessage);
var var
S: string[200]; S: string[200];
Ext: string; Ext: string;
@ -662,7 +666,7 @@ DragFinish(Message.WParam);
if Count >0 then if Count >0 then
begin begin
{$ELSE} {$ELSE}
procedure TForm1.DropFiles( Sender : TObject; procedure TformBrowser.DropFiles( Sender : TObject;
const FileNames : array of string); const FileNames : array of string);
var var
S : string; S : string;
@ -684,7 +688,7 @@ Message.Result := 0;
{$ENDIF} {$ENDIF}
end; end;
procedure TForm1.MediaPlayerNotify(Sender: TObject); procedure TformBrowser.MediaPlayerNotify(Sender: TObject);
begin begin
{$IFNDEF LCL} {$IFNDEF LCL}
try try
@ -704,7 +708,7 @@ except
{$ENDIF} {$ENDIF}
end; end;
procedure TForm1.SoundRequest(Sender: TObject; const SRC: String; procedure TformBrowser.SoundRequest(Sender: TObject; const SRC: String;
Loop: Integer; Terminate: Boolean); Loop: Integer; Terminate: Boolean);
begin begin
{$IFNDEF LCL} {$IFNDEF LCL}
@ -726,7 +730,7 @@ except
{$ENDIF} {$ENDIF}
end; end;
procedure TForm1.ViewimageClick(Sender: TObject); procedure TformBrowser.ViewimageClick(Sender: TObject);
var var
AForm: TImageForm; AForm: TImageForm;
begin begin
@ -739,12 +743,12 @@ with AForm do
end; end;
end; end;
procedure TForm1.CopyImageToClipboardClick(Sender: TObject); procedure TformBrowser.CopyImageToClipboardClick(Sender: TObject);
begin begin
Clipboard.Assign(FoundObject.Bitmap); Clipboard.Assign(FoundObject.Bitmap);
end; end;
procedure TForm1.ObjectClick(Sender, Obj: TObject; const OnClick: String); procedure TformBrowser.ObjectClick(Sender, Obj: TObject; const OnClick: String);
var var
S: string; S: string;
begin begin
@ -773,8 +777,32 @@ else if OnClick <> '' then
MessageDlg(OnClick, mtCustom, [mbOK], 0); MessageDlg(OnClick, mtCustom, [mbOK], 0);
end; end;
{ In this event we should provide images for the html component }
procedure TformBrowser.ViewerImageRequest(Sender: TObject; const SRC: string;
var Stream: TMemoryStream);
var
J: Integer;
URL: string;
begin
// Add the base URL if the URL is relative
J := Pos(':', UpperCase(SRC));
if J = 0 then
begin
URL := MyPageLoader.LastPageURL + Copy(SRC, 2, Length(SRC)-1)
end
else URL := SRC;
procedure TForm1.ViewerInclude(Sender: TObject; const Command: String;
J := Pos('HTTP:', UpperCase(URL));
if (J > 0) then
begin
MyPageLoader.LoadBinaryResource(URL, Stream);
Exit;
end;
end;
procedure TformBrowser.ViewerInclude(Sender: TObject; const Command: String;
Params: TStrings; var S: string); Params: TStrings; var S: string);
{OnInclude handler} {OnInclude handler}
var var
@ -810,12 +838,12 @@ else if CompareText(Command, 'Include') = 0 then
Params.Free; Params.Free;
end; end;
procedure TForm1.FormDestroy(Sender: TObject); procedure TformBrowser.FormDestroy(Sender: TObject);
begin begin
HintWindow.Free; HintWindow.Free;
end; end;
procedure TForm1.RightClick(Sender: TObject; Parameters: TRightClickParameters); procedure TformBrowser.RightClick(Sender: TObject; Parameters: TRightClickParameters);
var var
Pt: TPoint; Pt: TPoint;
S, Dest: string; S, Dest: string;
@ -864,7 +892,7 @@ with Parameters do
end; end;
end; end;
procedure TForm1.OpenInNewWindowClick(Sender: TObject); procedure TformBrowser.OpenInNewWindowClick(Sender: TObject);
var var
PC: array[0..255] of char; PC: array[0..255] of char;
{$IFDEF LCL} {$IFDEF LCL}
@ -889,7 +917,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TForm1.MetaTimerTimer(Sender: TObject); procedure TformBrowser.MetaTimerTimer(Sender: TObject);
begin begin
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}
@ -899,7 +927,7 @@ if Viewer.CurrentFile = PresentFile then {don't load if current file has change
end; end;
end; end;
procedure TForm1.MetaRefreshEvent(Sender: TObject; Delay: Integer; procedure TformBrowser.MetaRefreshEvent(Sender: TObject; Delay: Integer;
const URL: String); const URL: String);
begin begin
NextFile := Viewer.HTMLExpandFilename(URL); NextFile := Viewer.HTMLExpandFilename(URL);
@ -911,7 +939,7 @@ if FileExists(NextFile) then
end; end;
end; end;
procedure TForm1.PrintpreviewClick(Sender: TObject); procedure TformBrowser.PrintpreviewClick(Sender: TObject);
{$IFNDEF LCL} {$IFNDEF LCL}
var var
pf: TPreviewForm; pf: TPreviewForm;
@ -931,7 +959,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TForm1.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure TformBrowser.ViewerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var var
TitleStr: string; TitleStr: string;
begin begin
@ -949,14 +977,21 @@ if not Timer1.Enabled and Assigned(ActiveControl) and ActiveControl.Focused then
end; end;
end; end;
procedure TForm1.CloseAll; procedure TformBrowser.CloseAll;
begin begin
Timer1.Enabled := False; Timer1.Enabled := False;
HintWindow.ReleaseHandle; HintWindow.ReleaseHandle;
HintVisible := False; HintVisible := False;
end; end;
procedure TForm1.Timer1Timer(Sender: TObject); procedure TformBrowser.LoadURL(AURL: string);
begin
MyPageLoader.LoadFromURL(AURL);
Viewer.LoadFromString(MyPageLoader.Contents);
Caption := Viewer.DocumentTitle;
end;
procedure TformBrowser.Timer1Timer(Sender: TObject);
const const
StartCount = 2; {timer counts before hint window opens} StartCount = 2; {timer counts before hint window opens}
EndCount = 20; {after this many timer counts, hint window closes} EndCount = 20; {after this many timer counts, hint window closes}
@ -1001,7 +1036,7 @@ else if (TimerCount >= StartCount) and not HintVisible then
end; end;
end; end;
procedure TForm1.ViewerProgress(Sender: TObject; Stage: TProgressStage; procedure TformBrowser.ViewerProgress(Sender: TObject; Stage: TProgressStage;
PercentDone: Integer); PercentDone: Integer);
begin begin
ProgressBar.Position := PercentDone; ProgressBar.Position := PercentDone;
@ -1042,7 +1077,7 @@ if I > 0 then
end; end;
end; end;
procedure TForm1.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
S: string; S: string;
@ -1052,7 +1087,7 @@ S := ReplaceStr(S, '#right', Viewer.CurrentFile);
HFViewer.LoadFromString(S); HFViewer.LoadFromString(S);
end; end;
procedure TForm1.ViewerPrintHTMLFooter(Sender: TObject; procedure TformBrowser.ViewerPrintHTMLFooter(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
S: string; S: string;

50
applications/fpbrowser/pageloader.pas
View File

@ -14,9 +14,11 @@ type
TPageLoader = class TPageLoader = class
public public
Contents: string; Contents: string;
LastPageURL: string;
ContentsList: TStringList; ContentsList: TStringList;
constructor Create; constructor Create;
procedure LoadFromURL(AURL: string); procedure LoadFromURL(AURL: string);
procedure LoadBinaryResource(AURL: string; ADest: TStream);
end; end;
var var
@ -37,25 +39,57 @@ procedure TPageLoader.LoadFromURL(AURL: string);
var var
Client: THttpSend; Client: THttpSend;
begin begin
Client := THttpSend.Create; LastPageURL := AURL;
Client := THttpSend.Create;
try
// if checkGZip.Checked then // if checkGZip.Checked then
begin // begin
Client.Headers.Add('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'); Client.Headers.Add('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8');
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,
end; // end;
// Client.UserAgent := AUserAgent; // Client.UserAgent := AUserAgent;
Client.HttpMethod('GET', AURL); Client.HttpMethod('GET', AURL);
Client.Document.Position := 0; Client.Document.Position := 0;
ContentsList.LoadFromStream(Client.Document); ContentsList.LoadFromStream(Client.Document);
Contents := ContentsList.Text; Contents := ContentsList.Text;
finally
Client.Free;
end;
end;
Client.Free; procedure TPageLoader.LoadBinaryResource(AURL: string; ADest: TStream);
var
Client: THttpSend;
i: Integer;
begin
Client := THttpSend.Create;
try
Client.Headers.Add('Accept: image/png, image/jpeg, image/gif');
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.HttpMethod('GET', AURL);
Client.Document.Position := 0;
// ADest.CopyFrom(Client.Document, Client.Document.Size);
{ ContentsList.LoadFromStream(Client.Document);
for i := 0 to ContentsList.Count-1 do
WriteLn(ContentsList.Strings[i]);
Contents := ContentsList.Text;}
finally
Client.Free;
end;
end; end;
initialization initialization