webbrowser精华内容

网站上看到很多问题,特别是有关webbrowser的,很多人都舍不得将技术回答,现将近阶段整理的资料,奉献给大家,希望对大家有所用处
procedure TForm1.CheckFontState(Doc: IHTMLDocument2);

var

FontName: variant;

FontSize: variant;

 

begin

if Doc = nil then

Exit;

CBFontName.Visible := Doc.queryCommandSupported(’FontName’);

CBFontName.Enabled := Doc.queryCommandEnabled(’FontName’);

CBFontSize.Visible := Doc.queryCommandSupported(’FontSize’);

CBFontSize.Enabled := Doc.queryCommandEnabled(’FontSize’);

if CBFontName.Enabled then

begin

FontName := Doc.queryCommandValue(’FontName’);

if FontName <> null then

    begin

    if CBFontName.Items.IndexOf(FontName) >= 0 then

      begin

      CBFontName.ItemIndex := CBFontName.Items.IndexOf(FontName);

      end

    else

      begin

      if trim(FontName) <> ’’ then

        begin

        CBFontName.Items.Add(FontName);

        CBFontName.ItemIndex := CBFontName.Items.Count-1;

        end

      else

        begin

        CBFontName.ItemIndex := -1;

        end;

      end;

    end;

end;

if CBFontSize.Enabled then

begin

FontSize := Doc.queryCommandValue(’FontSize’);

if FontSize <> null then

    begin

    if CBFontSize.Items.IndexOf(FontSize) >= 0 then

      begin

      CBFontSize.ItemIndex := CBFontSize.Items.IndexOf(FontSize);

      end

    else

      begin

      if trim(FontSize) <> ’’ then

        begin

        CBFontSize.Items.Add(FontSize);

        CBFontSize.ItemIndex := CBFontSize.Items.Count-1;

        end

      else

        begin

        CBFontSize.ItemIndex := -1;

        end;

      end;

    end;

end;

end;

 

procedure TForm1.InsertHTMLContent(Doc: IHTMLDocument2; HTML: string);

var

Sel: IHTMLSelectionObject;

Range: IHTMLTxtRange;

 

begin

Sel := Doc.selection;

if assigned(Sel) then

begin

if (Sel.type_=’None’) or (Sel.type_=’Text’) then

    begin

    Range := Sel.createRange as IHTMLTxtRange;

    Range.pasteHTML(HTML);

    end;

end;

end;

procedure TForm1.SBInsertHTMLClick(Sender: TObject);

var

Doc: IHTMLDocument2;

 

begin

Doc := WebBrowser.Document as IHTMLDocument2;

if assigned(Doc) then

InsertHTMLContent(Doc, Memo1.Text);

end;

 

procedure TForm1.SBInsertBreakClick(Sender: TObject);

var

Doc: IHTMLDocument2;

 

begin

Doc := WebBrowser.Document as IHTMLDocument2;

if assigned(Doc) then

InsertHTMLContent(Doc, ’<BR>’);

end;

 

procedure TForm1.SBInsertTableClick(Sender: TObject);

var

Doc: IHTMLDocument2;

TableStr: string;

 

begin

Doc := WebBrowser.Document as IHTMLDocument2;

if assigned(Doc) then

begin

TableStr :=             ’<table border="1">’;

TableStr := TableStr + ’ <tr><th aling="left">Name</td><th align="right">Wert</td></tr>’;

TableStr := TableStr + ’ <tr><td aling="left">Test</td><td align="right">1</td></tr>’;

TableStr := TableStr + ’ <tr><td aling="left">Test2</td><td align="right">2</td></tr>’;

TableStr := TableStr + ’ <tr><td aling="left">letzter Test</td><td align="right">3</td></tr>’;

TableStr := TableStr + ’</table>’;

InsertHTMLContent(Doc, TableStr);

end;

end;

procedure TForm1.InsertBGImage(Doc: IHTMLDocument2; ImageURI: string);

var

Body: IHTMLBodyElement;

 

begin

Body := Doc.body as IHTMLBodyElement;

Body.background := ImageURI;

end;

 

procedure TForm1.SpeedButton2Click(Sender: TObject);

var

Doc: IHTMLDocument2;

 

begin

Doc := WebBrowser.Document as IHTMLDocument2;

if assigned(Doc) then

InsertBGImage(Doc, ’C:test.jpg’);

end;

function TForm1.GetElementAtPos(Doc: IHTMLDocument2; x, y: integer): IHTMLElement;

begin

Result := nil;

Result := Doc.elementFromPoint(x,y);

end;

 

function TForm1.ElementHasParent(Element: IHTMLElement;

TagName: string): boolean;

begin

Result := false;

while Element.tagName <> ’BODY’ do

begin

Element := Element.parentElement;

if Element.tagName = TagName then

    begin

    Result := true;

    exit;

    end;

end;

end;

procedure TForm1.DoMessage(var Msg: TMsg; var Handled: Boolean);

var

Pos: TPoint;

Doc: IHTMLDocument2;

Sel: IHTMLSelectionObject;

Element: IHTMLElement;

 

function GetWebBrowserPos(ScreenPos: TPoint; var BrowserPos: TPoint):boolean;

begin

    BrowserPos := WebBrowser.ScreenToClient(ScreenPos);

    Result:= (BrowserPos.x >= 0) and

      (BrowserPos.x < WebBrowser.ClientWidth) and

      (BrowserPos.y >= 0) and

      (BrowserPos.y < WebBrowser.ClientHeight);

end;

 

function GetDoc(var Doc: IHTMLDocument2): boolean;

begin

    Doc := WebBrowser.Document as IHTMLDocument2;

    Result := assigned(Doc);

end;

 

begin

if Msg.message = WM_KEYDOWN then

begin

if Msg.wParam = 13 then

    begin

if GetWebBrowserPos(Msg.pt, Pos) then

    begin

      if GetDoc(Doc) then

        begin

        Msg.wParam := 0;

        InsertHTMLContent(Doc,’<br>’);

        end;

      end;

    end;

end;

if Msg.message = WM_MOUSEMOVE then

begin

if GetWebBrowserPos(Msg.pt, Pos) then

    begin

    StatusBar.Panels[0].Text := IntToStr(Pos.x);

    StatusBar.Panels[1].Text := IntToStr(Pos.y);

    if GetDoc(Doc) then

      begin

      Element := GetElementAtPos(Doc, Pos.X, Pos.Y);

      if assigned(Element) then

        begin

        StatusBar.Panels[2].Text := Element.tagName;

        if Element.tagName = ’A’ then

          begin

          StatusBar.Panels[3].Text := ’Link’;

          end

        else

          begin

          if ElementHasParent(Element, ’A’) then

            StatusBar.Panels[3].Text := ’Link’

          else

            StatusBar.Panels[3].Text := ’No Link’;

          end;

        end;

      end;

    end;

end;

if Msg.message = WM_LBUTTONDOWN then

begin

//

end;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

if WebBrowser1.OleObject.Document.selection.Type = ’Text’ then

    WebBrowser1.OleObject.Document.execCommand(’CreateLink’);

end;

if btFarbe.Enabled then

begin

ForeColor := HTMLDocument2Ifc.queryCommandValue(’ForeColor’);

if ForeColor <> null then

    begin

      pnlFarbe.Color:=HTMLToColor(ForeColor);

    end;

end;

function HtmlToColor(Color: string): TColor;

begin

Result := StringToColor(’$’ + Copy(Color, 6, 2) + Copy(Color, 4, 2) + Copy(Color, 2, 2));

end;

function HtmlToColor(Color: string): TColor;

begin

Result := StrToInt(AColor);

end;

procedure TForm1.ForceCaretNextLine(Doc: IHTMLDocument2);

var

DisplayServices: IDisplayServices;

Caret: IHTMLCaret;

DisplayPointer: IDisplayPointer;

IsAtBol: integer;

IsPositioned: integer;

 

begin

Doc.QueryInterface(IID_IDisplayServices, DisplayServices);

if assigned(DisplayServices) then

begin

DisplayServices.GetCaret(Caret);

DisplayServices.CreateDisplayPointer(DisplayPointer);

if assigned(Caret) and assigned(DisplayPointer) then

    begin

    Caret.MoveDisplayPointerToCaret(DisplayPointer);

    DisplayPointer.IsPositioned(IsPositioned);

    if Boolean(IsPositioned) then

      begin

      DisplayPointer.IsAtBOL(IsAtBOL);

      if not Boolean(IsAtBol) then

        begin

        DisplayPointer.MoveUnit(DISPLAY_MOVEUNIT_NextLine, 0);

        Caret.MoveCaretToPointer(DisplayPointer, 0,CARET_DIRECTION_INDETERMINATE);

        end;

      end;

    end;

end;

end;

procedure TForm1.CheckFontState(Doc: IHTMLDocument2);

var

FontName: variant;

FontSize: variant;

 

begin

if Doc = nil then

Exit;

CBFontName.Visible := Doc.queryCommandSupported(’FontName’);

CBFontName.Enabled := Doc.queryCommandEnabled(’FontName’);

CBFontSize.Visible := Doc.queryCommandSupported(’FontSize’);

CBFontSize.Enabled := Doc.queryCommandEnabled(’FontSize’);

if CBFontName.Enabled then

begin

FontName := Doc.queryCommandValue(’FontName’);

if FontName <> null then

    begin

    if CBFontName.Items.IndexOf(FontName) >= 0 then

      begin

      CBFontName.ItemIndex := CBFontName.Items.IndexOf(FontName);

      end

    else

      begin

      if trim(FontName) <> ’’ then

        begin

        CBFontName.Items.Add(FontName);

        CBFontName.ItemIndex := CBFontName.Items.Count-1;

        end

      else

        begin

        CBFontName.ItemIndex := -1;

        end;

      end;

    end;

end;

if CBFontSize.Enabled then

begin

FontSize := Doc.queryCommandValue(’FontSize’);

if FontSize <> null then

    begin

    if CBFontSize.Items.IndexOf(FontSize) >= 0 then

      begin

      CBFontSize.ItemIndex := CBFontSize.Items.IndexOf(FontSize);

      end

    else

      begin

      if trim(FontSize) <> ’’ then

        begin

        CBFontSize.Items.Add(FontSize);

        CBFontSize.ItemIndex := CBFontSize.Items.Count-1;

        end

      else

        begin

        CBFontSize.ItemIndex := -1;

        end;

      end;

    end;

end;

end;

procedure TForm1.InsertHTMLContent(Doc: IHTMLDocument2; HTML: string);

var

Sel: IHTMLSelectionObject;

Range: IHTMLTxtRange;

 

begin

Sel := Doc.selection;

if assigned(Sel) then

begin

if (Sel.type_=’None’) or (Sel.type_=’Text’) then

    begin

    Range := Sel.createRange as IHTMLTxtRange;

    Range.pasteHTML(HTML);

    end;

end;

end;

procedure TForm1.tfXPButton5Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’Bold’, False, 0);

 

end;

 

procedure TForm1.tfXPButton6Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

 

HTMLDocument2Ifc.execCommand(’Italic’, False, 0);

 

end;

 

procedure TForm1.tfXPButton10Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’Underline’, False, 0);

 

end;

 

procedure TForm1.tfXPButton30Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

 

HTMLDocument2Ifc.execCommand(’StrikeThrough’, False, 0);

 

end;

 

procedure TForm1.tfXPButton31Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

 

HTMLDocument2Ifc.execCommand(’SubScript’, False, 0);

 

end;

 

procedure TForm1.tfXPButton32Click(Sender: TObject);

 

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

 

HTMLDocument2Ifc.execCommand(’SuperScript’, False, 0);

 

end;

 

procedure TForm1.tfXPButton19Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’InsertOrderedList’, false, ’0’);

 

end;

 

procedure TForm1.tfXPButton18Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’InsertUnorderedList’, false, ’0’);

 

end;

 

procedure TForm1.tfXPButton7Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’Justifyleft’, false, ’0’);

 

end;

 

procedure TForm1.tfXPButton22Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’Justifycenter’, false, ’0’);

 

end;

 

procedure TForm1.tfXPButton23Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’Justifyright’, false, ’Left’);

 

 

end;

 

procedure TForm1.tfXPButton25Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

begin

 

if ColorDialog1.Execute then

    edit1.Text := ColorToHtml(ColorDialog1.Color);

 

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’ForeColor’, False, ’’ + edit1.text + ’’);

end;

 

 

 

procedure TForm1.FlatComboBox1Click(Sender: TObject);

begin

if WebBrowser1.OleObject.Document.selection.Type = ’Text’ then

    WebBrowser1.OleObject.Document.execCommand(’FormatBlock’, False, ’’ + FlatComboBox1.text + ’’);

FlatComboBox1.text + ’’);

end;

 

procedure TForm1.FlatComboBox2Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

 

HTMLDocument2Ifc.execCommand(’FontSize’, False, ’’ + FlatComboBox2.text + ’’);

 

end;

procedure TForm1.tfXPButton1Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’Undo’, False, 0);

 

end;

 

procedure TForm1.tfXPButton2Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

 

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

HTMLDocument2Ifc.execCommand(’Redo’, False, 0);

 

end;

procedure TForm1.Bildeinfuegen3Click(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

begin

HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

   HTMLDocument2Ifc.ExecCommand(’InsertImage’, False, ’C:test.bmp’);

end;

procedure TForm1.LinkeinfuegenClick(Sender: TObject);

var

HTMLDocument2Ifc: IHTMLDocument2;

begin

    HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;

    WebBrowser1.OleObject.Document.ExecCommand(’CreateLink’);

end;

procedure TForm1.CheckButtonState(Doc: IHTMLDocument2; Btn: TSpeedButton; Command: string);

begin

if Doc = nil then

Exit;

Btn.Visible := Doc.queryCommandSupported(Command);

Btn.Enabled := Doc.queryCommandEnabled(Command);

Btn.Down := Doc.queryCommandState(Command);

end;

procedure TForm1.WebBrowserCommandStateChange(Sender: TObject;

Command: Integer; Enable: WordBool);

var

Doc: IHTMLDocument2;

begin

Doc := WebBrowser.Document as IHTMLDocument2;

if not assigned(Doc) then

exit;

CheckButtonState(Doc, SBBold, ’Bold’);

CheckButtonState(Doc, SBItalic, ’Italic’);

CheckButtonState(Doc, SBUnderline, ’Underline’);

CheckButtonState(Doc, SBJustifyLeft, ’JustifyLeft’);

CheckButtonState(Doc, SBJustifyCenter, ’JustifyCenter’);

CheckButtonState(Doc, SBJustifyRight, ’JustifyRight’);

CheckFontState(Doc);

end;

function TForm1.EditDesigner1PreHandleEvent(inEvtDispId: Integer;

const pIEventObj: IHTMLEventObj): HRESULT;

var

SpecialKeys: string;

 

begin

Result := S_FALSE;

case inEvtDispID of

    -602 :;   // key down

    -603 :; // key press

    -604 :;   // key up

    -2147418104 :; //Mouseover

    -2147418103 :; //Mouseout

    -606 : //MouseMove

      begin

      Label1.Caption := pIEventObj.srcElement.tagName;

      Label2.Caption := IntToStr(pIEventObj.x);

      Label3.Caption := IntToStr(pIEventObj.y);

      if pIEventObj.ctrlKey then

        SpecialKeys := SpecialKeys + ’-Ctrl’;

      if pIEventObj.altKey then

        SpecialKeys := SpecialKeys + ’-Alt’;

      if pIEventObj.shiftKey then

        SpecialKeys := SpecialKeys + ’-Shift’;

      Label4.Caption := SpecialKeys;

      end;

    -605 :;//MouseDown

    -607 :; //MouseUp

    end;

end;