A vfp9 replacement for IECAPT to snap any web page as image.

Published on by Yousfi Benameur


I used IECAPT.exe ,an utility to capture a web page (even on disc ) to image.this is a replacement with pure vfp code of this usefull utility.
I have already used this vfp pure code to snap any web page (or disc page).
that why i stay with same introduction:

The normal way of capturing the contents of a window into a bitmap is creating a memory device context (CreateCompatibleDC), creating a device-dependent bitmap (CreateCompatibleBitmap) or a DIB section  (CreateDIBSection), selecting the bitmap into the memory DC (SelectObject), and then bitblt from the  window's device context (GetWindowDC) into the memory DC (Bitblt).
After that, a copy of the contents of the window as it appears on the screen is stored in the bitmap.

the problem is that bitblt API works only for visible windows, all gdiplus codes in general work only for visible windows. if the window is hidden, or partially blocked with other windows the non-visible part of the window will be clipped in the device context returned from GetWindowDC. In other words,
that part of the window can't be captured using a simple BitBlt.

To capture any window, completely visible, partially visible, or complete invisible, Win32 API provides two special messages, WM_PRINT and WM_PRINTCLIENT. Both these messages take a device  context handle as a parameter, and the window handling these messages is supposed to draw itself  or its client area into the device context provided.

i tried this trick but without success.A black image raises and dont render the real copy of the web page.Maybe there is some works on bindevent WM_PAINT and WM_PRINT...Only a black frame is returned here.

Tried also the IE interface iHTMLelementRender.drawToDC (loading the MSHTML.TLB on VFP browser shows that).)

Finally the PrintWindow of the DIBAPI32.dll (free download on the web) of the visible screen ,making it visible, and the result is positive.Icaptured the entier window contents as an image bmp,jpg,gif,png,Tiff,Emf,... with gdiplus can crop, resize,the desired image returned as well
Note that can capture any window visible or invisible with printWndow API(by feeding the api with  the window hwnd)

Put a valid url(rightclick to paste url from clipboard), choose the image type,( even resizing dimensions),the max delay to wait  (sec) and Go!
of course see the valid syntaxes used in top of the code (only url is needed other parameters are optional).

Before begining:
Make sure if dibiApi32.dll is in your system32 otherwise simply google and download it.(put it in windows\system32).the printWindow API is declared in win32api (maybe no need to dibiApi32.dll...to confirm).
the code below works with 5 parameters (url,delay,image format,width,height)-only the first parameter is mandatory ,4 are optional.
the internet must be connected.
the code recquires system.app of gdiplusX library to work, if use resizing .
can build a project and compile ysnapweb.exe (29ko).
Remember that as IECAPT ,ysnapweb works only on IE.


Click on code to select [then copy] -click outside to deselect


*1* created on 10 of march  2017
*this is a vfp replacement of famous IECAPT invoqued and used in previous post to capture any web page as image
*ynapWeb  do the same job and plus it can resize the web url image captured.
*in this case gdiplusXlibrary is needed(system.app)

*if want to resize image output ,put system.app in source folder and change
*		thisform.yresize=.t.
*		and change values of  _screen.rWidth,_screen.rHeight


*!*	*ysnapweb.prg
*!*	*url can be a real web url or a file on disc (put file:///+fullpath to the file)
*!*save the code as ysnapWeb.prg
*!*	*available  syntaxes
*!*	*Image JPG format is the default
*!*	do  ysnapweb  &&default
*!*	do  ysnapweb with "http://www.yousfi.over-blog.com",,"GIF"
*!*	do  ysnapweb with "http://www.yousfi.over-blog.com",,"png"
*!*	do  ysnapweb with "http://www.yousfi.over-blog.com",,"PNG"
*!*	do  ysnapweb with "http://www.yousfi.over-blog.com",250,"bmp"
*!*	do  ysnapweb with  file://D:\________ytest2017\yQuestions\yqyuestions.html
*do  ysnapweb with "file://D:\________ytest2017\yQuestions\yquestions.html",,"gif",700,900


Parameters url,Delay,ytype ,xwidth,xheight  &&public parameters here
If Empty(url)
	Publi yform1
	yform1=Newobject("yinputbox")
	yform1.Show
	Read Events
	Local m.xurl
	m.xurl=_Screen.yurl
*messagebox(m.xurl)

*m.xurl=Inputbox("Type a valid web url here:","","http://www.yousfi.overblog.com")

	If Empty(m.xurl)
		Messagebox("a valid URL is needed!",16+4096,"Error")
		Return .F.
	Endi
	url=m.xurl
Endi

If ! _vfp.StartMode=0
	On Shutdown Quit
Endi


Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)

If !Directory("images")
	Md (m.yrep+"images")
Endi

Publi yform
yform=Newobject("ysnapweb")
yform.Show
Read Events
Retu
*
Define Class ysnapweb As Form
	Top = 0
	Left = 7
	Height = 517
	Width = 973
	ShowWindow = 2
	Caption = ""
	TitleBar = 0
	AlwaysOnTop = .T.
	showInTaskbar=.F.
	ytype = "JPG"
	url = .F.
	t0 = .F.
	Delay = .F.
	yresize=.F.

	Add Object olecontrol1 As OleControl With ;
		Oleclass="shell.explorer.2", ;
		Top = 0, ;
		Left = 0, ;
		Height = 517, ;
		Width = 973, ;
		Anchor = 15, ;
		Name = "Olecontrol1"

	Add Object timer1 As Timer With ;
		Top = 12, ;
		Left = 876, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .F., ;
		Interval = 2000, ;
		Name = "Timer1"

	Add Object timer2 As Timer With ;
		Top = 60, ;
		Left = 888, ;
		Height = 23, ;
		Width = 23, ;
		Name = "Timer2"

	Procedure Process
	Lparameters xurl
	Local xImage
	xImage="myImage.bmp"

	With Thisform.olecontrol1
		.Navigate(xurl)
		Do While .busy Or .readystate#4
			Inke(1)
		Enddo
		Inke(2)

		Thisform.Width =.Document.body.scrollwidth  +Sysmetric(5)
		Thisform.Height=.Document.body.scrollHeight
		.Width=.Document.body.offsetWidth
		.Height=.Document.body.offsetHeight
		.Left=-Sysmetric(5)
		.Top =0

	Endwith

	Inkey(2)

	lnBitmap = 0
	lnGraphics = 0
	hdc = 0
	lnStatus = 0

	lnWidth = Thisform. Width -2*Sysmetric(3)
	lnHeight = Thisform. Height+ 2*Sysmetric(13)

	lnStatus = GdipCreateBitmapFromScan0 (lnWidth, lnHeight, 0, 0x000E200B, 0, @ lnBitmap)
	If lnStatus = 0
		lnStatus = GdipGetImageGraphicsContext (lnBitmap, @ lnGraphics)
	Endif
	If lnStatus = 0
		lnStatus = GdipGetDC (lnGraphics, @ hdc)
		#Define PW_CLIENTONLY 0x00000001
*https://msdn.microsoft.com/en-us/library/windows/desktop/dd162869(v=vs.85).aspx
*The PrintWindow function copies a visual window into the specified device context (DC), typically a printer DC.
*PW_CLIENTONLY  Only the client area of the window is copied to hdcBlt. By default, the entire window is copied.
		PrintWindow (Thisform.HWnd, hdc, PW_CLIENTONLY)  &&0
	Endif

	= GdipReleaseDC (lnGraphics, hdc)
	= GdipDeleteGraphics (lnGraphics)

	#Define lqClsidEncoderBMP  0h00F47C55041AD3119A730000F81EF32E
	lnStatus = GdipSaveImageToFile (lnBitmap, Strconv (m.xImage + Chr (0), 5), lqClsidEncoderBMP, Null)
	= GdipDisposeImage (lnBitmap)

	If lnStatus> 0
		= Messagebox ("Error function GDI +" + Str (lnStatus))
	Endif

	With _Screen.System.drawing
		Local lobmp As xfcBitmap
		lobmp=.Bitmap.fromfile(m.xImage)
		Publi m.lcDest
		Local m.x
		m.x=Ttoc(Datetime())
		m.x=Strtran(x,"\","_")
		m.x=Strtran(x,":","_")
		m.x=Strtran(x,"/","_")
		m.x="_"+Strtran(x," ","_")

		m.lcDest=m.yrep+"images\"+Juststem(m.xImage)+x+"."+Allt(Thisform.ytype)

		Do Case
		Case Thisform.ytype=="BMP"
			lobmp.Save(m.lcDest,.imaging.imageformat.BMP)
		Case Thisform.ytype=="JPG"
			lobmp.Save(m.lcDest,.imaging.imageformat.JPEG)
		Case Thisform.ytype=="GIF"
			lobmp.Save(m.lcDest,.imaging.imageformat.GIF)
		Case Thisform.ytype=="PNG"
			lobmp.Save(m.lcDest,.imaging.imageformat.PNG)
		Case Thisform.ytype=="TIFF"
			lobmp.Save(m.lcDest,.imaging.imageformat.TIFF)
		Case Thisform.ytype=="EMF"
			lobmp.Save(m.lcDest,.imaging.imageformat.EMF)
		Endcase

		lobmp=Null
	Endwith

*Resize to ww x hh
	If Thisform.yresize=.T.

		With _Screen.System.drawing
			Local lnWidth_, lnHeight_
			lnWidth_ =_Screen.rWidth
			lnHeight_=_Screen.rHeight

			Local loSrcImage As xfcBitmap
			loSrcImage = .Bitmap.New(m.lcDest)

			Local loResized As xfcBitmap
			loResized = .Bitmap.New(lnWidth_, lnHeight_,.imaging.PixelFormat.Format32bppARGB)
			loResized.SetResolution(loSrcImage.HorizontalResolution,loSrcImage.VerticalResolution)
			Local loGfx As xfcGraphics
			loGfx = .Graphics.FromImage(loResized)
			loGfx.SmoothingMode = .Drawing2D.SmoothingMode.HighQuality
			loGfx.InterpolationMode = .Drawing2D.InterpolationMode.HighQualityBicubic
			loGfx.DrawImage(loSrcImage, 0, 0, lnWidth_, lnHeight_)
			Local bb,lcDest1
			lcDest1=m.yrep+"images\"+Juststem(m.lcDest)+"_rz."+Justext(m.lcDest)
			bb=".Imaging.ImageFormat."+Justext(m.lcDest)
			loResized.Save(m.lcDest1,m.bb)

		Endwith
	Endi

	Try
		Erase (xImage)
	Catch
	Endtry

	If Thisform.yresize=.F.
		Run/N explorer &lcDest
	Else
		Run/N explorer &lcDest1
	Endi

	If Thisform.yresize=.T.
		Clea Resources(m.lcDest)
		Try
			Erase (m.lcDest)
		Catch
		Endtry
	Endi

	Thisform.Release
	Endproc

	Procedure Init

	Thisform.url=url    &&m.xurl

	If Empty(Delay)
		Thisform.Delay=300
	Else
		Thisform.Delay=Delay
	Endi

	If Empty(ytype)
		Thisform.ytype="JPG"  && default format image - png,gif,bmp,emf,tiff...
	Else
		Thisform.ytype=Upper(ytype)
	Endi

	If !Empty(xwidth) And ! Empty(xheight)
		_Screen.AddProperty("rwidth",xwidth)
		_Screen.AddProperty("rHeight",xheight)
		Thisform.yresize=.T.
	Endi

	With This
		.Top=0
		.Left=-20000  &&invisible on user screen
	Endwith


	Thisform.t0=Seconds()
	Thisform.timer1.Enabled=.T.
	Endproc

	Procedure Load
	Do "system.app"  &&must be mandatory in the same folder

	Declare PrintWindow In WIN32API Long HWnd, Long hdcBlt, Long nFlags
	Declare Long GdipGetImageGraphicsContext In GDIPlus.Dll Long nativeImage, Long @ graphics
	Declare Long GdipGetDC In GDIPlus.Dll Long nativeImage, Long @ hdc
	Declare Long GdipCreateBitmapFromScan0 In GDIPlus.Dll Long, Long, Long, Long, Long, Long @
	Declare GdipDisposeImage In GDIPlus.Dll Long
	Declare GdipDeleteGraphics In GDIPlus.Dll Long
	Declare GdipReleaseDC In GDIPlus.Dll Long nativeGraphics, Long hdc
	Declare Long GdipSaveImageToFile In GDIPlus.Dll Long, String, String, String
	Endproc

	Procedure olecontrol1.Init
	This.silent=.T.
	Endproc

	Procedure timer1.Timer
	Thisform.Process(Thisform.url)
	This.Enabled=.F.
	Endproc

	Procedure timer2.Timer
	If Seconds()-Thisform.t0>=Thisform.Delay
		This.Enabled=.F.
		Messagebox("Delay consumed...cancel operation!",16+4096,1000)
		Thisform.Release
	Endi
	Endproc

	Procedure Destroy
	If Thisform.yresize=.T.
		Try
			Erase (m.lcDest)
		Catch
		Endtry
	Endi
	m.lcDest=Null
	Release mlcdest
	Clea Events
	Endproc

Enddefine
*
*-- EndDefine: ysnapWeb


Define Class yinputbox As Form
	BorderStyle = 1
	Height = 56
	Width = 700
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "Type the text or Rightclick on textbox to paste clipboard"
	MaxButton=.F.
	MinButton=.F.
*WindowType = 1  &&modal  or use show(1)  to set  the form modality-here showWIndow=2 +read events used
	BackColor = Rgb(212,210,208)
	Name = "Form1"

	Add Object text1 As TextBox With ;
		FontBold = .T., ;
		Height = 27, ;
		Left = 6, ;
		Top = 22, ;
		Width = 660, ;
		Name = "Text1"

	Procedure Init
	Try  &&if the property dont exist
		_Screen.AddProperty("yurl","")
	Catch
*the property already exists
	Endtry
	Endproc

	Procedure Destroy
	_Screen.yurl=Allt(Thisform.text1.Value)
	Clea Events
	Endproc

	Procedure text1.RightClick  &&paste clipboard
	This.Value=_Cliptext
	Endproc

	Procedure text1.Valid
*thisform.release
	Endproc


Enddefine
*
*-- EndDefine: yinputbox



for demo, i troncated this picture (its too big).can cut the scroolbars also in code.

for demo, i troncated this picture (its too big).can cut the scroolbars also in code.

Important:All Codes above are tested on VFP9SP2 & windows 10 pro and IE11 emulation.

To be informed of the latest articles, subscribe:
Comment on this post