fpbrowser: Adds a configuration dialog with a user agent switcher

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2308 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2012-02-22 14:35:04 +00:00
parent 3218aa8573
commit cce35768f7
10 changed files with 202 additions and 28 deletions
--- a/applications/fpbrowser/browserconfig.pas
+++ b/applications/fpbrowser/browserconfig.pas
@ -0,0 +1,39 @@
+unit browserconfig;
+
+{$mode delphi}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+
+  { TFPBrowserConfig }
+
+  TFPBrowserConfig = class
+  public
+    UserAgent: string;
+    constructor Create; virtual;
+  end;
+
+var
+  FPBrowserConfig: TFPBrowserConfig;
+
+implementation
+
+{ TFPBrowserConfig }
+
+constructor TFPBrowserConfig.Create;
+begin
+  inherited Create;
+  UserAgent := 'FPBrowser/1.0 (Mobile; U; en-GB)';
+end;
+
+initialization
+  FPBrowserConfig := TFPBrowserConfig.Create;
+
+finalization
+  FPBrowserConfig.Free;
+end.
+
--- a/applications/fpbrowser/dlgconfig.lfm
+++ b/applications/fpbrowser/dlgconfig.lfm
@ -0,0 +1,50 @@
+object formConfig: TformConfig
+  Left = 439
+  Height = 240
+  Top = 244
+  Width = 320
+  Caption = 'FPBrowser Preferences'
+  ClientHeight = 240
+  ClientWidth = 320
+  LCLVersion = '0.9.31'
+  object Label1: TLabel
+    Left = 8
+    Height = 14
+    Top = 8
+    Width = 59
+    Caption = 'User Agent:'
+    ParentColor = False
+  end
+  object comboUserAgent: TComboBox
+    Left = 8
+    Height = 21
+    Top = 24
+    Width = 304
+    ItemHeight = 13
+    ItemIndex = 0
+    Items.Strings = (
+      'FPBrowser/1.0 (Mobile; U; en-GB)'
+      'Opera/9.80 (iPhone; Opera Mini/6.5.1.23995/27.1227; U; pt) Presto/2.8.119 Version/11.10'
+    )
+    TabOrder = 0
+    Text = 'FPBrowser/1.0 (Mobile; U; en-GB)'
+  end
+  object btnClose: TButton
+    Left = 176
+    Height = 25
+    Top = 200
+    Width = 115
+    Caption = 'Save and Close'
+    OnClick = btnCloseClick
+    TabOrder = 1
+  end
+  object btnCancel: TButton
+    Left = 24
+    Height = 25
+    Top = 200
+    Width = 115
+    Caption = 'Cancel'
+    ModalResult = 2
+    TabOrder = 2
+  end
+end
--- a/applications/fpbrowser/dlgconfig.lrs
+++ b/applications/fpbrowser/dlgconfig.lrs
@ -0,0 +1,18 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TformConfig','FORMDATA',[
+  'TPF0'#11'TformConfig'#10'formConfig'#4'Left'#3#183#1#6'Height'#3#240#0#3'Top'
+  +#3#244#0#5'Width'#3'@'#1#7'Caption'#6#21'FPBrowser Preferences'#12'ClientHei'
+  +'ght'#3#240#0#11'ClientWidth'#3'@'#1#10'LCLVersion'#6#6'0.9.31'#0#6'TLabel'#6
+  +'Label1'#4'Left'#2#8#6'Height'#2#14#3'Top'#2#8#5'Width'#2';'#7'Caption'#6#11
+  +'User Agent:'#11'ParentColor'#8#0#0#9'TComboBox'#14'comboUserAgent'#4'Left'#2
+  +#8#6'Height'#2#21#3'Top'#2#24#5'Width'#3'0'#1#10'ItemHeight'#2#13#9'ItemInde'
+  +'x'#2#0#13'Items.Strings'#1#6' FPBrowser/1.0 (Mobile; U; en-GB)'#6'WOpera/9.'
+  +'80 (iPhone; Opera Mini/6.5.1.23995/27.1227; U; pt) Presto/2.8.119 Version/1'
+  +'1.10'#0#8'TabOrder'#2#0#4'Text'#6' FPBrowser/1.0 (Mobile; U; en-GB)'#0#0#7
+  +'TButton'#8'btnClose'#4'Left'#3#176#0#6'Height'#2#25#3'Top'#3#200#0#5'Width'
+  +#2's'#7'Caption'#6#14'Save and Close'#7'OnClick'#7#13'btnCloseClick'#8'TabOr'
+  +'der'#2#1#0#0#7'TButton'#9'btnCancel'#4'Left'#2#24#6'Height'#2#25#3'Top'#3
+  +#200#0#5'Width'#2's'#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2
+  +#2#0#0#0
+]);
--- a/applications/fpbrowser/dlgconfig.pas
+++ b/applications/fpbrowser/dlgconfig.pas
@ -0,0 +1,44 @@
+unit dlgconfig;
+
+{$mode delphi}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  StdCtrls, browserconfig;
+
+type
+
+  { TformConfig }
+
+  TformConfig = class(TForm)
+    btnClose: TButton;
+    btnCancel: TButton;
+    comboUserAgent: TComboBox;
+    Label1: TLabel;
+    procedure btnCloseClick(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end;
+
+var
+  formConfig: TformConfig;
+
+implementation
+
+{ TformConfig }
+
+procedure TformConfig.btnCloseClick(Sender: TObject);
+begin
+  FPBrowserConfig.UserAgent := comboUserAgent.Text;
+  Close;
+end;
+
+initialization
+  {$I dlgconfig.lrs}
+
+end.
+
--- a/applications/fpbrowser/fpbrowser.dpr
+++ b/applications/fpbrowser/fpbrowser.dpr
@ -25,11 +25,12 @@ uses
 {$ifdef FPBROWSER_TURBOPOWERIPRO}
  viewer_ipro,
 {$endif}
-  browserviewer, mod_braille, browserconstants;
+  browserviewer, mod_braille, browserconstants, dlgconfig, browserconfig;

 begin
  Application.Initialize;
  Application.CreateForm(TformBrowser, formBrowser);
  Application.CreateForm(TSubmitForm, SubmitForm);
+  Application.CreateForm(TformConfig, formConfig);
  Application.Run;
 end.
--- a/applications/fpbrowser/fpbrowser.lpi
+++ b/applications/fpbrowser/fpbrowser.lpi
@ -92,7 +92,7 @@
        <PackageName Value="LCL"/>
      </Item5>
    </RequiredPackages>
-    <Units Count="12">
+    <Units Count="14">
      <Unit0>
        <Filename Value="fpbrowser.dpr"/>
        <IsPartOfProject Value="True"/>
@ -161,6 +161,18 @@
        <IsPartOfProject Value="True"/>
        <UnitName Value="browserconstants"/>
      </Unit11>
+      <Unit12>
+        <Filename Value="dlgconfig.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="formConfig"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="dlgconfig"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="browserconfig.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="browserconfig"/>
+      </Unit13>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
--- a/applications/fpbrowser/mainform.lfm
+++ b/applications/fpbrowser/mainform.lfm
@ -129,6 +129,10 @@ object formBrowser: TformBrowser
    end
    object menuOptions: TMenuItem
      Caption = '&Tools'
+      object mnuPreferences: TMenuItem
+        Caption = 'Preferences'
+        OnClick = mnuPreferencesClick
+      end
      object ShowImages: TMenuItem
        Caption = '&Show images'
        OnClick = ShowImagesClick
--- a/applications/fpbrowser/mainform.lrs
+++ b/applications/fpbrowser/mainform.lrs
@ -39,25 +39,26 @@ LazarusResources.Add('TformBrowser','FORMDATA',[
  +'ItemClick'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#13'Sel'
  +'ectAllItem'#7'Caption'#6#11'Select &All'#7'Enabled'#8#7'OnClick'#7#18'Selec'
  +'tAllItemClick'#0#0#0#9'TMenuItem'#11'menuOptions'#7'Caption'#6#6'&Tools'#0#9
-  +'TMenuItem'#10'ShowImages'#7'Caption'#6#12'&Show images'#7'OnClick'#7#15'Sho'
-  +'wImagesClick'#0#0#9'TMenuItem'#5'Fonts'#7'Caption'#6#23'Default &Font/Color'
-  +'s...'#7'OnClick'#7#15'FontColorsClick'#0#0#9'TMenuItem'#13'menuViewDebug'#7
-  +'Caption'#6#26'View Source and Debug info'#7'OnClick'#7#18'menuViewDebugClic'
-  +'k'#0#0#9'TMenuItem'#16'menuToolsModules'#7'Caption'#6#7'Modules'#0#0#0#9'TM'
-  +'enuItem'#15'HistoryMenuItem'#7'Caption'#6#8'&History'#7'Visible'#8#0#0#9'TM'
-  +'enuItem'#6'About1'#7'Caption'#6#6'&About'#7'OnClick'#7#11'About1Click'#0#0#0
-  +#12'TPrintDialog'#11'PrintDialog'#8'FromPage'#2#1#7'MinPage'#2#1#7'MaxPage'#3
-  +#15''''#7'Options'#11#10'poPageNums'#0#6'ToPage'#2#1#4'left'#3'j'#1#3'top'#2
-  +#1#0#0#11'TFindDialog'#10'FindDialog'#7'Options'#11#6'frDown'#15'frHideWhole'
-  +'Word'#18'frDisableWholeWord'#0#6'OnFind'#7#14'FindDialogFind'#4'left'#3#248
-  +#0#3'top'#2#4#0#0#10'TPopupMenu'#9'PopupMenu'#4'left'#3#144#1#3'top'#2#1#0#9
-  +'TMenuItem'#9'Viewimage'#7'Caption'#6#11'&View image'#7'OnClick'#7#14'Viewim'
-  +'ageClick'#0#0#9'TMenuItem'#20'CopyImageToClipboard'#7'Caption'#6#24'&Copy i'
-  +'mage to clipboard'#7'OnClick'#7#25'CopyImageToClipboardClick'#0#0#9'TMenuIt'
-  +'em'#2'N3'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#15'OpenInNewWindow'#7'Caption'
-  +#6#19'&Open in new window'#7'OnClick'#7#20'OpenInNewWindowClick'#0#0#0#6'TTi'
-  +'mer'#9'MetaTimer'#7'Enabled'#8#7'OnTimer'#7#14'MetaTimerTimer'#4'left'#3#242
-  +#0#3'top'#2'K'#0#0#6'TTimer'#6'Timer1'#8'Interval'#3#200#0#7'OnTimer'#7#11'T'
-  +'imer1Timer'#4'left'#3'0'#1#3'top'#2'G'#0#0#19'TPrinterSetupDialog'#18'Print'
-  +'erSetupDialog'#4'left'#3#192#1#0#0#0
+  +'TMenuItem'#14'mnuPreferences'#7'Caption'#6#11'Preferences'#7'OnClick'#7#19
+  +'mnuPreferencesClick'#0#0#9'TMenuItem'#10'ShowImages'#7'Caption'#6#12'&Show '
+  +'images'#7'OnClick'#7#15'ShowImagesClick'#0#0#9'TMenuItem'#5'Fonts'#7'Captio'
+  +'n'#6#23'Default &Font/Colors...'#7'OnClick'#7#15'FontColorsClick'#0#0#9'TMe'
+  +'nuItem'#13'menuViewDebug'#7'Caption'#6#26'View Source and Debug info'#7'OnC'
+  +'lick'#7#18'menuViewDebugClick'#0#0#9'TMenuItem'#16'menuToolsModules'#7'Capt'
+  +'ion'#6#7'Modules'#0#0#0#9'TMenuItem'#15'HistoryMenuItem'#7'Caption'#6#8'&Hi'
+  +'story'#7'Visible'#8#0#0#9'TMenuItem'#6'About1'#7'Caption'#6#6'&About'#7'OnC'
+  +'lick'#7#11'About1Click'#0#0#0#12'TPrintDialog'#11'PrintDialog'#8'FromPage'#2
+  +#1#7'MinPage'#2#1#7'MaxPage'#3#15''''#7'Options'#11#10'poPageNums'#0#6'ToPag'
+  +'e'#2#1#4'left'#3'j'#1#3'top'#2#1#0#0#11'TFindDialog'#10'FindDialog'#7'Optio'
+  +'ns'#11#6'frDown'#15'frHideWholeWord'#18'frDisableWholeWord'#0#6'OnFind'#7#14
+  +'FindDialogFind'#4'left'#3#248#0#3'top'#2#4#0#0#10'TPopupMenu'#9'PopupMenu'#4
+  +'left'#3#144#1#3'top'#2#1#0#9'TMenuItem'#9'Viewimage'#7'Caption'#6#11'&View '
+  +'image'#7'OnClick'#7#14'ViewimageClick'#0#0#9'TMenuItem'#20'CopyImageToClipb'
+  +'oard'#7'Caption'#6#24'&Copy image to clipboard'#7'OnClick'#7#25'CopyImageTo'
+  +'ClipboardClick'#0#0#9'TMenuItem'#2'N3'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#15
+  +'OpenInNewWindow'#7'Caption'#6#19'&Open in new window'#7'OnClick'#7#20'OpenI'
+  +'nNewWindowClick'#0#0#0#6'TTimer'#9'MetaTimer'#7'Enabled'#8#7'OnTimer'#7#14
+  +'MetaTimerTimer'#4'left'#3#242#0#3'top'#2'K'#0#0#6'TTimer'#6'Timer1'#8'Inter'
+  +'val'#3#200#0#7'OnTimer'#7#11'Timer1Timer'#4'left'#3'0'#1#3'top'#2'G'#0#0#19
+  +'TPrinterSetupDialog'#18'PrinterSetupDialog'#4'left'#3#192#1#0#0#0
 ]);
--- a/applications/fpbrowser/mainform.pas
+++ b/applications/fpbrowser/mainform.pas
@ -16,13 +16,14 @@ uses
  customdrawnextras, customdrawncontrols,  customdrawndrawers, customdrawn_kde,
  //
  dlgabout, browserconstants,
-  pageloader, browserviewer, browsermodules;
+  pageloader, browserviewer, browsermodules, dlgconfig;

 type

  { TformBrowser }

  TformBrowser = class(TForm)
+    mnuPreferences: TMenuItem;
    pageBrowser: TCDPageControl;
    labelProgress: TLabel;
    menuToolsModules: TMenuItem;
@ -62,6 +63,7 @@ type
    PrinterSetup1: TMenuItem;
    procedure editURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure menuViewDebugClick(Sender: TObject);
+    procedure mnuPreferencesClick(Sender: TObject);
    procedure OpenFileClick(Sender: TObject);
    procedure pageBrowserChange(Sender: TObject);
    procedure ShowImagesClick(Sender: TObject);
@ -201,6 +203,11 @@ begin
  AddMemoTab(lDebugInfo, 'Debug', False);
 end;

+procedure TformBrowser.mnuPreferencesClick(Sender: TObject);
+begin
+  formConfig.ShowModal;
+end;
+
 {The Show Images menu item was clicked}
 procedure TformBrowser.ShowImagesClick(Sender: TObject);
 begin
--- a/applications/fpbrowser/pageloader.pas
+++ b/applications/fpbrowser/pageloader.pas
@ -6,7 +6,7 @@ interface

 uses
  Classes, SysUtils,
-  browsermodules;
+  browsermodules, browserconfig;

 type

@ -16,7 +16,6 @@ type
  public
    Contents: string;
    LastPageURL: string;
-    UserAgent: string;
    ContentsList: TStringList;
    DebugInfo: TStringList;
    constructor Create;
@ -86,7 +85,6 @@ constructor TPageLoader.Create;
 begin
  ContentsList := TStringList.Create;
  DebugInfo := TStringList.Create;
-  UserAgent := 'FPBrowser/1.0 (Mobile; U; en-GB)';
 end;

 destructor TPageLoader.Destroy;
@ -112,7 +110,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 := UserAgent;
+    Client.UserAgent := FPBrowserConfig.UserAgent;
    Client.HttpMethod('GET', LastPageURL);

 //    Client.Headers;