Einzelnen Beitrag anzeigen

wschrabi

Registriert seit: 16. Jan 2005
448 Beiträge
 
#3

AW: event auslösten in Javascript Page in TWEBBROWSER

  Alt 7. Jan 2016, 12:23
DANKE nahpets, Ich sehe da ist ein Profi der mir hilft.
Doch leider klappt es nicht. ich habs so gemacht.
Ich möchte in button1 auf die Rote Flache klicken, wo dann der TEXT INPUT Screen kommt
und in Button3) auf die START SEARCH Button Flache klicken.

DANKE DIR TAUSENDMAL!


Delphi-Quellcode:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  MSHTML, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    WebBrowser2: TWebBrowser;
    Button1: TButton;
    Button2: TButton; 
    Button3: TButton;
    Button4: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WebFormSetFieldValue( document: IHTMLDocument2; const formNumber: integer; const fieldName, newValue: string) ;
    procedure SetMyProfile(Name:string; Checkbox: TCheckbox);
    function WebFormGet(const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement;
    procedure CallFoo( );
    procedure CallStartSearch( );
    procedure ClickImage(wb : TWebBrowser; sImageName : String);
       
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  WWWdocument: IHTMLDocument2;

implementation

{$R *.dfm}

function TFORM1.WebFormGet(const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement;
var
   forms : IHTMLElementCollection;
begin
   forms := document.Forms as IHTMLElementCollection;
   result := forms.Item(formNumber,'') as IHTMLFormElement ;
end;

procedure TForm1.WebFormSetFieldValue(document: IHTMLDocument2; const formNumber: integer; const fieldName, newValue: string) ;
var
   form : IHTMLFormElement;
   field: IHTMLElement;

begin
   form := WebFormGet(formNumber, WebBrowser2.Document AS IHTMLDocument2) ;
   field := form.Item(fieldName,'') as IHTMLElement;

   if field = nil then Exit;

   if field.tagName = 'INPUTthen
      begin
      (field as IHTMLInputElement).value := newValue;
      ShowMessage(DateTimeToStr(Now)+': -> CN ausgefüllt! ');
      end;
   //if field.tagName = 'SELECT' then (field as IHTMLSelectElement) := newValue;
   //if field.tagName = 'TEXTAREA' then (field as IHTMLTextAreaElement) := newValue;
   
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // Here the event js handling routine is called. HOW???
   //CallFoo( );
   ClickImage(WebBrowser2, 'text_normal_metro.png');
   
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WWWdocument := WebBrowser2.Document as IHTMLDocument2;
  
  WebFormSetFieldValue(WWWdocument ,0,'NamesearchpageTextbox', Edit2.text) ;
  SetMyProfile('RadTextTile_Namesearchpage_Defaultprofile_ClientState', Checkbox1);
  
end;

procedure TForm1.CallFoo( );
  { Calls JavaScript foo() function }
var
  Doc: IHTMLDocument2; // current HTML document
  HTMLWindow: IHTMLWindow2; // parent window of current HTML document
  JSFn: string; // stores JavaScipt function call
begin
  // Get reference to current document
  Doc := WebBrowser2.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  // Get parent window of current document
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  // Run JavaScript
  try
    //JSFn := Format('foo("%s",%d)', [S, I]); // build function call
    // QUESTION 1
    // WHAT FUNCTION NAME must I enter here ??????
    JSFn := 'btn_StartpageTextSearch.close(true)'; // build function call
    HTMLWindow.execScript(JSFn, 'JavaScript'); // execute function
  except on Err:Exception do
   begin
     ShowMessage('Sorry: Exception: '+Err.Classname + ':' + Err.Message);

   end;
  end;
end;

procedure TForm1.CallStartSearch( );
  { Calls JavaScript foo() function }
var
  Doc: IHTMLDocument2; // current HTML document
  HTMLWindow: IHTMLWindow2; // parent window of current HTML document
  JSFn: string; // stores JavaScipt function call
begin
  // Get reference to current document
  Doc := WebBrowser2.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit; 
  // Get parent window of current document
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  // Run JavaScript
  try
    //JSFn := Format('foo("%s",%d)', [S, I]); // build function call
    // QUESTION 2
    // WHAT FUNCTION NAME must I enter here ??????
    JSFn := 'btn_StartpageTextSearch.close(true)'; // build function call
    HTMLWindow.execScript(JSFn, 'JavaScript'); // execute function
  except on Err:Exception do
   begin
     ShowMessage('Sorry: Exception: '+Err.Classname + ':' + Err.Message);

   end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   //Webbrowser2.Navigate(Edit1.text);
   CallStartSearch( );
   
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
   Webbrowser2.Navigate(Edit1.text);

end;

procedure TForm1.SetMyProfile(Name:string; Checkbox: TCheckbox);
begin
  if Checkbox.checked then
      WebFormSetFieldValue(WWWdocument ,0,Name, '{"selected":true}')
  else
      WebFormSetFieldValue(WWWdocument ,0,Name, '{"selected":false}') ;

end;

procedure TForm1.ClickImage(wb : TWebBrowser; sImageName : String);
var
  iDoc: IHtmlDocument2;
  i: integer;
  ov: OleVariant;
  iDisp: IDispatch;
  iColl: IHTMLElementCollection;
  InputImage: HTMLInputImage;
begin
  wb.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
  if not Assigned(iDoc) then begin
    Exit;
  end;
  ov := 'INPUT';
  iDisp := iDoc.all.tags(ov);
  if Assigned(IDisp) then begin
    IDisp.QueryInterface(IHTMLElementCollection, iColl);
    if Assigned(iColl) then begin
      for i := 1 to iColl.Get_length do begin
        iDisp := iColl.item(pred(i), 0);
        iDisp.QueryInterface(HTMLInputImage, InputImage);
        if Assigned(InputImage) then begin
          if InputImage.Name = sImageName then begin
            InputImage.Click; // klick es
          end;
        end;
      end;
    end;
  end;
end;

end.
Angehängte Dateien
Dateityp: zip EventFireJS_DEMO.zip (3,77 MB, 7x aufgerufen)
  Mit Zitat antworten Zitat