Auto Resize WebGadget [Windows]

RASHAD · Post by **RASHAD** » Tue Mar 13, 2012 8:53 pm



OpenWindow(0, 0, 0, 1024,768, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
ScrollAreaGadget(0, 10, 10, 1000, 720, 10000,10000,100,#PB_ScrollArea_Flat)
WebGadget(1, 10, 10, 100, 100, "http://www.qinbiying.co.uk")
;Delay(100)
CloseGadgetList()
ButtonGadget(2,10,735,60,25,"Resize")
GetWindowRect_(GadgetID(1),r.RECT)
Delay(100)

Repeat
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
          Quit = 1
     
      Case #PB_Event_Gadget
          Select EventGadget()
            Case 2            
                If Run = 0
                    hdc = GetDC_(0)
                    xcolor = GetPixel_(hdc, r\right-40, r\bottom-5)
                   For x = 0 To 10000
                     SetGadgetAttribute(1, #PB_Web_ScrollX, x)
                     x + 100
                      If GetPixel_(hdc, r\right-40, r\bottom-5) <> xcolor
                       Break
                     EndIf
                   Next
                                       
                   ycolor = GetPixel_(hdc, r\right-5, r\bottom-40)
                   For y = 0 To 10000
                     SetGadgetAttribute(1, #PB_Web_ScrollY, y)
                     y + 100
                     If GetPixel_(hdc, r\right-5, r\bottom-40) <> ycolor
                       Break
                     EndIf
                   Next
                   ReleaseDC_(WindowID(0),hdc)
                   ResizeGadget(1,10,10,x*1.1+40,y*1.1+40)
                   Run = 1
                EndIf
          EndSelect
  EndSelect
Until Quit = 1

Edit : Modified a little

luis · Post by **luis** » Tue Mar 13, 2012 9:24 pm

Brute force approach

ts-soft · Post by **ts-soft** » Tue Mar 13, 2012 9:32 pm

I would have expected, actually, another result

luis · Post by **luis** » Tue Mar 13, 2012 9:36 pm

Did you press the button ?

Probably it's off your screen.

ts-soft · Post by **ts-soft** » Tue Mar 13, 2012 9:41 pm

luis wrote:Did you press the button ?

Probably it's off your screen.

Sorry, i have not seen any button, is outside my screen (1680 X 1050)

After pressing the button, the result is another, but not better

luis · Post by **luis** » Tue Mar 13, 2012 9:53 pm

Strange, here it works. Tried with google and PB's home. IE 8.x, PB4.60
Anyway, it's a nice idea but a little too brutal for my taste to implement it in a real program

IdeasVacuum · Post by **IdeasVacuum** » Tue Mar 13, 2012 10:40 pm

Results much better than before, but success still depends on the web page loaded. Works perfectly with "http://www.purebasic.com", it does not work (height) with my wife's web page "http://www.qinbiying.co.uk".

RASHAD · Post by **RASHAD** » Wed Mar 14, 2012 3:49 am

Thanks luis
As you said it is just an idea (For fun maybe)

@IdeasVacuum
It works fine even with your wife site
Just increase

Code: Select all

For y = 0 To 10000
.
.

To suit your height
We should do our best she is the boss after all
Right ?

IdeasVacuum · Post by **IdeasVacuum** » Wed Mar 14, 2012 4:04 am

We should do our best she is the boss after all Right ?

...hang on, I'll just ask her if I can tell you

breeze4me · Post by **breeze4me** » Wed Mar 14, 2012 10:39 pm

not fully tested.

Code: Select all

EnableExplicit

Procedure WebGadget_GetScrollWidth(WebGadget)
  Protected Result = -1, Browser.IWebBrowser2 = GetWindowLong_(GadgetID(WebGadget), #GWL_USERDATA)
  Protected DocumentDispatch.IDispatch, Document.IHTMLDocument2, Element.IHTMLElement2, DocElement.IHTMLElement
  If Browser
    If Browser\get_Document(@DocumentDispatch) = #S_OK And DocumentDispatch
      If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document) = #S_OK And Document
        If Document\get_body(@DocElement) = #S_OK And DocElement
          If docElement\QueryInterface(?IID_IHTMLElement2, @Element) = #S_OK And Element
            If Element\get_scrollWidth(@Result) <> #S_OK
              Result = -1
            EndIf
            Element\Release()
          EndIf
          DocElement\Release()
        EndIf
        Document\Release()
      EndIf
      DocumentDispatch\Release()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure WebGadget_GetScrollHeight(WebGadget)
  Protected Result = -1, Browser.IWebBrowser2 = GetWindowLong_(GadgetID(WebGadget), #GWL_USERDATA)
  Protected DocumentDispatch.IDispatch, Document.IHTMLDocument2, Element.IHTMLElement2, DocElement.IHTMLElement
  If Browser
    If Browser\get_Document(@DocumentDispatch) = #S_OK And DocumentDispatch
      If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document) = #S_OK And Document
        If Document\get_body(@DocElement) = #S_OK And DocElement
          If docElement\QueryInterface(?IID_IHTMLElement2, @Element) = #S_OK And Element
            If Element\get_scrollHeight(@Result) <> #S_OK
              Result = -1
            EndIf
            Element\Release()
          EndIf
          DocElement\Release()
        EndIf
        Document\Release()
      EndIf
      DocumentDispatch\Release()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

DisableExplicit

DataSection
  IID_IHTMLDocument2:
  Data.l $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
  IID_IHTMLElement2:
  Data.l $3050F434
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
EndDataSection




;- example

url.s = "http://www.purebasic.com"
;url.s = "http://www.google.com"
;url.s = "http://www.qinbiying.co.uk"

OpenWindow(0, 0, 0, 1024, 840, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
ButtonGadget(1, 10, 5, 60, 25, "Resize")
WebGadget(0, 80, 1, 100, 65, url)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          If GetGadgetAttribute(0, #PB_Web_Busy) = 0
            w = WebGadget_GetScrollWidth(0) + 16  ;+ scrollbar width
            h = WebGadget_GetScrollHeight(0)
            Debug "W:" + Str(w) + " , H:" + Str(h)
            ResizeWindow(0, #PB_Ignore, #PB_Ignore, #PB_Ignore, h + 60)
            ResizeGadget(0, #PB_Ignore, #PB_Ignore, w, h)
          Else
            Debug "busy"
          EndIf
          
      EndSelect
  EndSelect
Until Quit = 1

ts-soft · Post by **ts-soft** » Wed Mar 14, 2012 11:14 pm

@breeze4me

This works for me

I have only changed line 84 to:

Code: Select all

w = WebGadget_GetScrollWidth(0) + 20  ;+ scrollbar width

IdeasVacuum · Post by **IdeasVacuum** » Thu Mar 15, 2012 3:51 am

@breeze4me: Works very well, thank you. Especially clever to size to the document

IdeasVacuum · Post by **IdeasVacuum** » Thu Mar 15, 2012 7:02 am

..... ah, leads to another issue, capturing the web page as an image. I was thinking that GetDCEx with a region the size of the WebGadget would work, but it only grabs the portion that can be seen on screen - not good, since for the final app, the WebGadget Window would be hidden

Now, in the past past I have "built-up" a full image by capturing a visible region, scroll, capture etc but I was hoping that would not be necessary since it is a distraction.

Code: Select all

EnableExplicit

UsePNGImageEncoder()

Enumeration
  #Win
  #Web2
  #CapImage
EndEnumeration

Global gUrl.s = "http://www.qinbiying.co.uk"

Procedure CaptureImage(iX.i, iY.i, iW.i, iH.i, iGdt)
;---------------------------------------------------
        Define       hRgn = CreateRectRgn_(iX,iY,iW,iH)
        Define sImgName.s = "C:\Test.png"
        Define   hImage.i = CreateImage(#CapImage,iW,iH)
        ;Define       DC.i = GetDC_(GadgetID(iGdt))
        Define     DCex.i = GetDCEx_(GadgetID(iGdt),hRgn,#DCX_CACHE)

        Define      hdc.i = StartDrawing(ImageOutput(#CapImage))

        BitBlt_(hdc,0,0,iW,iH,DCex,iX,iY,#SRCCOPY)

        StopDrawing()

        If IsImage(#CapImage)

                SaveImage(#CapImage, sImgName, #PB_ImagePlugin_PNG, 24)
                FreeImage(#CapImage)
        EndIf

        DeleteObject_(hdc)
        DeleteObject_(DCex)

EndProcedure

Procedure WebGadget_GetScrollWidth(WebGadget)
;--------------------------------------------
  Protected Result = -1, Browser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(WebGadget), #GWL_USERDATA)
  Protected DocumentDispatch.IDispatch, Document.IHTMLDocument2, Element.IHTMLElement2, DocElement.IHTMLElement

  If Browser
    If Browser\get_Document(@DocumentDispatch) = #S_OK And DocumentDispatch
      If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document) = #S_OK And Document
        If Document\get_body(@DocElement) = #S_OK And DocElement
          If docElement\QueryInterface(?IID_IHTMLElement2, @Element) = #S_OK And Element
            If Element\get_scrollWidth(@Result) <> #S_OK
              Result = -1
            EndIf
            Element\Release()
          EndIf
          DocElement\Release()
        EndIf
        Document\Release()
      EndIf
      DocumentDispatch\Release()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure WebGadget_GetScrollHeight(WebGadget)
;---------------------------------------------

  Protected Result = -1, Browser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(WebGadget), #GWL_USERDATA)
  Protected DocumentDispatch.IDispatch, Document.IHTMLDocument2, Element.IHTMLElement2, DocElement.IHTMLElement

  If Browser
    If Browser\get_Document(@DocumentDispatch) = #S_OK And DocumentDispatch
      If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document) = #S_OK And Document
        If Document\get_body(@DocElement) = #S_OK And DocElement
          If docElement\QueryInterface(?IID_IHTMLElement2, @Element) = #S_OK And Element
            If Element\get_scrollHeight(@Result) <> #S_OK
              Result = -1
            EndIf
            Element\Release()
          EndIf
          DocElement\Release()
        EndIf
        Document\Release()
      EndIf
      DocumentDispatch\Release()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure

DisableExplicit

DataSection
  IID_IHTMLDocument2:
  Data.l $332C4425
  Data.w $26CB, $11D0
  Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
  IID_IHTMLElement2:
  Data.l $3050F434
  Data.w $98B5, $11CF
  Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
EndDataSection


Procedure OpenWin()
;------------------

     If OpenWindow(#Win, 0, 0, 210, 210, gUrl, #PB_Window_SystemMenu|#PB_Window_SizeGadget)

             WebGadget(#Web2, 5, 5, 200, 200, gUrl)
     EndIf

EndProcedure

Procedure WaitWeb()
;------------------

  iTryCnt.i = 0

         Repeat

                 If(iTryCnt < 100)

                        If(GetGadgetAttribute(#Web2, #PB_Web_Busy) = 0)

                                  w = WebGadget_GetScrollWidth(#Web2) + 20  ;+ scrollbar width
                                  h = WebGadget_GetScrollHeight(#Web2) + 20

                                  ResizeWindow(#Win, #PB_Ignore, #PB_Ignore, w + 10, h + 10)
                                  ResizeGadget(#Web2, #PB_Ignore, #PB_Ignore, w, h)

                                  UpdateWindow_(WindowID(#Win))
                                          Delay(1000)

                                   CaptureImage(0,0,w,h,#Web2)

                                  iTryCnt = 300

                        Else
                                  Delay(100)
                        EndIf

                 Else
                        If Not (iTryCnt > 200) : SetWindowTitle(#Win,"Capture Web Page Failed") : EndIf
                 EndIf

                 iTryCnt + 1

         Until WaitWindowEvent(1) = #PB_Event_CloseWindow

EndProcedure

OpenWin()
WaitWeb()

End

RASHAD · Post by **RASHAD** » Thu Mar 15, 2012 8:30 am

First post modified

Well breeze4me

You asked for the hard way

Code: Select all

UsePNGImageEncoder()

  Enumeration 1 
    #OLECMDID_OPEN          
    #OLECMDID_NEW          
    #OLECMDID_SAVE          
    #OLECMDID_SAVEAS          
    #OLECMDID_SAVECOPYAS    
    #OLECMDID_PRINT          
    #OLECMDID_PRINTPREVIEW    
    #OLECMDID_PAGESETUP      
    #OLECMDID_SPELL          
    #OLECMDID_PROPERTIES      
    #OLECMDID_CUT            
    #OLECMDID_COPY            
    #OLECMDID_PASTE            
    #OLECMDID_PASTESPECIAL    
    #OLECMDID_UNDO            
    #OLECMDID_REDO              
    #OLECMDID_SELECTALL        
    #OLECMDID_CLEARSELECTION  
    #OLECMDID_ZOOM              
    #OLECMDID_GETZOOMRANGE      
    #OLECMDID_UPDATECOMMANDS    
    #OLECMDID_REFRESH            
    #OLECMDID_STOP              
    #OLECMDID_HIDETOOLBARS    
    #OLECMDID_SETPROGRESSMAX    
    #OLECMDID_SETPROGRESSPOS    
    #OLECMDID_SETPROGRESSTEXT    
    #OLECMDID_SETTITLE            
    #OLECMDID_SETDOWNLOADSTATE  
    #OLECMDID_STOPDOWNLOAD    
    #OLECMDID_ONTOOLBARACTIVATED 
    #OLECMDID_FIND              
    #OLECMDID_DELETE            
    #OLECMDID_HTTPEQUIV        
    #OLECMDID_HTTPEQUIV_DONE    
    #OLECMDID_ENABLE_INTERACTION 
    #OLECMDID_ONUNLOAD          
    #OLECMDID_PROPERTYBAG2      
    #OLECMDID_PREREFRESH        
    #OLECMDID_SHOWSCRIPTERROR 
    #OLECMDID_SHOWMESSAGE      
    #OLECMDID_SHOWFIND        
    #OLECMDID_SHOWPAGESETUP    
    #OLECMDID_SHOWPRINT        
    #OLECMDID_CLOSE          
    #OLECMDID_ALLOWUILESSSAVEAS 
    #OLECMDID_DONTDOWNLOADCSS 
    #OLECMDID_UPDATEPAGESTATUS 
    #OLECMDID_PRINT2 
    #OLECMDID_PRINTPREVIEW2 
    #OLECMDID_SETPRINTTEMPLATE 
    #OLECMDID_GETPRINTTEMPLATE 
  EndEnumeration 

Enumeration 0
  #OLECMDEXECOPT_DODEFAULT     
  #OLECMDEXECOPT_PROMPTUSER       
  #OLECMDEXECOPT_DONTPROMPTUSER   
  #OLECMDEXECOPT_SHOWHELP       
EndEnumeration 

Enumeration 
  #VT_EMPTY           = 0
  #VT_NULL            = 1
  #VT_I2              = 2
  #VT_I4              = 3
  #VT_R4              = 4
  #VT_R8              = 5
  #VT_CY              = 6
  #VT_DATE            = 7
  #VT_BSTR            = 8
  #VT_DISPATCH        = 9
  #VT_ERROR           = 10
  #VT_BOOL            = 11
  #VT_VARIANT         = 12
  #VT_UNKNOWN         = 13
  #VT_DECIMAL         = 14
  #VT_I1              = 16
  #VT_UI1             = 17
  #VT_UI2             = 18
  #VT_UI4             = 19
  #VT_I8              = 20
  #VT_UI8             = 21
  #VT_INT             = 22
  #VT_UINT            = 23
  #VT_VOID            = 24
  #VT_HRESULT         = 25
  #VT_PTR             = 26
  #VT_SAFEARRAY       = 27
  #VT_CARRAY          = 28
  #VT_USERDEFINED     = 29
  #VT_LPSTR           = 30
  #VT_LPWSTR          = 31
  #VT_RECORD          = 36
  #VT_FILETIME        = 64
  #VT_BLOB            = 65
  #VT_STREAM          = 66
  #VT_STORAGE         = 67
  #VT_STREAMED_OBJECT = 68
  #VT_STORED_OBJECT   = 69
  #VT_BLOB_OBJECT     = 70
  #VT_CF              = 71
  #VT_CLSID           = 72
  #VT_BSTR_BLOB       = $0fff
  #VT_VECTOR          = $1000
  #VT_ARRAY           = $2000
  #VT_BYREF           = $4000
  #VT_RESERVED        = $8000
  #VT_ILLEGAL         = $ffff
  #VT_ILLEGALMASKED   = $0fff
  #VT_TYPEMASK        = $0fff
EndEnumeration

#BEFORENAVIGATE    =     250 
#DOCUMENTCOMPLETE  =     259

Structure DispatchFunctions 
    QueryInterface.l 
    AddRef.l 
    Release.l 
    GetTypeInfoCount.l 
    GetTypeInfo.l 
    GetIDsOfNames.l 
    Invoke.l 
EndStructure 

Structure DispatchObject 
    *IDispatch.IDispatch 
    ObjectCount.l 
    GadgetID.l 
EndStructure 

Global Depth
Global NewList dispatchObject.DispatchObject() 

Procedure DocumentComplete(*THIS.DispatchObject,*pDisp.IDispatch, *URL.Variant)

    depth = depth +  PeekL(*Url\bstrval-4)
    
EndProcedure

Procedure.l AddRef(*THIS.DispatchObject) 
    *THIS\ObjectCount + 1 
    ProcedureReturn *THIS\ObjectCount 
EndProcedure 

Procedure.l QueryInterface(*THIS.DispatchObject, *iid.GUID, *Object.LONG) 

    If CompareMemory(*iid, ?IID_IUnknown, SizeOf(GUID)) Or CompareMemory(*iid, ?IID_IDispatch, SizeOf(GUID)) 
        *Object\l = *THIS 
        AddRef(*THIS.DispatchObject) 
        ProcedureReturn #S_OK 
    Else 
        *Object\l = 0 
        ProcedureReturn #E_NOINTERFACE 
    EndIf 
EndProcedure 

Procedure.l Release(*THIS.DispatchObject) 
    *THIS\ObjectCount - 1 
    ProcedureReturn *THIS\ObjectCount 
EndProcedure 

Procedure GetTypeInfoCount(*THIS.DispatchObject, pctinfo) 
    ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure GetTypeInfo(*THIS.DispatchObject, iTInfo, lcid, ppTInfo ) 
    ProcedureReturn #E_NOTIMPL 
EndProcedure 

Procedure GetIDsOfNames(*THIS.DispatchObject, riid, rgszNames, cNames, lcid, rgDispId) : EndProcedure 

Procedure Invoke(*THIS.DispatchObject, dispIdMember, riid, lcid, wFlags, *pDispParams.DISPPARAMS, pVarResult, pExcepInfo, puArgErr)
    Select dispIDMember 
        Case #BEFORENAVIGATE 
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*6) 
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*5) 
            *params3.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*4) 
            *params4.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*3) 
            *params5.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*2) 
            *params6.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
            *params7.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0) 
            
        Case #DOCUMENTCOMPLETE 
            *params1.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*1) 
            *params2.VARIANT = *pDispParams\rgvarg +(SizeOf(VARIANT)*0)                        
            DocumentComplete(*THIS,*params1\pDispVal, *params2\pvarVal)

    EndSelect 
EndProcedure 


Procedure CaptureImage(iX.i, iY.i, iW.i, iH.i, iGdt)
;---------------------------------------------------
        Define       hRgn = CreateRectRgn_(iX,iY,iW,iH)
        Define sImgName.s = "F:\RASHAD_Test.png"
        Define   hImage.i = CreateImage(0,iW,iH)
        ;Define       DC.i = GetDC_(GadgetID(iGdt))
        Define     DCex.i = GetDCEx_(GadgetID(iGdt),hRgn,#DCX_CACHE)

        Define      hdc.i = StartDrawing(ImageOutput(0))

        BitBlt_(hdc,0,0,iW,iH,DCex,iX,iY,#SRCCOPY)

        StopDrawing()

        If IsImage(0)

                SaveImage(0, sImgName, #PB_ImagePlugin_PNG, 24)
                FreeImage(0)
        EndIf

        DeleteObject_(hdc)
        DeleteObject_(DCex)

EndProcedure


Procedure WndProc(hwnd, uMsg, wParam, lParam)
      result = #PB_ProcessPureBasicEvents 

 Select uMsg
   
   Case #WM_NOTIFY  

   Case #WM_SIZE
        ResizeGadget(2,10,WindowHeight(0)- 55,80,24)
        ResizeGadget(3,100,WindowHeight(0)- 55,80,24)
        ResizeGadget(4,200,WindowHeight(0)- 55,80,24)
        ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)- 72)
             
   EndSelect
   
  ProcedureReturn result 
EndProcedure


OpenWindow(0,0,0,1020,650,"Auto WebGadget",#PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_SizeGadget)

  CreateStatusBar(0, WindowID(0))
    AddStatusBarField(100)
    AddStatusBarField(300)
    AddStatusBarField(300)

ScrollAreaGadget(0,10,10,1000,578,10000,10000,#PB_ScrollArea_Flat)
;WebGadget(1,0,0,1000,620, "http://www.purebasic.com")
;WebGadget(1,0,0,1000,620, "http://www.google.com")
WebGadget(1,0,0,1000,618, "http://www.qinbiying.co.uk") 
CloseGadgetList()

ButtonGadget(2,10,595,80,24,"Save As MHT")
ButtonGadget(3,100,595,80,24,"Adjust")
ButtonGadget(4,200,595,80,24,"Save As BMP")

AddElement(DispatchObject()) 
DispatchObject()\IDispatch = ?dispatchFunctions 
DispatchObject()\GadgetID=0 
webBrowser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(1), #GWL_USERDATA) 
webBrowser\QueryInterface(?IID_IConnectionPointContainer, @connectionPointContainer.IConnectionPointContainer) 
connectionPointContainer\findconnectionpoint(?IID_DWebBrowserEvents2, @connectionPoint.IConnectionPoint) 
connectionPoint\Advise(DispatchObject(), @Cookie) 
connectionPoint\release() 
connectionPointContainer\release()

SetWindowCallback(@WndProc())

Repeat    
     If GetGadgetAttribute(1, #PB_Web_Busy) = 1 And Flag = 0
        Status$ = "Busy"
        StatusBarText(0, 0, Status$,#PB_StatusBar_Center )
        DisableGadget(2,1)
        DisableGadget(3,1)
        DisableGadget(4,1)
     ElseIf GetGadgetAttribute(1, #PB_Web_Busy) = 0 And Flag = 0
        ResizeGadget(1,0,0,#PB_Ignore,depth*2+800)
        Status$ = "Finished"
        StatusBarText(0, 0 , Status$,#PB_StatusBar_Center )
        StatusBarText(0, 1 , "WebPage Width  :  " +Str(GadgetWidth(1))) 
        StatusBarText(0, 2 , "WebPage Height :  " +Str(GadgetHeight(1)+800))
        DisableGadget(2,0)
        DisableGadget(3,0)
        Flag = 1 
     EndIf
 
   Select WaitWindowEvent()
      
       Case #PB_Event_CloseWindow
           Quit = 1
       
    
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 2 
              filename$ = ""
              
              filename_Unicode = AllocateMemory(Len(filename$)*2+2)
              MultiByteToWideChar_(#CP_ACP, 0, @filename$, -1, filename_Unicode, Len(filename$)*2+2)               
              filename_BSTR = SysAllocString_(filename_Unicode)
              VariantIn.VARIANT
              VariantIn\vt = #VT_BSTR
              VariantIn\bstrVal = filename_BSTR             
              If webBrowser\ExecWB(#OLECMDID_SAVEAS, #OLECMDEXECOPT_PROMPTUSER, @VariantIn, 0) = #S_OK
                MessageRequester("","Saved successfully")
              Else
                MessageRequester("","could not save file")
              EndIf
              
              FreeMemory(filename_Unicode)
              SysFreeString_(filename_BSTR)
              
              
;            Case 3
;               ResizeWindow(0,0,0,1020,1100)
;               ResizeGadget(2,10,1050,80,24)
;               ResizeGadget(3,100,1050,80,24)
;               ResizeGadget(4,200,1050,80,24)
;               ResizeGadget(0,10,10,1000,1000)
;               ResizeGadget(1,0,0,1000,1000)
;               If webBrowser\ExecWB(#OLECMDID_ZOOM, #OLECMDEXECOPT_PROMPTUSER, 2, 0) = #S_OK
;                 MessageRequester("","Saved successfully")
;               Else
;                 MessageRequester("","could not save file")
;               EndIf
;              DisableGadget(4,0)
;               
;           Case 3
;              CaptureImage(0,0,1000,depth*2+800,1)

                                        
          EndSelect
   EndSelect
            
Until Quit = 1

End 

DataSection 
dispatchFunctions: 
Data.l @QueryInterface(),@AddRef(),@Release(),@GetTypeInfoCount() 
Data.l @GetTypeInfo(),@GetIDsOfNames(),@Invoke() 

IID_IWebBrowser2: 
Data.l $D30C1661 
Data.w $CDAF, $11D0 
Data.b $8A, $3E, $00, $C0, $4F, $C9, $E2, $6E 
    
IID_IConnectionPointContainer: 
Data.l $B196B284 
Data.w $BAB4, $101A 
Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07    

IID_IDispatch: 
Data.l $00020400 
Data.w $0000, $0000 
Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
    
IID_IUnknown: 
Data.l $00000000 
Data.w $0000, $0000 
Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
    
IID_DWebBrowserEvents2: 
Data.l $34A715A0 
Data.w $6587, $11D0 
Data.b $92, $4A, $00, $20, $AF, $C7, $AC, $4D 
EndDataSection

Edit: Modified for Resizing

Kwai chang caine · Post by **Kwai chang caine** » Thu Mar 15, 2012 9:47 am

@Rashad
Waooouuhh cool code, i need often MHTML, works great here
Thanks a lot RASHAD

@BREEZEFORME
It's a pity the capture is not of all the WebPage

But thanks too for sharing

PureBasic Forums - English

Auto Resize WebGadget [Windows]

Auto Resize WebGadget [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadget [Windows]

Re: Auto Resize WebGadegt [Windows]

Re: Auto Resize WebGadget [Windows]

Re: Auto Resize WebGadget [Windows]