Re: [DUG] TWebBrowser Populating a Combo Box

Paul A Norman Tue, 04 Apr 2006 19:54:25 -0700

Sorry Jeremy,

I have just come into the group after a while.

If you are still on this project, one way to do this is as follows (Example dpr, pas and text version of form are below)

The expected innerHTML on a SELECT tag object or other DOM functions don't always perform in MS for this kind of situation.

The trick of it using MSHTML_TLB is to get ourselves an instance of IHTMLOptionElementFactory

Here is the heart of it:

procedure TForm1.BitBtn3Click(Sender: TObject);
var
dropElement : IHTMLSelectElement;
optionElement : ihtmloptionelement;
window2 : IHTMLWindow2 ;
makeOPtion : IHTMLOptionElementFactory;
count : integer;
begin

dropElement :=
(webbrowser1.document as ihtmldocument3).getElementById('ourDropDown') as IHTMLSelectElement;

//first clear any existing OPTION tags   (dropElement as ihtmlelement).innerHTML := '';

showmessage((dropElement as ihtmlelement).id + ' ok so far');

for count := low(displayText) to high(displayText) do
   begin
   window2 := (webbrowser1.Document as ihtmldocument2).parentWindow ;
     makeOPtion :=   window2.Option;
      optionElement := makeOPtion.create(displayText[count],valuesText[count],False,False);
   dropElement.add(optionElement as ihtmlelement,True);
   end;

end;

===================
program DropDown_Example;

uses
Forms,
main in 'main.pas' {Form1};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

=================

object Form1: TForm1
Left = 0
Top = 0
Width = 656
Height = 561
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
> PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
    Left = 40
    Top = 456
    Width = 450
    Height = 13
    Caption =
      'Click "Initialise" try the drop down box, then Click "Fill Drop ' +
      'Down" and try the drop down box.'
end
object WebBrowser1: TWebBrowser
    Left = 40
    Top = 16
    Width = 553
    Height = 377
    TabOrder = 0
    ControlData = {
      4C00000027390000F72600000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
end
object BitBtn1: TBitBtn
    Left = 496
    Top = 488
    Width = 75
    Height = 25
    TabOrder = 1
    Kind = bkClose
end
object BitBtn2: TBitBtn
    Left = 40
    Top = 408
    Width = 81
    Height = 25
    Caption = 'Initialise'
    TabOrder = 2
    > end
object BitBtn3: TBitBtn
    Left = 128
    Top = 408
    Width = 81
    Height = 25
    Caption = 'Fill Drop Down'
    TabOrder = 3
    > end
end

==========

unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, OleCtrls, SHDocVw, mshtml_tlb, activeX;

type
TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Label1: TLabel;
    procedure BitBtn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;
displayText : array [0 .. 2] of string = ('First', 'Second', 'Third');
valuesText : array [0 .. 2] of string = ('Chose Number One Option','Chose Number Two Option','Chose Number Three Option');

implementation

{$R *.dfm}

procedure TForm1.BitBtn2Click(Sender: TObject);
// tip from Ron Loewy [EMAIL PROTECTED]
var
v: Variant;
HTMLDocument: IHTMLDocument2;
HTMLString : string;
begin
   HTMLString := '<BODY>'
                 +'<Script>function onChoose(drop){text = drop.options[drop.selectedIndex].value ;alert(text);}</script>'
                 +'<textarea style="position:absolute;top:10;left:300 ">Some text</textarea>'
                 +'<select id="ourDropDown"><option value="will disappear">This will be replaced</option><option value="will also disappear">And So will this</option></select>'

+'</BODY>';
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
v := VarArrayCreate([0, 0], varVariant);
v[0] := HTMLString; // Here's your HTML string
HTMLDocument.Write (PSafeArray(TVarData(v).VArray));
HTMLDocument.Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
webbrowser1.Navigate('about:blank');
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
dropElement : IHTMLSelectElement;
optionElement : ihtmloptionelement;
window2 : IHTMLWindow2 ;
makeOPtion : IHTMLOptionElementFactory;
count : integer;
begin

dropElement :=
(webbrowser1.document as ihtmldocument3).getElementById('ourDropDown') as IHTMLSelectElement;

    (dropElement as ihtmlelement).innerHTML := '';
showmessage((dropElement as ihtmlelement).id + ' ok so far');
//rough and ready example here
for count := low(displayText) to high(displayText) do
   begin
   window2 := (webbrowser1.Document as ihtmldocument2).parentWindow ;
     makeOPtion :=   window2.Option;
      optionElement := makeOPtion.create(displayText[count],valuesText[count],False,False);
   dropElement.add (optionElement as ihtmlelement,True);
   end;

end;

end.

=======

On 30/03/06, Jeremy Coulter <[EMAIL PROTECTED]> wrote:

Hi All.

I am just looking into something, and have dropped a TWebBrowser onto a form.

I thne download a test webpage and populate the Text of a text box, and checka checkbox, BUT I want to beable to add items to a Dropdown/combo box.

Anyone done this in the past?

Thanks, Jeremy

--
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.1.385 / Virus Database: 268.3.3/296 - Release Date: 29/03/2006

--
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.1.385 / Virus Database: 268.3.3/296 - Release Date: 29/03/2006

_______________________________________________
Delphi mailing list
[email protected]
http://ns3.123.co.nz/mailman/listinfo/delphi

_______________________________________________
Delphi mailing list
[email protected]
http://ns3.123.co.nz/mailman/listinfo/delphi

Re: [DUG] TWebBrowser Populating a Combo Box

Reply via email to