[DUG] TWebBrowser Populating a Combo Box
Paul A Norman
paul.a.norman at gmail.com
Wed Apr 5 14:54:12 NZST 2006
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
OnCreate = FormCreate
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
OnClick = BitBtn2Click
end
object BitBtn3: TBitBtn
Left = 128
Top = 408
Width = 81
Height = 25
Caption = 'Fill Drop Down'
TabOrder = 3
OnClick = BitBtn3Click
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 rloewy at hyperact.com
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 onclick="onChoose(this)" 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 <vss at vss.co.nz> 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
> Delphi at ns3.123.co.nz
> http://ns3.123.co.nz/mailman/listinfo/delphi
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://ns3.123.co.nz/pipermail/delphi/attachments/20060405/d7e1f74f/attachment.html
More information about the Delphi
mailing list