Works very well, and thanks for the scrolling
You are a magician
Capture Any Browser [Windows]
-
Kwai chang caine
- Always Here
- Posts: 5494
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: Capture Any Browser [Windows]
Waooouh !!!! very great RASHAD !!!
Works very well, and thanks for the scrolling
You are a magician
Works very well, and thanks for the scrolling
You are a magician
The happiness is a road...Not a destination
Re: Capture Any Browser [Windows]
Update and optimization for much better performance
Code: Select all
Prototype printwindow(hwnd,hdc,flag)
Global printwindow.printwindow
lib = OpenLibrary(0,"User32.dll")
If lib
printwindow = GetFunction(0,"PrintWindow")
EndIf
Procedure ScrollDown()
In.INPUT
In\type = #INPUT_KEYBOARD
In\ki\wVk = #VK_DOWN
;In\ki\dwFlags = #KEYEVENTF_KEYUP
SendInput_(1,@In,SizeOf(INPUT))
In\ki\dwFlags = #KEYEVENTF_KEYUP
SendInput_(1,@In,SizeOf(INPUT))
EndProcedure
Procedure ScrollUp()
In.INPUT
In\type = #INPUT_KEYBOARD
In\ki\wVk = #VK_UP
;In\ki\dwFlags = #KEYEVENTF_KEYUP
SendInput_(1,@In,SizeOf(INPUT))
In\ki\dwFlags = #KEYEVENTF_KEYUP
SendInput_(1,@In,SizeOf(INPUT))
EndProcedure
Procedure GetHandle(Wtext$)
hWnd = GetWindow_(GetDesktopWindow_(),#GW_CHILD)
Repeat
Text$ = Space(#MAX_PATH)
GetWindowText_(hWnd,@Text$,#MAX_PATH)
If FindString(LCase(Text$), LCase(Wtext$),1) <>0 And IsWindowVisible_(hWnd) = 1
Finhwnd = hWnd
Else
hWnd = GetWindow_(hWnd,#GW_HWNDNEXT)
EndIf
Until hWnd=0 Or Finhwnd <> 0
ProcedureReturn Finhwnd
EndProcedure
;
For browser = 1 To 3
Read.s Browser$
hWnd = GetHandle(Browser$)
If hWnd <> 0
Break
EndIf
Next
If hWnd
If IsIconic_(hWnd)
ShowWindow_(hWnd,#SW_RESTORE)
Iconic =1
EndIf
SetForegroundWindow_(hWnd)
GetWindowRect_(hWnd,r.RECT)
cycle = (r\bottom-r\top)/58 - 1
SetActiveWindow_(hWnd)
For x = 1 To 10
hBitmap = CreateImage(0,r\right-r\left,r\bottom-r\top)
hdc = StartDrawing(ImageOutput(0))
PrintWindow(hwnd,hdc,0)
StopDrawing()
DeleteDC_(hdc)
Delay(200)
SaveImage(0,GetHomeDirectory() + "Image "+Str(imn)+".bmp",#PB_ImagePlugin_BMP)
imn + 1
Delay(200)
For key = 1 To cycle
ScrollDown()
;Delay(50)
Next
Delay(200)
Next
EndIf
For key = 1 To cycle*10
ScrollUp()
Next
If Iconic = 1
ShowWindow_(hWnd,#SW_MINIMIZE )
EndIf
If lib
CloseLibrary(0)
EndIf
DataSection
Data.s "Explorer","Fire","Opera"
EndDataSection
Egypt my love
Re: Capture Any Browser [Windows]
+1Kwaï chang caïne wrote:Waooouh !!!! very great RASHAD !!!
Works very well, and thanks for the scrolling
You are a magician
Just tried this with Chrome.
Just added "Chrome" to your data section and changed loop from 3 to 4.
Worked great.
Thank you very much.
DE AA EB
-
Kwai chang caine
- Always Here
- Posts: 5494
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: Capture Any Browser [Windows]
DAVIDO have right...that works also with chrome for me too
Thanks again RASHAD
Thanks again RASHAD
The happiness is a road...Not a destination
Re: Capture Any Browser [Windows]
RASHAD wrote:Using Kiffi code
- Press right-mouse-click in the Browser URL Edit
- Select the URL
- Paste it in the StringGadget
- Press Capture
- Repeat the previous steps for each web change
Tested with Explorer,FireFox & Opera
It should work with all the other browsers
Code: Select all
UsePNGImageEncoder() Global sURL.s,imgn Enumeration #WinSnapShot #WebSnapShot EndEnumeration #DVASPECT_CONTENT = 1 #DVASPECT_THUMBNAIL = 2 #DVASPECT_ICON = 4 #DVASPECT_DOCPRINT = 8 Procedure CaptureWebPage(URL$, WBWidth.i, WBHeight.i, Filename.s) ;---------------------------------------------------------------- Define.IWebBrowser2 m_pWebBrowser Define.IHTMLDocument2 pDocument Define.IHTMLDocument3 pDocument3 Define.IHTMLElement pElement Define.IHTMLElement2 pElement2 Define.iDispatch pDispatch Define.IViewObject2 pViewObject Define.i bodyHeight Define.i bodyWidth Define.i rootHeight Define.i rootWidth Define.RECT rcBounds Define.i bolFlag Define.i IsBusy Define.i hr bolFlag = #False If OpenWindow(#WinSnapShot, 0, 0, 0, 0, "", #PB_Window_Invisible | #PB_Window_BorderLess) WebGadget(#WebSnapShot, 0, 0, 0, 0, URL$) Repeat If GetGadgetAttribute(#WebSnapShot, #PB_Web_Busy) = 0 Break EndIf While WindowEvent(): Delay(1) : Wend ForEver m_pWebBrowser = GetWindowLongPtr_(GadgetID(#WebSnapShot), #GWL_USERDATA) hr = m_pWebBrowser\get_document(@pDispatch) If hr = #S_OK If pDispatch hr = pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument) If hr = #S_OK If pDocument hr = pDocument\get_body(@pElement) If hr = #S_OK If pElement hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2) If hr = #S_OK If pElement2 hr = pElement2\get_scrollHeight(@bodyHeight) If hr = #S_OK ;Debug "bodyHeight: " + Str(bodyHeight) hr = pElement2\get_scrollWidth(@bodyWidth) If hr = #S_OK ;Debug "bodyWidth: " + Str(bodyWidth) hr = pDispatch\QueryInterface(?IID_IHTMLDocument3, @pDocument3) If hr = #S_OK If pDocument3 hr = pDocument3\get_documentElement(@pElement) If hr <> #S_OK : ProcedureReturn #False : EndIf hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2) If hr <> #S_OK : ProcedureReturn #False : EndIf hr = pElement2\get_scrollHeight(@rootHeight) If hr <> #S_OK : ProcedureReturn #False : EndIf ;Debug "rootHeight: " + Str(rootHeight) hr = pElement2\get_scrollWidth(@rootWidth) If hr <> #S_OK : ProcedureReturn #False : EndIf ;Debug "rootWidth: " + Str(rootWidth) Define.i width Define.i height width = bodyWidth If rootWidth > bodyWidth : width = rootWidth : EndIf height = bodyHeight If rootHeight > bodyHeight : height = rootHeight : EndIf width + 22 ResizeGadget(#WebSnapShot, 0, 0, width, height) hr = m_pWebBrowser\QueryInterface(?IID_IViewObject2, @pViewObject) If hr = #S_OK If pViewObject Define.i hdcMain hdcMain = GetDC_(0) If hdcMain Define.i hdcMem hdcMem = CreateCompatibleDC_(hdcMain) If hdcMem Define.i hBitmap hBitmap = CreateCompatibleBitmap_(hdcMain, width, height) If hBitmap Define.i oldImage oldImage = SelectObject_(hdcMem, hBitmap) rcBounds\top = 0 rcBounds\left = 0 rcBounds\right = width rcBounds\bottom = height pViewObject\Draw(#DVASPECT_CONTENT, -1, 0, 0, hdcMain, hdcMem, rcBounds, 0, 0, 0) Define.i Image Image = CreateImage(#PB_Any, width, height) If Image Define.i img_hDC img_hDC = StartDrawing(ImageOutput(Image)) If img_hDC BitBlt_(img_hDC, 0, 0, width, height, hdcMem, 0, 0, #SRCCOPY) StopDrawing() SaveImage(Image,Filename,#PB_ImagePlugin_PNG) bolFlag = #True EndIf ; img_hDC FreeImage(Image) EndIf ; Image SelectObject_(hdcMem, oldImage) EndIf ; hBitmap DeleteDC_(hdcMem) EndIf ; hdcMem ReleaseDC_(0, hdcMain) EndIf ; hdcMain pViewObject\Release() EndIf ; pViewObject EndIf; HR pDocument3\Release() EndIf ; pDocument3 EndIf ; HR EndIf ; HR EndIf ; HR pElement2\Release() EndIf ; pElement2 EndIf ; HR pElement\Release() EndIf ; pElement EndIf ; HR pDocument\Release() EndIf ; pDocument EndIf ; HR pDispatch\Release() EndIf ; pDispatch EndIf ; HR CloseWindow(#WinSnapShot) EndIf ProcedureReturn bolFlag EndProcedure Procedure Snapshot() ;------------------- ;Define sURL.s Define sFileOut.s Define sNow.s ;sURL = "http://www.purebasic.fr/english/" ;sFileOut = ReplaceString(sURL, ".", "_") ;sNow = FormatDate("_%yyyy_%mm_%dd_%hh_%ii_%ss", Date()) ExamineDesktops() sFileOut = GetHomeDirectory()+"web_image_"+Str(imgn)+".png" imgn+1 If CaptureWebPage(sURL, DesktopWidth(0), DesktopHeight(0), sFileOut) Else MessageRequester("Web Page", "Capture Failed") EndIf EndProcedure ;Snapshot() LoadFont(0,"Broadway",24) OpenWindow(10,0,0,400,80,"Capture Web",#PB_Window_SystemMenu |#PB_Window_ScreenCentered) StickyWindow(10,1) StringGadget(20,10,10,380,24,"") ButtonGadget(30,10,50,60,24,"Capture") TextGadget(40,140,50,80,40,"") SetGadgetFont(40,0) SetGadgetColor(40,#PB_Gadget_FrontColor,#Red) Repeat Select WaitWindowEvent() Case #PB_Event_CloseWindow Quit = 1 Case #PB_Event_Gadget Select EventGadget() Case 30 SetGadgetText(40,"") sURL.s = GetGadgetText(20) If sURL.s Snapshot() EndIf SetGadgetText(20,"") SetGadgetText(40,"FINISHED") EndSelect EndSelect Until Quit = 1 End End DataSection IID_IHTMLDocument2: ;332C4425-26CB-11D0-B483-00C04FD90119 Data.i $332C4425 Data.w $26CB, $11D0 Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19 IID_IHTMLDocument3: ;3050F485-98B5-11CF-BB82-00AA00BDCE0B Data.i $3050F485 Data.w $98B5, $11CF Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B IID_IHTMLElement2: ;3050f434-98b5-11cf-bb82-00aa00bdce0b Data.i $3050F434 Data.w $98B5, $11CF Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B IID_IViewObject2: ;00000127-0000-0000-c000-000000000046 Data.i $00000127 Data.w $0000, $0000 Data.b $C0, $00, $00, $00, $00, $00, $00, $46 EndDataSection
Can this be done in IE instead of webgadget?
Thanks in advance.
ARGENTINA WORLD CHAMPION
Re: Capture Any Browser [Windows]
Capture IE web pages
Code: Select all
UsePNGImageEncoder()
Global sURL.s,imgn
Enumeration
#WinSnapShot
#WebSnapShot
EndEnumeration
#DVASPECT_CONTENT = 1
#DVASPECT_THUMBNAIL = 2
#DVASPECT_ICON = 4
#DVASPECT_DOCPRINT = 8
Procedure WindowProc(hWnd,uMsg,wParam,lParam)
Result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_NCACTIVATE
Result = 1
EndSelect
ProcedureReturn Result
EndProcedure
Procedure.s EnumChildProc(hwnd, lParam)
Protected Classname$ = Space(#MAX_PATH)
Protected URL$ = Space(#MAX_PATH)
GetClassName_(hwnd, @Classname$, #MAX_PATH-1)
If ClassName$ = "Edit"
SendMessage_(hwnd, #WM_GETTEXT, #MAX_PATH, @URL$)
sURL.s = URL$
EndIf
ProcedureReturn sURL.s
EndProcedure
Procedure CaptureWebPage(URL$, WBWidth.i, WBHeight.i, Filename.s)
Define.IWebBrowser2 m_pWebBrowser
Define.IHTMLDocument2 pDocument
Define.IHTMLDocument3 pDocument3
Define.IHTMLElement pElement
Define.IHTMLElement2 pElement2
Define.iDispatch pDispatch
Define.IViewObject2 pViewObject
Define.i bodyHeight
Define.i bodyWidth
Define.i rootHeight
Define.i rootWidth
Define.RECT rcBounds
Define.i bolFlag
Define.i IsBusy
Define.i hr
bolFlag = #False
If OpenWindow(#WinSnapShot, 0, 0, 0, 0, "", #PB_Window_Invisible | #PB_Window_BorderLess)
WebGadget(#WebSnapShot, 0, 0, 0, 0, URL$)
Repeat
If GetGadgetAttribute(#WebSnapShot, #PB_Web_Busy) = 0
Break
EndIf
While WindowEvent(): Delay(1) : Wend
ForEver
m_pWebBrowser = GetWindowLongPtr_(GadgetID(#WebSnapShot), #GWL_USERDATA)
m_pWebBrowser\put_Silent(#True)
hr = m_pWebBrowser\get_document(@pDispatch)
If hr = #S_OK
If pDispatch
hr = pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument)
If hr = #S_OK
If pDocument
hr = pDocument\get_body(@pElement)
If hr = #S_OK
If pElement
hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
If hr = #S_OK
If pElement2
hr = pElement2\get_scrollHeight(@bodyHeight)
If hr = #S_OK
;Debug "bodyHeight: " + Str(bodyHeight)
hr = pElement2\get_scrollWidth(@bodyWidth)
If hr = #S_OK
;Debug "bodyWidth: " + Str(bodyWidth)
hr = pDispatch\QueryInterface(?IID_IHTMLDocument3, @pDocument3)
If hr = #S_OK
If pDocument3
hr = pDocument3\get_documentElement(@pElement)
If hr <> #S_OK : ProcedureReturn #False : EndIf
hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
If hr <> #S_OK : ProcedureReturn #False : EndIf
hr = pElement2\get_scrollHeight(@rootHeight)
If hr <> #S_OK : ProcedureReturn #False : EndIf
;Debug "rootHeight: " + Str(rootHeight)
hr = pElement2\get_scrollWidth(@rootWidth)
If hr <> #S_OK : ProcedureReturn #False : EndIf
;Debug "rootWidth: " + Str(rootWidth)
Define.i width
Define.i height
width = bodyWidth
If rootWidth > bodyWidth : width = rootWidth : EndIf
height = bodyHeight
If rootHeight > bodyHeight : height = rootHeight : EndIf
width + 22
ResizeGadget(#WebSnapShot, 0, 0, width, height)
hr = m_pWebBrowser\QueryInterface(?IID_IViewObject2, @pViewObject)
If hr = #S_OK
If pViewObject
Define.i hdcMain
hdcMain = GetDC_(0)
If hdcMain
Define.i hdcMem
hdcMem = CreateCompatibleDC_(hdcMain)
If hdcMem
Define.i hBitmap
hBitmap = CreateCompatibleBitmap_(hdcMain, width, height)
If hBitmap
Define.i oldImage
oldImage = SelectObject_(hdcMem, hBitmap)
rcBounds\top = 0
rcBounds\left = 0
rcBounds\right = width
rcBounds\bottom = height
pViewObject\Draw(#DVASPECT_CONTENT, -1, 0, 0, hdcMain, hdcMem, rcBounds, 0, 0, 0)
Define.i Image
Image = CreateImage(#PB_Any, width, height)
If Image
Define.i img_hDC
img_hDC = StartDrawing(ImageOutput(Image))
If img_hDC
BitBlt_(img_hDC, 0, 0, width, height, hdcMem, 0, 0, #SRCCOPY)
StopDrawing()
SaveImage(Image,Filename,#PB_ImagePlugin_PNG)
bolFlag = #True
EndIf ; img_hDC
FreeImage(Image)
EndIf ; Image
SelectObject_(hdcMem, oldImage)
EndIf ; hBitmap
DeleteDC_(hdcMem)
EndIf ; hdcMem
ReleaseDC_(0, hdcMain)
EndIf ; hdcMain
pViewObject\Release()
EndIf ; pViewObject
EndIf; HR
pDocument3\Release()
EndIf ; pDocument3
EndIf ; HR
EndIf ; HR
EndIf ; HR
pElement2\Release()
EndIf ; pElement2
EndIf ; HR
pElement\Release()
EndIf ; pElement
EndIf ; HR
pDocument\Release()
EndIf ; pDocument
EndIf ; HR
pDispatch\Release()
EndIf ; pDispatch
EndIf ; HR
CloseWindow(#WinSnapShot)
EndIf
ProcedureReturn bolFlag
EndProcedure
Procedure Snapshot()
Define sFileOut.s
Define sNow.s
ExamineDesktops()
sFileOut = GetHomeDirectory()+"web_image_"+Str(imgn)+".png"
imgn+1
If CaptureWebPage(sURL, DesktopWidth(0), DesktopHeight(0), sFileOut)
Else
MessageRequester("Web Page", "Capture Failed")
EndIf
EndProcedure
LoadFont(0,"Georgia",12,#PB_Font_Bold)
OpenWindow(10,0,0,300,40,"Capture Web",#PB_Window_SystemMenu |#PB_Window_ScreenCentered)
StickyWindow(10,1)
ButtonGadget(30,10,10,60,24,"Capture")
TextGadget(40,100,10,160,40,"")
SetGadgetFont(40,FontID(0))
SetGadgetColor(40,#PB_Gadget_FrontColor,#Red)
SetWindowCallback(@WindowProc())
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #PB_Event_Gadget
Select EventGadget()
Case 30
hwndParent = FindWindow_("IEFrame", 0)
EnumChildWindows_(hwndParent, @EnumChildProc(), 0)
If sURL.s
SetGadgetText(40,"Capturing...")
Snapshot()
SetGadgetText(40,"FINISHED")
Else
MessageRequester("Error..","No URL to copy,please try again",#PB_MessageRequester_Ok|#MB_ICONERROR|#MB_SYSTEMMODAL)
End
EndIf
EndSelect
EndSelect
Until Quit = 1
End
End
DataSection
IID_IHTMLDocument2:
;332C4425-26CB-11D0-B483-00C04FD90119
Data.i $332C4425
Data.w $26CB, $11D0
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
IID_IHTMLDocument3:
;3050F485-98B5-11CF-BB82-00AA00BDCE0B
Data.i $3050F485
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLElement2:
;3050f434-98b5-11cf-bb82-00aa00bdce0b
Data.i $3050F434
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IViewObject2:
;00000127-0000-0000-c000-000000000046
Data.i $00000127
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection
Egypt my love
Re: Capture Any Browser [Windows]
RASHAD wrote:Capture IE web pagesCode: Select all
UsePNGImageEncoder() Global sURL.s,imgn Enumeration #WinSnapShot #WebSnapShot EndEnumeration #DVASPECT_CONTENT = 1 #DVASPECT_THUMBNAIL = 2 #DVASPECT_ICON = 4 #DVASPECT_DOCPRINT = 8 Procedure WindowProc(hWnd,uMsg,wParam,lParam) Result = #PB_ProcessPureBasicEvents Select uMsg Case #WM_NCACTIVATE Result = 1 EndSelect ProcedureReturn Result EndProcedure Procedure.s EnumChildProc(hwnd, lParam) Protected Classname$ = Space(#MAX_PATH) Protected URL$ = Space(#MAX_PATH) GetClassName_(hwnd, @Classname$, #MAX_PATH-1) If ClassName$ = "Edit" SendMessage_(hwnd, #WM_GETTEXT, #MAX_PATH, @URL$) sURL.s = URL$ EndIf ProcedureReturn sURL.s EndProcedure Procedure CaptureWebPage(URL$, WBWidth.i, WBHeight.i, Filename.s) Define.IWebBrowser2 m_pWebBrowser Define.IHTMLDocument2 pDocument Define.IHTMLDocument3 pDocument3 Define.IHTMLElement pElement Define.IHTMLElement2 pElement2 Define.iDispatch pDispatch Define.IViewObject2 pViewObject Define.i bodyHeight Define.i bodyWidth Define.i rootHeight Define.i rootWidth Define.RECT rcBounds Define.i bolFlag Define.i IsBusy Define.i hr bolFlag = #False If OpenWindow(#WinSnapShot, 0, 0, 0, 0, "", #PB_Window_Invisible | #PB_Window_BorderLess) WebGadget(#WebSnapShot, 0, 0, 0, 0, URL$) Repeat If GetGadgetAttribute(#WebSnapShot, #PB_Web_Busy) = 0 Break EndIf While WindowEvent(): Delay(1) : Wend ForEver m_pWebBrowser = GetWindowLongPtr_(GadgetID(#WebSnapShot), #GWL_USERDATA) m_pWebBrowser\put_Silent(#True) hr = m_pWebBrowser\get_document(@pDispatch) If hr = #S_OK If pDispatch hr = pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument) If hr = #S_OK If pDocument hr = pDocument\get_body(@pElement) If hr = #S_OK If pElement hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2) If hr = #S_OK If pElement2 hr = pElement2\get_scrollHeight(@bodyHeight) If hr = #S_OK ;Debug "bodyHeight: " + Str(bodyHeight) hr = pElement2\get_scrollWidth(@bodyWidth) If hr = #S_OK ;Debug "bodyWidth: " + Str(bodyWidth) hr = pDispatch\QueryInterface(?IID_IHTMLDocument3, @pDocument3) If hr = #S_OK If pDocument3 hr = pDocument3\get_documentElement(@pElement) If hr <> #S_OK : ProcedureReturn #False : EndIf hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2) If hr <> #S_OK : ProcedureReturn #False : EndIf hr = pElement2\get_scrollHeight(@rootHeight) If hr <> #S_OK : ProcedureReturn #False : EndIf ;Debug "rootHeight: " + Str(rootHeight) hr = pElement2\get_scrollWidth(@rootWidth) If hr <> #S_OK : ProcedureReturn #False : EndIf ;Debug "rootWidth: " + Str(rootWidth) Define.i width Define.i height width = bodyWidth If rootWidth > bodyWidth : width = rootWidth : EndIf height = bodyHeight If rootHeight > bodyHeight : height = rootHeight : EndIf width + 22 ResizeGadget(#WebSnapShot, 0, 0, width, height) hr = m_pWebBrowser\QueryInterface(?IID_IViewObject2, @pViewObject) If hr = #S_OK If pViewObject Define.i hdcMain hdcMain = GetDC_(0) If hdcMain Define.i hdcMem hdcMem = CreateCompatibleDC_(hdcMain) If hdcMem Define.i hBitmap hBitmap = CreateCompatibleBitmap_(hdcMain, width, height) If hBitmap Define.i oldImage oldImage = SelectObject_(hdcMem, hBitmap) rcBounds\top = 0 rcBounds\left = 0 rcBounds\right = width rcBounds\bottom = height pViewObject\Draw(#DVASPECT_CONTENT, -1, 0, 0, hdcMain, hdcMem, rcBounds, 0, 0, 0) Define.i Image Image = CreateImage(#PB_Any, width, height) If Image Define.i img_hDC img_hDC = StartDrawing(ImageOutput(Image)) If img_hDC BitBlt_(img_hDC, 0, 0, width, height, hdcMem, 0, 0, #SRCCOPY) StopDrawing() SaveImage(Image,Filename,#PB_ImagePlugin_PNG) bolFlag = #True EndIf ; img_hDC FreeImage(Image) EndIf ; Image SelectObject_(hdcMem, oldImage) EndIf ; hBitmap DeleteDC_(hdcMem) EndIf ; hdcMem ReleaseDC_(0, hdcMain) EndIf ; hdcMain pViewObject\Release() EndIf ; pViewObject EndIf; HR pDocument3\Release() EndIf ; pDocument3 EndIf ; HR EndIf ; HR EndIf ; HR pElement2\Release() EndIf ; pElement2 EndIf ; HR pElement\Release() EndIf ; pElement EndIf ; HR pDocument\Release() EndIf ; pDocument EndIf ; HR pDispatch\Release() EndIf ; pDispatch EndIf ; HR CloseWindow(#WinSnapShot) EndIf ProcedureReturn bolFlag EndProcedure Procedure Snapshot() Define sFileOut.s Define sNow.s ExamineDesktops() sFileOut = GetHomeDirectory()+"web_image_"+Str(imgn)+".png" imgn+1 If CaptureWebPage(sURL, DesktopWidth(0), DesktopHeight(0), sFileOut) Else MessageRequester("Web Page", "Capture Failed") EndIf EndProcedure LoadFont(0,"Georgia",12,#PB_Font_Bold) OpenWindow(10,0,0,300,40,"Capture Web",#PB_Window_SystemMenu |#PB_Window_ScreenCentered) StickyWindow(10,1) ButtonGadget(30,10,10,60,24,"Capture") TextGadget(40,100,10,160,40,"") SetGadgetFont(40,FontID(0)) SetGadgetColor(40,#PB_Gadget_FrontColor,#Red) SetWindowCallback(@WindowProc()) Repeat Select WaitWindowEvent() Case #PB_Event_CloseWindow Quit = 1 Case #PB_Event_Gadget Select EventGadget() Case 30 hwndParent = FindWindow_("IEFrame", 0) EnumChildWindows_(hwndParent, @EnumChildProc(), 0) If sURL.s SetGadgetText(40,"Capturing...") Snapshot() SetGadgetText(40,"FINISHED") Else MessageRequester("Error..","No URL to copy,please try again",#PB_MessageRequester_Ok|#MB_ICONERROR|#MB_SYSTEMMODAL) End EndIf EndSelect EndSelect Until Quit = 1 End End DataSection IID_IHTMLDocument2: ;332C4425-26CB-11D0-B483-00C04FD90119 Data.i $332C4425 Data.w $26CB, $11D0 Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19 IID_IHTMLDocument3: ;3050F485-98B5-11CF-BB82-00AA00BDCE0B Data.i $3050F485 Data.w $98B5, $11CF Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B IID_IHTMLElement2: ;3050f434-98b5-11cf-bb82-00aa00bdce0b Data.i $3050F434 Data.w $98B5, $11CF Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B IID_IViewObject2: ;00000127-0000-0000-c000-000000000046 Data.i $00000127 Data.w $0000, $0000 Data.b $C0, $00, $00, $00, $00, $00, $00, $46 EndDataSection
One question: Isnt it taking the snapshot from a web gadget with the same URL that the IE?
How to take it directly from an IE instance? Some instance that its already open, maybe even hidden or minimized?
The situation is that imagine a webpage that display some diffrent image everytime it displays, copying the url would not do the job form me if i need the exact image that is displayed on the open IE.
I dont need only the same URL but rally the same instance of ie.
I hope its possible
ARGENTINA WORLD CHAMPION
-
IdeasVacuum
- Always Here
- Posts: 6426
- Joined: Fri Oct 23, 2009 2:33 am
- Location: Wales, UK
- Contact:
Re: Capture Any Browser [Windows]
I'm trying to enhance Rashad's code to capture a webpage from any browser, as an image, with auto-scroll.
Issues are:
1) Determining the height of the whole web page, to know how many snapshots are needed. Currently, total number of snapshots is set to 10, which is too many for most webpages for sure but might not be enough for others.
2) Making the auto-scroll distance match the height of a snapshot. Currently, a magic number is used:
3) I have added code so that you select the top-left and bottom-right of the region to be captured - the original code captured the whole browser window. It's nice to have a cross-hair cursor for this task, but on my PC at least, the cursor takes too long to load (about 4 seconds!).
[/size]
Issues are:
1) Determining the height of the whole web page, to know how many snapshots are needed. Currently, total number of snapshots is set to 10, which is too many for most webpages for sure but might not be enough for others.
2) Making the auto-scroll distance match the height of a snapshot. Currently, a magic number is used:
Code: Select all
iCycle = (iImgH) / 58 - 1Code: Select all
UsePNGImageEncoder()
UsePNGImageDecoder()
EnableExplicit
Enumeration
#WinMsg
#TxtWinMsg
#WholePage
EndEnumeration
Global ighCrossCursor.i = LoadCursor_(#Null, #IDC_CROSS)
SetSystemCursor_(ighCrossCursor, #OCR_NORMAL)
Global igLEFTBTN.i = #VK_LBUTTON, igRIGHTBTN.i = #VK_RBUTTON
If(GetSystemMetrics_(#SM_SWAPBUTTON) = #True)
igLEFTBTN = #VK_RBUTTON
igRIGHTBTN = #VK_LBUTTON
EndIf
Global MouseUpL.INPUT
MouseUpL\type = #INPUT_MOUSE
MouseUpL\mi\dx = 0
MouseUpL\mi\dy = 0
MouseUpL\mi\mouseData = 0
MouseUpL\mi\dwFlags = #MOUSEEVENTF_LEFTUP
MouseUpL\mi\time = 0
MouseUpL\mi\dwExtraInfo = 0
Global gPt1.POINT, gPt2.POINT
Procedure LeftButtonDown()
;#------------------------
If(GetAsyncKeyState_(igLEFTBTN) & 32768)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure WinMsg(sMsg.s)
;#----------------------
If OpenWindow(#WinMsg, 0, 0, 300, 30, "", #PB_Window_BorderLess | #PB_Window_ScreenCentered)
SetWindowColor(#WinMsg,RGB(255,255,190)) ;Pale Yellow
TextGadget(#TxtWinMsg, 5, 5, 290, 20, "", #PB_Text_Center)
SetGadgetColor(#TxtWinMsg, #PB_Gadget_BackColor, RGB(255,255,190))
SetGadgetColor(#TxtWinMsg, #PB_Gadget_FrontColor, RGB(0,0,0))
SetGadgetText(#TxtWinMsg, sMsg)
StickyWindow(#WinMsg, #True)
EndIf
EndProcedure
Procedure Pick2Pts(iImgID.i)
;#--------------------------
; Pick 2 points to define area of web page inside Browser Window
Protected iPick1.i = #False
Protected iPick2.i = #False
Protected iEvent.i
Protected sMsg1.s, sMsg2.s
If LeftButtonDown() : SendInput_(1,@MouseUpL,SizeOf(INPUT)) : EndIf
WinMsg("Pick top-left corner of web page")
Repeat
If(GetAsyncKeyState_(#VK_ESCAPE) & 32768)
Goto Pick2PtsQuit
ElseIf(GetAsyncKeyState_(igLEFTBTN) & 32768) ;button is down
GetCursorPos_(gPt1)
iPick1 = #True
Break
EndIf
Until iPick1 = #True
CloseWindow(#WinMsg)
If LeftButtonDown() : SendInput_(1,@MouseUpL,SizeOf(INPUT)) : EndIf
WinMsg("Pick bottom-right corner of web page")
Repeat
If(GetAsyncKeyState_(#VK_ESCAPE) & 32768)
Goto Pick2PtsQuit
ElseIf(GetAsyncKeyState_(igLEFTBTN) & 32768) ;button is down
GetCursorPos_(gPt2)
iPick2 = #True
Break
EndIf
Until iPick2 = #True
Pick2PtsQuit:
CloseWindow(#WinMsg)
EndProcedure
Procedure ScrollDown()
;#--------------------
Protected In.INPUT
In\type = #INPUT_KEYBOARD
In\ki\wVk = #VK_DOWN
SendInput_(1,@In,SizeOf(INPUT))
In\ki\dwFlags = #KEYEVENTF_KEYUP
SendInput_(1,@In,SizeOf(INPUT))
EndProcedure
Procedure ScrollUp()
;#------------------
Protected In.INPUT
In\type = #INPUT_KEYBOARD
In\ki\wVk = #VK_UP
SendInput_(1,@In,SizeOf(INPUT))
In\ki\dwFlags = #KEYEVENTF_KEYUP
SendInput_(1,@In,SizeOf(INPUT))
EndProcedure
Procedure GetHandle(sWtxt.s)
;#--------------------------
Protected hWnd.i = GetWindow_(GetDesktopWindow_(), #GW_CHILD)
Protected hwndFin.i
Protected sWinTxt.s
Repeat
sWinTxt = Space(#MAX_PATH)
GetWindowText_(hWnd, @sWinTxt, #MAX_PATH)
If( (FindString(LCase(sWinTxt), LCase(sWtxt), 1) <> 0) And (IsWindowVisible_(hWnd) = 1) )
hwndFin = hWnd
Else
hWnd = GetWindow_(hWnd, #GW_HWNDNEXT)
EndIf
Until hWnd = 0 Or hwndFin <> 0
ProcedureReturn(hwndFin)
EndProcedure
Procedure CaptureWebPage()
;#------------------------
Protected iX.i = 0, iY.i = 0
Protected iCnt.i, iBrowser.i, iKey.i, iCycle.i, hWnd.i, iTotal.i = 10
Protected iImgW.i, iImgH.i, iIconic.i = #False
Protected WinRect.RECT
Protected sBrowser.s
Protected dm.DEVMODE ;structure for CreateDC()
Protected screenDC.i, trgDC.i, hBmp.i
For iBrowser = 1 To 4
Read.s sBrowser
hWnd = GetHandle(sBrowser)
If(hWnd <> 0)
Break
EndIf
Next iBrowser
If hWnd
If IsIconic_(hWnd)
ShowWindow_(hWnd, #SW_RESTORE)
iIconic = #True
EndIf
SetForegroundWindow_(hWnd)
Pick2Pts(hWnd)
iImgW = (gPt2\x - gPt1\x)
iImgH = (gPt2\y - gPt1\y)
iCycle = (iImgH) / 58 - 1
SetActiveWindow_(hWnd)
If CreateImage(#WholePage, iImgW, (iImgH * iTotal), 24, RGB(255,255,255))
For iCnt = 1 To iTotal
screenDC = CreateDC_("DISPLAY", "", "", dm) ;Initialise dm
trgDC = CreateCompatibleDC_(screenDC)
hBmp = 0
If StartDrawing(ImageOutput(#WholePage))
hBmp = CreateCompatibleBitmap_(screenDC, iImgW, iImgH)
SelectObject_(trgDC, hBmp)
BitBlt_(trgDC, 0, 0, iImgW, iImgH, screenDC, gPt1\x, gPt1\y, #SRCCOPY)
DrawImage(hBmp, iX, iY)
StopDrawing()
iY = iY + iImgH
Delay(100)
For iKey = 1 To iCycle
ScrollDown()
Next
EndIf
;Clean up
DeleteDC_(trgDC)
ReleaseDC_(hBmp, screenDC)
Next iCnt
Delay(100)
SaveImage(#WholePage,"C:\WebPageImage.png", #PB_ImagePlugin_PNG, 10, 24)
Delay(100)
RunProgram("C:\WebPageImage.png")
EndIf
For iKey = 1 To iCycle * 10
ScrollUp()
Next
If iIconic = #True
ShowWindow_(hWnd, #SW_MINIMIZE)
EndIf
EndIf
EndProcedure
CaptureWebPage()
;Reset Cursor Pointers Set
SystemParametersInfo_(#SPI_SETCURSORS,0,#Null,#Null)
End
DataSection
Data.s "Explorer","Fire","Opera","Chrome"
EndDataSection
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
If it sounds simple, you have not grasped the complexity.