• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    迪恩网络公众号

delphi从TWebbrowse组件中获取图片

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

在 delphi 中使用 TWebbrowse 组件,虽然效率不如用(idhttp之类)模拟操作效率高。但其难度低,上手快,简单粗暴有效。

从网上搜到的处理此问题的文章大多是 ctrl + c 复制到剪贴板的方法,但在 win7 64中,此法几乎没法使用,随时报剪贴板错误。

本方法利用 IHTMLElementRender 接口,完美地解决了问题。同时,也可以加深对接口的进一步理解。

delphi7源码下载

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, MSHtml;
type
  // 此定义是从 XE8 的 MSHTML 单元中抄的
  IHTMLElementRender = interface(IUnknown)
    ['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}']
    function DrawToDC(hdc: hdc): HResult; stdcall;
    function SetDocumentPrinter(const bstrPrinterName: WideString; hdc: hdc): HResult; stdcall;
  end;

  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FFirstShow: Boolean;
    FCodeBmp: TBitmap;
  end;

var
  Form1: TForm1;

implementation
const
  csUrl = 'https://account.guokr.com/sign_in/?';
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FFirstShow := true;
  FCodeBmp := TBitmap.Create;
  FCodeBmp.Height := 40;
  FCodeBmp.Width := 100;
  FCodeBmp.PixelFormat := pf24bit;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 // 做一个 FirstOnShow 功能。
 // OnCreate 事件中使用 WebBrowser1.Navigate 的话,会出错的。
  if FFirstShow then
  begin
    WebBrowser1.Navigate(csUrl);
    FFirstShow := false;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Doc: IHTMLDocument2;
  Render: IHTMLElementRender;
begin
  Doc := WebBrowser1.Document as IHTMLDocument2;
  Render := Doc.All.Item('captchaImage', EmptyParam) as IHTMLElementRender;
  Render.DrawToDC(Self.Canvas.Handle);
  Render.DrawToDC(FCodeBmp.Canvas.Handle);
  Image1.Picture.Assign(FCodeBmp);
end;

end.

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
DELPHITADOQuery和Excel相关发布时间:2022-07-18
下一篇:
DelphiXE2新功能:LiveBindings---把对象之间的属性绑定起来发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap