Code: Select all
EnableExplicit
Enumeration
#frmSnapShot
#frmSnapShot_WB
EndEnumeration
Enumeration
#DVASPECT_CONTENT = 1
#DVASPECT_THUMBNAIL = 2
#DVASPECT_ICON = 4
#DVASPECT_DOCPRINT = 8
EndEnumeration
Procedure.l TakeWebSnapshot(URL$, WBWidth.l, WBHeight.l, Filename$, ThumbWidth.l, ThumbHeight.l, ThumbRatio.f)
Define.IWebBrowser2 m_pWebBrowser
Define.IHTMLDocument2 pDocument
Define.IHTMLDocument3 pDocument3
Define.IHTMLElement pElement
Define.IHTMLElement2 pElement2
Define.iDispatch pDispatch
Define.IViewObject2 pViewObject
Define.l bodyHeight
Define.l bodyWidth
Define.l rootHeight
Define.l rootWidth
Define.RECT rcBounds
Define.l bolFlag
Define.l IsBusy
Define.l hr
bolFlag = #False
If OpenWindow(#frmSnapShot, 0, 0, 0, 0, "", #PB_Window_Invisible | #PB_Window_BorderLess)
If CreateGadgetList(WindowID(#frmSnapShot))
WebGadget(#frmSnapShot_WB, 0, 0, 0, 0, URL$)
Repeat
If GetGadgetAttribute(#frmSnapShot_WB, #PB_Web_Busy) = 0
Break
EndIf
While WindowEvent(): Delay(1) : Wend
ForEver
m_pWebBrowser = GetWindowLong_(GadgetID(#frmSnapShot_WB), #GWL_USERDATA)
; hr = m_pWebBrowser->get_Document(&pDispatch);
hr = m_pWebBrowser\get_document(@pDispatch)
If hr = #S_OK
If pDispatch
; hr = pDispatch->QueryInterface(IID_IHTMLDocument2, (void**)&pDocument);
hr = pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument)
If hr = #S_OK
If pDocument
; hr = pDocument->get_body(&pElement);
hr = pDocument\get_body(@pElement)
If hr = #S_OK
If pElement
; hr = pElement->QueryInterface(IID_IHTMLElement2, (void**)&pElement2);
hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
If hr = #S_OK
If pElement2
; hr = pElement2->get_scrollHeight(&bodyHeight);
hr = pElement2\get_scrollHeight(@bodyHeight)
If hr = #S_OK
Debug "bodyHeight: " + Str(bodyHeight)
; hr = pElement2->get_scrollWidth(&bodyWidth);
hr = pElement2\get_scrollWidth(@bodyWidth)
If hr = #S_OK
Debug "bodyWidth: " + Str(bodyWidth)
; hr = pDispatch->QueryInterface(IID_IHTMLDocument3, (void**)&pDocument3);
hr = pDispatch\QueryInterface(?IID_IHTMLDocument3, @pDocument3)
If hr = #S_OK
If pDocument3
; hr = pDocument3->get_documentElement(&pElement);
hr = pDocument3\get_documentElement(@pElement)
If hr <> #S_OK : ProcedureReturn #False : EndIf
; hr = pElement->QueryInterface(IID_IHTMLElement2, (void**)&pElement2);
hr = pElement\QueryInterface(?IID_IHTMLElement2, @pElement2)
If hr <> #S_OK : ProcedureReturn #False : EndIf
; hr = pElement2->get_scrollHeight(&rootHeight);
hr = pElement2\get_scrollHeight(@rootHeight)
If hr <> #S_OK : ProcedureReturn #False : EndIf
Debug "rootHeight: " + Str(rootHeight)
; hr = pElement2->get_scrollWidth(&rootWidth);
hr = pElement2\get_scrollWidth(@rootWidth)
If hr <> #S_OK : ProcedureReturn #False : EndIf
Debug "rootWidth: " + Str(rootWidth)
Define.l width
Define.l height
width = bodyWidth
; If rootWidth > bodyWidth : Width = rootWidth : EndIf
height = bodyHeight
; If rootHeight > bodyHeight : Height = rootHeight : EndIf
width + 22
If WBHeight > 0 : height = WBHeight : EndIf
If WBWidth > 0 : width = WBWidth : EndIf
ResizeGadget(#frmSnapShot_WB, 0, 0, width, height)
; hr = m_pWebBrowser->QueryInterface(IID_IViewObject2, (void**)&pViewObject);
hr = m_pWebBrowser\QueryInterface(?IID_IViewObject2, @pViewObject)
If hr = #S_OK
If pViewObject
Define.l hdcMain
hdcMain = GetDC_(0)
If hdcMain
Define.l hdcMem
hdcMem = CreateCompatibleDC_(hdcMain)
If hdcMem
Define.l hBitmap
hBitmap = CreateCompatibleBitmap_(hdcMain, width, height)
If hBitmap
Define.l 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.l Image
Image = CreateImage(#PB_Any, width, height)
If Image
Define.l img_hDC
img_hDC = StartDrawing(ImageOutput(Image))
If img_hDC
BitBlt_(img_hDC, 0, 0, width, height, hdcMem, 0, 0, #SRCCOPY)
StopDrawing()
If ThumbRatio > 0
ResizeImage(Image, width*ThumbRatio, height*ThumbRatio, #PB_Image_Smooth)
Else
ResizeImage(Image, ThumbWidth, ThumbHeight, #PB_Image_Smooth)
EndIf
SaveImage(Image,Filename$,#PB_ImagePlugin_BMP)
bolFlag = #True
EndIf ; img_hDC
FreeImage(Image)
EndIf ; Image
SelectObject_(hdcMem, oldImage)
EndIf ; hBitmap
DeleteDC_(hdcMem) ; DeleteDC_() bei CreateCompatibleDC_()
EndIf ; hdcMem
ReleaseDC_(0, hdcMain) ; ReleaseDC_() bei GetDC_()
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(#frmSnapShot)
EndIf
EndIf
ProcedureReturn bolFlag
EndProcedure
Procedure TakeWebSnapshot_test()
Define.s URL$
Define.s SaveAs$
Define.f ResizeFaktor
Define.l WBWidth
Define.l WBHeight
URL$ = "http://www.purebasic.com"
SaveAs$ = "c:\webshot.bmp"
ResizeFaktor.f = 0.5
If ResizeFaktor = 0 : ResizeFaktor = 1.0 : EndIf
If ResizeFaktor < 0 : ResizeFaktor = 0.1 : EndIf
If ResizeFaktor > 2 : ResizeFaktor = 2.0 : EndIf
ExamineDesktops()
WBWidth = DesktopWidth(0)
WBHeight = DesktopHeight(0)
If TakeWebSnapshot(URL$, WBWidth, WBHeight, SaveAs$, 0, 0, ResizeFaktor)
RunProgram(SaveAs$)
Else
MessageRequester("WebShot", "TakeWebSnapshot() failed")
EndIf
EndProcedure
TakeWebSnapshot_test()
End
DataSection ;{
IID_IHTMLDocument2:
;332C4425-26CB-11D0-B483-00C04FD90119
Data.l $332C4425
Data.w $26CB, $11D0
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
IID_IHTMLDocument3:
;3050F485-98B5-11CF-BB82-00AA00BDCE0B
Data.l $3050F485
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLElement2:
;3050f434-98b5-11cf-bb82-00aa00bdce0b
Data.l $3050F434
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IViewObject2:
;00000127-0000-0000-c000-000000000046
Data.l $00000127
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
EndDataSection ;}
Greetings ... Kiffi
Kiffi - thats great .. thank you very much!!!!
And thus fails. Are