@Chris:
> Dass du die Entwicklung einstellst ist mir unerklärlich - why?
Zum einen, weil WebSwoon (s.o.) genau das macht, was ich eigentlich von
so einem Tool erwarte. Normalerweise schreibe ich mir meine Tools, weil
es etwas vergleichbares nicht gibt oder weil ich denke, bestehende Tools
besser (auf meine Bedürfnisse angepasst) realisieren zu können.
Zum anderen: Die liebe Zeit, die ich leider leider nicht habe. Ist ja nicht
so, dass ich sonst nix zu tun habe
Habe halt meine Prioritäten
zugunsten anderer Projekte verschoben.
> Wenn - dann kannst du den Source ja einem Interessierten Progger geben,
> der dein Tool in ehren weiterproggt
das wäre in der Tat sehr nett. Allerdings bezweifel ich, dass sich hier
jemand findet, der das Projekt weiterführt.
@onny:
>*grins* ich glaube du weisst was ich meine...
ja, klar weiss ich, was Du meinst
[mal kurz in den archivkeller geh]
OK, hier der Code für PB4. Ist allerdings ohne aufrufendes Fenster (ist
aber schnell nachprogrammiert) und ohne Kommentare.
Code: Alles auswählen
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$)
m_pWebBrowser = GetWindowLong_(GadgetID(#frmSnapShot_WB), #GWL_USERDATA)
Repeat
m_pWebBrowser\get_Busy(@IsBusy)
Delay(1)
While WindowEvent(): Wend
Until IsBusy = 0
; 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" ; GetGadgetText(gadget(#frmMain_txtURL))
SaveAs$ = "c:\webshot.bmp" ; GetGadgetText(gadget(#frmMain_txtSaveAs))
ResizeFaktor.f = 0.5 ; ValF(GetGadgetText(gadget(#frmMain_txtResizeFaktor)))
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() konnte nicht korrekt ausgeführt werden")
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 ;}
