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

fpbrowser: Re-enables THTMLPort support, fixes identing and starts implementing back, forward and adds image support for ipro (although not working yet)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1928 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-09-09 09:30:37 +00:00
parent 2c00a1e9de
commit 6110aab762
5 changed files with 215 additions and 178 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
applications/fpbrowser/fpbrowser.lpi
View File

@@ -91,7 +91,7 @@
<CompilerOptions> <CompilerOptions>
<Version Value="10"/> <Version Value="10"/>
<SearchPaths> <SearchPaths>
<OtherUnitFiles Value="../../Wcomponents/thtmlport/package"/> <OtherUnitFiles Value="../../components/thtmlport/package"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
<SyntaxOptions> <SyntaxOptions>

9
applications/fpbrowser/mainform.lfm
View File

@@ -64,17 +64,16 @@ object formBrowser: TformBrowser
TabStop = False TabStop = False
TabOrder = 3 TabOrder = 3
end end
object ReloadButton: TButton object buttonReload: TButton
Left = 10 Left = 10
Height = 24 Height = 24
Top = 4 Top = 4
Width = 59 Width = 59
Caption = '&Reload' Caption = '&Reload'
Enabled = False OnClick = buttonReloadClick
OnClick = ReloadButtonClick
TabOrder = 0 TabOrder = 0
end end
object BackButton: TButton object buttonBack: TButton
Left = 69 Left = 69
Height = 24 Height = 24
Top = 4 Top = 4
@@ -84,7 +83,7 @@ object formBrowser: TformBrowser
OnClick = FwdBackClick OnClick = FwdBackClick
TabOrder = 1 TabOrder = 1
end end
object FwdButton: TButton object buttonForward: TButton
Left = 128 Left = 128
Height = 24 Height = 24
Top = 4 Top = 4

122
applications/fpbrowser/mainform.lrs
View File

@@ -18,65 +18,65 @@ LazarusResources.Add('TformBrowser','FORMDATA',[
+'bvNone'#12'ClientHeight'#2'!'#11'ClientWidth'#3'm'#2#8'TabOrder'#2#1#0#5'TE' +'bvNone'#12'ClientHeight'#2'!'#11'ClientWidth'#3'm'#2#8'TabOrder'#2#1#0#5'TE'
+'dit'#7'editURL'#4'Left'#3#190#0#6'Height'#2#24#3'Top'#2#4#5'Width'#3'Q'#1#8 +'dit'#7'editURL'#4'Left'#3#190#0#6'Height'#2#24#3'Top'#2#4#5'Width'#3'Q'#1#8
+'AutoSize'#8#9'OnKeyDown'#7#14'editURLKeyDown'#7'TabStop'#8#8'TabOrder'#2#3#0 +'AutoSize'#8#9'OnKeyDown'#7#14'editURLKeyDown'#7'TabStop'#8#8'TabOrder'#2#3#0
+#0#7'TButton'#12'ReloadButton'#4'Left'#2#10#6'Height'#2#24#3'Top'#2#4#5'Widt' +#0#7'TButton'#12'buttonReload'#4'Left'#2#10#6'Height'#2#24#3'Top'#2#4#5'Widt'
+'h'#2';'#7'Caption'#6#7'&Reload'#7'Enabled'#8#7'OnClick'#7#17'ReloadButtonCl' +'h'#2';'#7'Caption'#6#7'&Reload'#7'OnClick'#7#17'buttonReloadClick'#8'TabOrd'
+'ick'#8'TabOrder'#2#0#0#0#7'TButton'#10'BackButton'#4'Left'#2'E'#6'Height'#2 +'er'#2#0#0#0#7'TButton'#10'buttonBack'#4'Left'#2'E'#6'Height'#2#24#3'Top'#2#4
+#24#3'Top'#2#4#5'Width'#2';'#7'Caption'#6#5'&Back'#7'Enabled'#8#7'OnClick'#7 +#5'Width'#2';'#7'Caption'#6#5'&Back'#7'Enabled'#8#7'OnClick'#7#12'FwdBackCli'
+#12'FwdBackClick'#8'TabOrder'#2#1#0#0#7'TButton'#9'FwdButton'#4'Left'#3#128#0 +'ck'#8'TabOrder'#2#1#0#0#7'TButton'#13'buttonForward'#4'Left'#3#128#0#6'Heig'
+#6'Height'#2#24#3'Top'#2#4#5'Width'#2';'#7'Caption'#6#8'&Forward'#7'Enabled' +'ht'#2#24#3'Top'#2#4#5'Width'#2';'#7'Caption'#6#8'&Forward'#7'Enabled'#8#7'O'
+#8#7'OnClick'#7#12'FwdBackClick'#8'TabOrder'#2#2#0#0#0#12'TPageControl'#11'p' +'nClick'#7#12'FwdBackClick'#8'TabOrder'#2#2#0#0#0#12'TPageControl'#11'pageBr'
+'ageBrowser'#4'Left'#2#0#6'Height'#3'i'#1#3'Top'#2'!'#5'Width'#3'm'#2#10'Act' +'owser'#4'Left'#2#0#6'Height'#3'i'#1#3'Top'#2'!'#5'Width'#3'm'#2#10'ActivePa'
+'ivePage'#7#10'tabBrowser'#5'Align'#7#8'alClient'#8'ShowTabs'#8#8'TabIndex'#2 +'ge'#7#10'tabBrowser'#5'Align'#7#8'alClient'#8'ShowTabs'#8#8'TabIndex'#2#0#8
+#0#8'TabOrder'#2#2#0#9'TTabSheet'#10'tabBrowser'#7'Caption'#6#7'Browser'#12 +'TabOrder'#2#2#0#9'TTabSheet'#10'tabBrowser'#7'Caption'#6#7'Browser'#12'Clie'
+'ClientHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#6'TPanel'#12'panelBrowser'#4 +'ntHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#6'TPanel'#12'panelBrowser'#4'Left'
+'Left'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3'k'#2#5'Align'#7#8'alClient' +#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3'k'#2#5'Align'#7#8'alClient'#10'B'
+#10'BevelInner'#7#9'bvLowered'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#12'pa' +'evelInner'#7#9'bvLowered'#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#12'panelB'
+'nelBrowser'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tabDebug'#7'Caption'#6#5'D' +'rowser'#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tabDebug'#7'Caption'#6#5'Debug'
+'ebug'#12'ClientHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#5'TMemo'#9'memoDebug' +#12'ClientHeight'#3'g'#1#11'ClientWidth'#3'k'#2#0#5'TMemo'#9'memoDebug'#4'Le'
+#4'Left'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3'k'#2#5'Align'#7#8'alClie' +'ft'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Width'#3'k'#2#5'Align'#7#8'alClient'
+'nt'#13'Lines.Strings'#1#6#9'memoDebug'#0#8'TabOrder'#2#0#0#0#0#9'TTabSheet' +#13'Lines.Strings'#1#6#9'memoDebug'#0#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#9't'
+#9'tabSource'#7'Caption'#6#6'Source'#12'ClientHeight'#3'g'#1#11'ClientWidth' +'abSource'#7'Caption'#6#6'Source'#12'ClientHeight'#3'g'#1#11'ClientWidth'#3
+#3'k'#2#0#5'TMemo'#10'memoSource'#4'Left'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5 +'k'#2#0#5'TMemo'#10'memoSource'#4'Left'#2#0#6'Height'#3'g'#1#3'Top'#2#0#5'Wi'
+'Width'#3'k'#2#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#10'memoSource'#0 +'dth'#3'k'#2#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#10'memoSource'#0#8
+#8'TabOrder'#2#0#0#0#0#0#11'TOpenDialog'#10'OpenDialog'#10'DefaultExt'#6#4'.' +'TabOrder'#2#0#0#0#0#0#11'TOpenDialog'#10'OpenDialog'#10'DefaultExt'#6#4'.ht'
+'htm'#6'Filter'#6'%html files|*.htm;*.html|all files|*.*'#7'Options'#11#14'o' +'m'#6'Filter'#6'%html files|*.htm;*.html|all files|*.*'#7'Options'#11#14'ofH'
+'fHideReadOnly'#15'ofPathMustExist'#15'ofFileMustExist'#0#4'left'#3'I'#1#3't' +'ideReadOnly'#15'ofPathMustExist'#15'ofFileMustExist'#0#4'left'#3'I'#1#3'top'
+'op'#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3'#'#1#3'top'#2#4#0#9'TMenuIte' +#2#2#0#0#9'TMainMenu'#8'MainMenu'#4'left'#3'#'#1#3'top'#2#4#0#9'TMenuItem'#5
+'m'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'Open'#7'Caption'#6#5'&Op' +'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#4'Open'#7'Caption'#6#5'&Open'#8
+'en'#8'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0#0#9'TMenuItem'#12'Ope' +'ShortCut'#2'r'#7'OnClick'#7#13'OpenFileClick'#0#0#9'TMenuItem'#12'OpenTextF'
+'nTextFile'#7'Caption'#6#15'Open &Text File'#7'OnClick'#7#17'OpenTextFileCli' +'ile'#7'Caption'#6#15'Open &Text File'#7'OnClick'#7#17'OpenTextFileClick'#0#0
+'ck'#0#0#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16'Open &Image File'#7 +#9'TMenuItem'#13'OpenImageFile'#7'Caption'#6#16'Open &Image File'#7'OnClick'
+'OnClick'#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'PrinterSetup1'#7'Capt' +#7#18'OpenImageFileClick'#0#0#9'TMenuItem'#13'PrinterSetup1'#7'Caption'#6#16
+'ion'#6#16'Printer Setup...'#7'OnClick'#7#18'PrinterSetup1Click'#0#0#9'TMenu' +'Printer Setup...'#7'OnClick'#7#18'PrinterSetup1Click'#0#0#9'TMenuItem'#12'P'
+'Item'#12'Printpreview'#7'Caption'#6#14'Print pre&view'#7'Enabled'#8#7'OnCli' +'rintpreview'#7'Caption'#6#14'Print pre&view'#7'Enabled'#8#7'OnClick'#7#17'P'
+'ck'#7#17'PrintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7'Caption'#6#9'&Prin' +'rintpreviewClick'#0#0#9'TMenuItem'#6'Print1'#7'Caption'#6#9'&Print...'#7'En'
+'t...'#7'Enabled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMenuItem'#2'N1'#7'Ca' +'abled'#8#7'OnClick'#7#11'Print1Click'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1
+'ption'#6#1'-'#0#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'E&xit'#7'OnClick'#7 +'-'#0#0#9'TMenuItem'#5'Exit1'#7'Caption'#6#5'E&xit'#7'OnClick'#7#10'Exit1Cli'
+#10'Exit1Click'#0#0#0#9'TMenuItem'#5'Edit2'#7'Caption'#6#5'&Edit'#7'OnClick' +'ck'#0#0#0#9'TMenuItem'#5'Edit2'#7'Caption'#6#5'&Edit'#7'OnClick'#7#10'Edit2'
+#7#10'Edit2Click'#0#9'TMenuItem'#5'Find1'#7'Caption'#6#5'&Find'#7'Enabled'#8 +'Click'#0#9'TMenuItem'#5'Find1'#7'Caption'#6#5'&Find'#7'Enabled'#8#7'OnClick'
+#7'OnClick'#7#10'Find1Click'#0#0#9'TMenuItem'#8'CopyItem'#7'Caption'#6#5'&Co' +#7#10'Find1Click'#0#0#9'TMenuItem'#8'CopyItem'#7'Caption'#6#5'&Copy'#8'Short'
+'py'#8'ShortCut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9'TMenuItem'#2'N2' +'Cut'#3'C@'#7'OnClick'#7#13'CopyItemClick'#0#0#9'TMenuItem'#2'N2'#7'Caption'
+#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Caption'#6#11'Select' +#6#1'-'#0#0#9'TMenuItem'#13'SelectAllItem'#7'Caption'#6#11'Select &All'#7'En'
+' &All'#7'Enabled'#8#7'OnClick'#7#18'SelectAllItemClick'#0#0#0#9'TMenuItem'#8 +'abled'#8#7'OnClick'#7#18'SelectAllItemClick'#0#0#0#9'TMenuItem'#8'options1'
+'options1'#7'Caption'#6#6'&Tools'#0#9'TMenuItem'#10'ShowImages'#7'Caption'#6 +#7'Caption'#6#6'&Tools'#0#9'TMenuItem'#10'ShowImages'#7'Caption'#6#12'&Show '
+#12'&Show images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMenuItem'#5'Fonts' +'images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMenuItem'#5'Fonts'#7'Captio'
+#7'Caption'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'FontColorsClick'#0 +'n'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'FontColorsClick'#0#0#9'TMe'
+#0#9'TMenuItem'#13'menuViewDebug'#7'Caption'#6#26'View Source and Debug info' +'nuItem'#13'menuViewDebug'#7'Caption'#6#26'View Source and Debug info'#7'OnC'
+#7'OnClick'#7#18'menuViewDebugClick'#0#0#0#9'TMenuItem'#15'HistoryMenuItem'#7 +'lick'#7#18'menuViewDebugClick'#0#0#0#9'TMenuItem'#15'HistoryMenuItem'#7'Cap'
+'Caption'#6#8'&History'#7'Visible'#8#0#0#9'TMenuItem'#6'About1'#7'Caption'#6 +'tion'#6#8'&History'#7'Visible'#8#0#0#9'TMenuItem'#6'About1'#7'Caption'#6#6
+#6'&About'#7'OnClick'#7#11'About1Click'#0#0#0#12'TPrintDialog'#11'PrintDialo' +'&About'#7'OnClick'#7#11'About1Click'#0#0#0#12'TPrintDialog'#11'PrintDialog'
,'g'#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7'Options'#11#10'poPa' ,#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7'Options'#11#10'poPageN'
+'geNums'#0#6'ToPage'#2#1#4'left'#3'j'#1#3'top'#2#1#0#0#11'TFindDialog'#10'Fi' +'ums'#0#6'ToPage'#2#1#4'left'#3'j'#1#3'top'#2#1#0#0#11'TFindDialog'#10'FindD'
+'ndDialog'#7'Options'#11#6'frDown'#15'frHideWholeWord'#18'frDisableWholeWord' +'ialog'#7'Options'#11#6'frDown'#15'frHideWholeWord'#18'frDisableWholeWord'#0
+#0#6'OnFind'#7#14'FindDialogFind'#4'left'#3#248#0#3'top'#2#4#0#0#10'TPopupMe' +#6'OnFind'#7#14'FindDialogFind'#4'left'#3#248#0#3'top'#2#4#0#0#10'TPopupMenu'
+'nu'#9'PopupMenu'#4'left'#3#144#1#3'top'#2#1#0#9'TMenuItem'#9'Viewimage'#7'C' +#9'PopupMenu'#4'left'#3#144#1#3'top'#2#1#0#9'TMenuItem'#9'Viewimage'#7'Capti'
+'aption'#6#11'&View image'#7'OnClick'#7#14'ViewimageClick'#0#0#9'TMenuItem' +'on'#6#11'&View image'#7'OnClick'#7#14'ViewimageClick'#0#0#9'TMenuItem'#20'C'
+#20'CopyImageToClipboard'#7'Caption'#6#24'&Copy image to clipboard'#7'OnClic' +'opyImageToClipboard'#7'Caption'#6#24'&Copy image to clipboard'#7'OnClick'#7
+'k'#7#25'CopyImageToClipboardClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'#6#1'-' +#25'CopyImageToClipboardClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'#6#1'-'#0#0#9
+#0#0#9'TMenuItem'#15'OpenInNewWindow'#7'Caption'#6#19'&Open in new window'#7 +'TMenuItem'#15'OpenInNewWindow'#7'Caption'#6#19'&Open in new window'#7'OnCli'
+'OnClick'#7#20'OpenInNewWindowClick'#0#0#0#6'TTimer'#9'MetaTimer'#7'Enabled' +'ck'#7#20'OpenInNewWindowClick'#0#0#0#6'TTimer'#9'MetaTimer'#7'Enabled'#8#7
+#8#7'OnTimer'#7#14'MetaTimerTimer'#4'left'#3#242#0#3'top'#2'K'#0#0#6'TTimer' +'OnTimer'#7#14'MetaTimerTimer'#4'left'#3#242#0#3'top'#2'K'#0#0#6'TTimer'#6'T'
+#6'Timer1'#8'Interval'#3#200#0#7'OnTimer'#7#11'Timer1Timer'#4'left'#3'0'#1#3 +'imer1'#8'Interval'#3#200#0#7'OnTimer'#7#11'Timer1Timer'#4'left'#3'0'#1#3'to'
+'top'#2'G'#0#0#19'TPrinterSetupDialog'#18'PrinterSetupDialog'#4'left'#3#192#1 +'p'#2'G'#0#0#19'TPrinterSetupDialog'#18'PrinterSetupDialog'#4'left'#3#192#1#0
+#0#0#0 +#0#0
]); ]);

258
applications/fpbrowser/mainform.pas
View File

@@ -21,8 +21,6 @@ uses
HTMLabt, HTMLabt,
pageloader; pageloader;
const
MaxHistories = 6; {size of History list}
type type
{$ifdef FPBROWSER_TURBOPOWERIPRO} {$ifdef FPBROWSER_TURBOPOWERIPRO}
@@ -54,9 +52,9 @@ type
ShowImages: TMenuItem; ShowImages: TMenuItem;
Fonts: TMenuItem; Fonts: TMenuItem;
editURL: TEdit; editURL: TEdit;
ReloadButton: TButton; buttonReload: TButton;
BackButton: TButton; buttonBack: TButton;
FwdButton: TButton; buttonForward: TButton;
HistoryMenuItem: TMenuItem; HistoryMenuItem: TMenuItem;
Exit1: TMenuItem; Exit1: TMenuItem;
PrintDialog: TPrintDialog; PrintDialog: TPrintDialog;
@@ -88,7 +86,7 @@ type
procedure menuViewDebugClick(Sender: TObject); procedure menuViewDebugClick(Sender: TObject);
procedure OpenFileClick(Sender: TObject); procedure OpenFileClick(Sender: TObject);
procedure ShowImagesClick(Sender: TObject); procedure ShowImagesClick(Sender: TObject);
procedure ReloadButtonClick(Sender: TObject); procedure buttonReloadClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FwdBackClick(Sender: TObject); procedure FwdBackClick(Sender: TObject);
procedure HistoryClick(Sender: TObject); procedure HistoryClick(Sender: TObject);
@@ -128,7 +126,8 @@ type
{$IFDEF LCLCarbon} {$IFDEF LCLCarbon}
AppMenu : TMenuItem; AppMenu : TMenuItem;
{$ENDIF} {$ENDIF}
Histories: array[0..MaxHistories-1] of TMenuItem; History: TStringList;
HistoryIndex: Integer;
MediaCount: integer; MediaCount: integer;
NewWindowFile: string; NewWindowFile: string;
NextFile, PresentFile: string; NextFile, PresentFile: string;
@@ -181,6 +180,7 @@ type
MyPageLoaderThread: TPageLoaderThread; MyPageLoaderThread: TPageLoaderThread;
MyPageLoader: TPageLoader; MyPageLoader: TPageLoader;
procedure LoadURL(AURL: string); procedure LoadURL(AURL: string);
procedure AddURLToHistory(AURL: string);
procedure HandlePageLoaderProgress(APercent: Integer); procedure HandlePageLoaderProgress(APercent: Integer);
procedure HandlePageLoaderTerminated(Sender: TObject); procedure HandlePageLoaderTerminated(Sender: TObject);
end; end;
@@ -217,14 +217,14 @@ end;
function TformBrowser.DataProvider1CanHandle(Sender: TObject; const URL: string function TformBrowser.DataProvider1CanHandle(Sender: TObject; const URL: string
): Boolean; ): Boolean;
begin begin
WriteLn('TForm1.DataProvider1CanHandle ',URL); WriteLn('TformBrowser.DataProvider1CanHandle ',URL);
Result:=True; Result:=True;
end; end;
procedure TformBrowser.DataProvider1CheckURL(Sender: TObject; const URL: string; procedure TformBrowser.DataProvider1CheckURL(Sender: TObject; const URL: string;
var Available: Boolean; var ContentType: string); var Available: Boolean; var ContentType: string);
begin begin
WriteLn('TForm1.DataProvider1CheckURL ',URL); WriteLn('TformBrowser.DataProvider1CheckURL ',URL);
Available:=True; Available:=True;
ContentType:='text/html'; ContentType:='text/html';
end; end;
@@ -234,17 +234,39 @@ procedure TformBrowser.DataProvider1GetHtml(Sender: TObject; const URL: string;
var var
lStream: TMemoryStream; lStream: TMemoryStream;
begin begin
WriteLn('TForm1.DataProvider1GetHtml ',URL); WriteLn('TformBrowser.DataProvider1GetHtml ',URL);
MyPageLoader.LoadBinaryResource(URL, lStream); { MyPageLoader.LoadBinaryResource(URL, lStream);
Stream := lStream; Stream := lStream;
lStream.Position := 0; lStream.Position := 0;}
Stream := nil;
LoadURL(URL);
end; end;
procedure TformBrowser.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string; procedure TformBrowser.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture); var Picture: TPicture);
var
lStream: TMemoryStream = nil;
lStr: String;
begin begin
//debugln(['TForm1.DataProvider1GetImage ',URL]); WriteLn('TformBrowser.DataProvider1GetImage ',URL);
Picture:=nil; lStr := ExtractFileExt(URL);
if (lStr = '.jpeg') or (lStr = '.jpg') then
begin
try
MyPageLoader.LoadBinaryResource(URL, lStream);
Picture := TPicture.Create;
Picture.Jpeg.LoadFromStream(lStream);
finally
lStream.Free
end;
end
else
begin
WriteLn('TformBrowser.DataProvider1GetImage Unsupported format: ', lStr);
Picture := nil;
Exit;
end;
// and (lStr <> '.bmp') and (lStr <> '.png')
end; end;
procedure TformBrowser.DataProvider1Leave(Sender: TIpHtml); procedure TformBrowser.DataProvider1Leave(Sender: TIpHtml);
@@ -282,6 +304,7 @@ var
I: integer; I: integer;
begin begin
MyPageLoader := TPageLoader.Create; MyPageLoader := TPageLoader.Create;
History := TStringList.Create;
{$ifdef FPBROWSER_TURBOPOWERIPRO} {$ifdef FPBROWSER_TURBOPOWERIPRO}
DataProvider1:=TMyIpHtmlDataProvider.Create(Self); DataProvider1:=TMyIpHtmlDataProvider.Create(Self);
@@ -336,7 +359,7 @@ begin
Viewer.OnPrintHTMLHeader := ViewerPrintHTMLHeader; Viewer.OnPrintHTMLHeader := ViewerPrintHTMLHeader;
Viewer.OnPrintHTMLFooter := ViewerPrintHTMLFooter; Viewer.OnPrintHTMLFooter := ViewerPrintHTMLFooter;
Viewer.OnInclude := ViewerInclude; Viewer.OnInclude := ViewerInclude;
Viewer.OnSoundRequest := SoundRequest; //Viewer.OnSoundRequest := SoundRequest;
Viewer.OnMetaRefresh := MetaRefreshEvent; Viewer.OnMetaRefresh := MetaRefreshEvent;
Viewer.OnObjectClick := ObjectClick; Viewer.OnObjectClick := ObjectClick;
Viewer.OnRightClick := RightClick; Viewer.OnRightClick := RightClick;
@@ -356,7 +379,7 @@ begin
Caption := 'HTML Demo, Version '+HTMLAbt.Version; Caption := 'HTML Demo, Version '+HTMLAbt.Version;
for I := 0 to MaxHistories-1 do (*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]);
@@ -366,7 +389,7 @@ begin
OnClick := HistoryClick; OnClick := HistoryClick;
Tag := I; Tag := I;
end; end;
end; end;*)
{$IFDEF LCLCarbon} {$IFDEF LCLCarbon}
AppMenu := TMenuItem.Create(Self); //Application menu AppMenu := TMenuItem.Create(Self); //Application menu
@@ -582,13 +605,13 @@ begin
{$endif} {$endif}
end; end;
procedure TformBrowser.ReloadButtonClick(Sender: TObject); procedure TformBrowser.buttonReloadClick(Sender: TObject);
{the Reload button was clicked} {the Reload button was clicked}
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$ifdef FPBROWSER_THTMLCOMP}
Viewer.ReLoadButton.Enabled := False; buttonReload.Enabled := False;
Viewer.ReLoad; Viewer.ReLoad;
Viewer.ReLoadButton.Enabled := CurrentFile <> ''; buttonReload.Enabled := Viewer.CurrentFile <> '';
Viewer.SetFocus; Viewer.SetFocus;
{$endif} {$endif}
end; end;
@@ -597,15 +620,24 @@ procedure TformBrowser.FwdBackClick(Sender: TObject);
{Either the Forward or Back button was clicked} {Either the Forward or Back button was clicked}
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$ifdef FPBROWSER_THTMLCOMP}
with Viewer do { if Sender = buttonBack then
begin Viewer.HistoryIndex := Viewer.HistoryIndex +1
if Sender = BackButton then
HistoryIndex := HistoryIndex +1
else else
HistoryIndex := HistoryIndex -1; Viewer.HistoryIndex := Viewer.HistoryIndex -1;
Self.Caption := DocumentTitle; Self.Caption := Viewer.DocumentTitle;}
end;
{$endif} {$endif}
LoadURL(History.Strings[HistoryIndex]);
if Sender = buttonBack then
begin
HistoryIndex := HistoryIndex-1;
if HistoryIndex < 0 then buttonBack.Enabled := False;
buttonForward.Enabled := True;
end
else
begin
HistoryIndex := HistoryIndex+1;
if HistoryIndex >= History.Count then buttonForward.Enabled := False;
end;
end; end;
procedure TformBrowser.HistoryChange(Sender: TObject); procedure TformBrowser.HistoryChange(Sender: TObject);
@@ -614,12 +646,12 @@ var
I: integer; I: integer;
Cap: string[80]; Cap: string[80];
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$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}
FwdButton.Enabled := HistoryIndex > 0; buttonForward.Enabled := HistoryIndex > 0;
BackButton.Enabled := HistoryIndex < History.Count-1; buttonBack.Enabled := HistoryIndex < History.Count-1;
{Enable and caption the appropriate history menuitems} {Enable and caption the appropriate history menuitems}
HistoryMenuItem.Visible := History.Count > 0; HistoryMenuItem.Visible := History.Count > 0;
@@ -638,21 +670,21 @@ with Sender as ThtmlViewer do
Caption := DocumentTitle; {keep the caption updated} Caption := DocumentTitle; {keep the caption updated}
Viewer.SetFocus; Viewer.SetFocus;
end; end;
{$endif} {$endif}
end; end;
{A history list menuitem got clicked on} {A history list menuitem got clicked on}
procedure TformBrowser.HistoryClick(Sender: TObject); procedure TformBrowser.HistoryClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$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} {$endif}
end; end;
procedure TformBrowser.Exit1Click(Sender: TObject); procedure TformBrowser.Exit1Click(Sender: TObject);
begin begin
Close; Close;
end; end;
procedure TformBrowser.FontColorsClick(Sender: TObject); procedure TformBrowser.FontColorsClick(Sender: TObject);
@@ -685,14 +717,14 @@ end;
procedure TformBrowser.Print1Click(Sender: TObject); procedure TformBrowser.Print1Click(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$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} {$endif}
end; end;
procedure TformBrowser.PrinterSetup1Click(Sender: TObject); procedure TformBrowser.PrinterSetup1Click(Sender: TObject);
@@ -707,52 +739,49 @@ end;
procedure TformBrowser.About1Click(Sender: TObject); procedure TformBrowser.About1Click(Sender: TObject);
begin begin
AboutBox := TAboutBox.CreateIt(Self, 'HTMLDemo', 'ThtmlViewer'); AboutBox := TAboutBox.CreateIt(Self, 'HTMLDemo', 'ThtmlViewer');
try try
AboutBox.ShowModal; AboutBox.ShowModal;
finally finally
AboutBox.Free; AboutBox.Free;
end; end;
end; end;
procedure TformBrowser.SubmitEvent(Sender: TObject; const AnAction, Target, EncType, Method: String; procedure TformBrowser.SubmitEvent(Sender: TObject; const AnAction, Target,
Results: TStringList); EncType, Method: String; Results: TStringList);
begin begin
with SubmitForm do SubmitForm.ActionText.Text := AnAction;
begin SubmitForm.MethodText.Text := Method;
ActionText.Text := AnAction; SubmitForm.ResultBox.Items := Results;
MethodText.Text := Method;
ResultBox.Items := Results;
Results.Free; Results.Free;
Show; SubmitForm.Show;
end;
end; end;
procedure TformBrowser.Find1Click(Sender: TObject); procedure TformBrowser.Find1Click(Sender: TObject);
begin begin
FindDialog.Execute; FindDialog.Execute;
end; end;
procedure TformBrowser.FindDialogFind(Sender: TObject); procedure TformBrowser.FindDialogFind(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$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} {$endif}
end; end;
procedure TformBrowser.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean); procedure TformBrowser.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$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; buttonForward.Enabled := False;
BackButton.Enabled := False; buttonBack.Enabled := False;
ReLoadButton.Enabled := False; buttonReload.Enabled := False;
Print1.Enabled := False; Print1.Enabled := False;
PrintPreview.Enabled := False; PrintPreview.Enabled := False;
Find1.Enabled := False; Find1.Enabled := False;
@@ -760,11 +789,11 @@ if ProcessingOn then
Open.Enabled := False; Open.Enabled := False;
CloseAll; {in case hint window is open} CloseAll; {in case hint window is open}
end end
else else
begin begin
FwdButton.Enabled := Viewer.HistoryIndex > 0; buttonForward.Enabled := Viewer.HistoryIndex > 0;
BackButton.Enabled := Viewer.HistoryIndex < Viewer.History.Count-1; buttonBack.Enabled := Viewer.HistoryIndex < Viewer.History.Count-1;
ReLoadButton.Enabled := Viewer.CurrentFile <> ''; buttonReload.Enabled := Viewer.CurrentFile <> '';
Print1.Enabled := Viewer.CurrentFile <> ''; Print1.Enabled := Viewer.CurrentFile <> '';
PrintPreview.Enabled := Viewer.CurrentFile <> ''; PrintPreview.Enabled := Viewer.CurrentFile <> '';
Find1.Enabled := Viewer.CurrentFile <> ''; Find1.Enabled := Viewer.CurrentFile <> '';
@@ -798,20 +827,20 @@ end;
procedure TformBrowser.OpenTextFileClick(Sender: TObject); procedure TformBrowser.OpenTextFileClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$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'+
'|Text Files (*.txt)|*.txt'+ '|Text Files (*.txt)|*.txt'+
'|All Files (*.*)|*.*'; '|All Files (*.*)|*.*';
if OpenDialog.Execute then if OpenDialog.Execute then
begin begin
ReloadButton.Enabled := False; buttonReload.Enabled := False;
Update; Update;
Viewer.LoadTextFile(OpenDialog.Filename); Viewer.LoadTextFile(OpenDialog.Filename);
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
begin begin
Caption := Viewer.DocumentTitle; Caption := Viewer.DocumentTitle;
ReLoadButton.Enabled := True; buttonReload.Enabled := True;
end; end;
end; end;
{$endif} {$endif}
@@ -819,23 +848,23 @@ end;
procedure TformBrowser.OpenImageFileClick(Sender: TObject); procedure TformBrowser.OpenImageFileClick(Sender: TObject);
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$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)|'+
'*.bmp;*.jpg;*.jpeg;*.gif;*.png|'+ '*.bmp;*.jpg;*.jpeg;*.gif;*.png|'+
'All Files (*.*)|*.*'; 'All Files (*.*)|*.*';
if OpenDialog.Execute then if OpenDialog.Execute then
begin begin
ReloadButton.Enabled := False; buttonReload.Enabled := False;
Viewer.LoadImageFile(OpenDialog.Filename); Viewer.LoadImageFile(OpenDialog.Filename);
if Viewer.CurrentFile <> '' then if Viewer.CurrentFile <> '' then
begin begin
Caption := Viewer.DocumentTitle; Caption := Viewer.DocumentTitle;
ReLoadButton.Enabled := True; buttonReload.Enabled := True;
end; end;
end; end;
{$endif} {$endif}
end; end;
procedure TformBrowser.DropFiles( Sender : TObject; procedure TformBrowser.DropFiles( Sender : TObject;
@@ -844,7 +873,7 @@ var
S : string; S : string;
Ext: string; Ext: string;
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$ifdef FPBROWSER_THTMLCOMP}
S := FileNames[0]; S := FileNames[0];
Ext := LowerCase(ExtractFileExt(S)); Ext := LowerCase(ExtractFileExt(S));
if (Ext = '.htm') or (Ext = '.html') then if (Ext = '.htm') or (Ext = '.html') then
@@ -881,7 +910,7 @@ var
S: string; S: string;
begin begin
{$ifdef FPBROWSER_THTMLCOMP} {$ifdef FPBROWSER_THTMLCOMP}
if OnClick = 'display' then if OnClick = 'display' then
begin begin
if Obj is TFormControlObj then if Obj is TFormControlObj then
with TFormControlObj(Obj) do with TFormControlObj(Obj) do
@@ -902,7 +931,7 @@ if OnClick = 'display' then
end; end;
end; end;
end end
else if OnClick <> '' then else if OnClick <> '' then
MessageDlg(OnClick, mtCustom, [mbOK], 0); MessageDlg(OnClick, mtCustom, [mbOK], 0);
{$endif} {$endif}
end; end;
@@ -933,13 +962,13 @@ var
I: integer; I: integer;
MS: TMemoryStream; MS: TMemoryStream;
begin begin
if CompareText(Command, 'Date') = 0 then if CompareText(Command, 'Date') = 0 then
S := DateToStr(Date) { <!--#date --> } S := DateToStr(Date) { <!--#date --> }
else if CompareText(Command, 'Time') = 0 then else if CompareText(Command, 'Time') = 0 then
S := TimeToStr(Time) { <!--#time --> } S := TimeToStr(Time) { <!--#time --> }
else if CompareText(Command, 'Include') = 0 then else if CompareText(Command, 'Include') = 0 then
begin {an include file <!--#include FILE="filename" --> } begin {an include file <!--#include FILE="filename" --> }
if (Params.count >= 1) then if (Params.count >= 1) then
begin begin
I := Pos('file=', Lowercase(Params[0])); I := Pos('file=', Lowercase(Params[0]));
if I > 0 then if I > 0 then
@@ -958,13 +987,14 @@ else if CompareText(Command, 'Include') = 0 then
end; end;
end; end;
end; end;
Params.Free; Params.Free;
end; end;
procedure TformBrowser.FormDestroy(Sender: TObject); procedure TformBrowser.FormDestroy(Sender: TObject);
begin begin
HintWindow.Free; HintWindow.Free;
MyPageLoader.Free; MyPageLoader.Free;
History.Free;
end; end;
{$ifdef FPBROWSER_THTMLCOMP} {$ifdef FPBROWSER_THTMLCOMP}
@@ -1127,6 +1157,13 @@ begin
MyPageLoaderThread.Resume; MyPageLoaderThread.Resume;
end; end;
procedure TformBrowser.AddURLToHistory(AURL: string);
begin
History.Add(AURL);
HistoryIndex := History.Count-1;
buttonBack.Enabled := True;
end;
procedure TformBrowser.HandlePageLoaderProgress(APercent: Integer); procedure TformBrowser.HandlePageLoaderProgress(APercent: Integer);
begin begin
labelProgress.Caption := 'Loading a Page'; labelProgress.Caption := 'Loading a Page';
@@ -1151,6 +1188,7 @@ begin
memoSource.Lines.AddStrings(MyPageLoader.ContentsList); memoSource.Lines.AddStrings(MyPageLoader.ContentsList);
memoDebug.Lines.Clear(); memoDebug.Lines.Clear();
memoDebug.Lines.AddStrings(MyPageLoader.DebugInfo); memoDebug.Lines.AddStrings(MyPageLoader.DebugInfo);
AddURLToHistory(MyPageLoader.LastPageURL);
end; end;
procedure TformBrowser.Timer1Timer(Sender: TObject); procedure TformBrowser.Timer1Timer(Sender: TObject);
@@ -1199,15 +1237,15 @@ end;
procedure TformBrowser.ViewerProgress(Sender: TObject; Stage: TProgressStage; procedure TformBrowser.ViewerProgress(Sender: TObject; Stage: TProgressStage;
PercentDone: Integer); PercentDone: Integer);
begin begin
ProgressBar.Position := PercentDone; ProgressBar.Position := PercentDone;
case Stage of case Stage of
psStarting: psStarting:
ProgressBar.Visible := True; ProgressBar.Visible := True;
psRunning:; psRunning:;
psEnding: psEnding:
ProgressBar.Visible := False; ProgressBar.Visible := False;
end; end;
ProgressBar.Update; ProgressBar.Update;
end; end;
{$endif} {$endif}
@@ -1229,12 +1267,12 @@ function ReplaceStr(Const S, FromStr, ToStr: string): string;
var var
I: integer; I: integer;
begin begin
I := Pos(FromStr, S); I := Pos(FromStr, S);
if I > 0 then if I > 0 then
begin begin
Result := S; Result := S;
Delete(Result, I, Length(FromStr)); Delete(Result, I, Length(FromStr));
Insert(ToStr, Result, I); Insert(ToStr, Result, I);
end; end;
end; end;
@@ -1244,9 +1282,9 @@ procedure TformBrowser.ViewerPrintHTMLHeader(Sender: TObject;
var var
S: string; S: string;
begin begin
S := ReplaceStr(HFText, '#left', Viewer.DocumentTitle); S := ReplaceStr(HFText, '#left', Viewer.DocumentTitle);
S := ReplaceStr(S, '#right', Viewer.CurrentFile); S := ReplaceStr(S, '#right', Viewer.CurrentFile);
HFViewer.LoadFromString(S); HFViewer.LoadFromString(S);
end; end;
procedure TformBrowser.ViewerPrintHTMLFooter(Sender: TObject; procedure TformBrowser.ViewerPrintHTMLFooter(Sender: TObject;
@@ -1254,9 +1292,9 @@ procedure TformBrowser.ViewerPrintHTMLFooter(Sender: TObject;
var var
S: string; S: string;
begin begin
S := ReplaceStr(HFText, '#left', DateToStr(Date)); 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} {$endif}

2
applications/fpbrowser/pageloader.pas
View File

@@ -82,7 +82,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)'; UserAgent := 'FPBrowser/1.0 (Mobile; U; en-GB)';
end; end;
destructor TPageLoader.Destroy; destructor TPageLoader.Destroy;