WebGadget - retreiving URL of link under pointer

Just starting out? Need help? Post your questions and find answers here.
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Re: WebGadget - retreiving URL of link under pointer

Post by firace »

a_carignan wrote:I'm talking about the two sample code on this page.
I tried to convert the text with its command lines:

Code: Select all

*ascii=Ascii(anchor$)
anchor$=PeekS(*ascii,-1)
But it doesn't work, it's still Chinese. :?

Code: Select all


Global hBrowser, webInit

Global pElement.IHTMLElement
Global pAnchor.IHTMLAnchorElement
Global pDispatch.IDispatch
Global pDocument2.IHTMLDocument2
Global  WebObject.IWebBrowser2


Procedure doweb()
  
  If pDispatch : pDispatch\Release() : EndIf
   
  If WebObject\get_document(@pDispatch) = #S_OK
    
    If pDispatch\QueryInterface(?IID_IHTMLDocument2, @pDocument2) = #S_OK 
      hChild1 = FindWindowEx_(GadgetID(0), 0, "Shell Embedding", 0)
      hChild2 = FindWindowEx_(hChild1, 0, "Shell DocObject View", 0)
      hBrowser = FindWindowEx_(hChild2, 0, "Internet Explorer_Server", 0)
      If hBrowser = 0 ; is our browser window available yet
        
        If pDispatch : pDispatch\Release() : EndIf
        
        webInit = #False ; browser window not available yet
      Else
        webInit = #True ; browser window available
      EndIf
      
    EndIf
    
  EndIf
  
EndProcedure

Procedure MouseProc(nCode, wParam, lParam)
  *ms.MOUSEHOOKSTRUCT = lParam
  
  Select wParam
    
    Case #WM_RBUTTONUP
      
      StatusBarText(1, 0, "")
      currentsb$ = ""
      
    Case #WM_RBUTTONDOWN
      
      If pDocument2
        ;- I use WindowMouseX() and WindowMouseY() so for
        ;- PureBasic ver < 3.91, uncomment the next 3 lines
        ;GetCursorPos_(@cpos.POINT);
        ;ScreenToClient_(hBrowser, @cpos)
        ;If pDocument2\elementFromPoint(cpos\x, cpos\y, @pElement) = #S_OK
        
        ;- for PureBasic ver < 3.91, comment the next line
        If pDocument2\elementFromPoint(WindowMouseX(0) , WindowMouseY(0) , @pElement) = #S_OK
          
          If pElement\QueryInterface(?IID_IHTMLAnchorElement, @pAnchor)= #S_OK
            pElement\Release()
            pAnchor\get_href(@BSTR_Anchor)
            
            anchor$ =  PeekS(BSTR_Anchor)
                        
            If currentsb$ <> anchor$
              StatusBarText(1, 0, anchor$)
              currentsb$ = anchor$
            EndIf
            
            pAnchor\Release()
            
          Else
            StatusBarText(1, 0, "")
            currentsb$ = ""
              
          EndIf
          
        EndIf
          
      EndIf
      result = 1 ;result = 0 enables context menu
      
  EndSelect 
  
ProcedureReturn result
EndProcedure

If OpenWindow(0, 0, 0, 700, 500,  "Hypertext Info" , #PB_Window_SystemMenu ) 
  If CreateStatusBar(1, WindowID(0))
    AddStatusBarField(400)
  EndIf
  
    hWeb = WebGadget(0, 0, 0, WindowWidth(0), WindowHeight(0)-25, "http://www.purearea.net/pb/CodeArchiv/English.html") 
    WebObject = GetWindowLong_(GadgetID(0), #GWL_USERDATA)
  
  hInstance = GetModuleHandle_(0)
  lpdwProcessId = GetWindowThreadProcessId_(WindowID(0), 0)
  hhook = SetWindowsHookEx_(#WH_MOUSE, @MouseProc(), 0, lpdwProcessId)
   
EndIf 

Repeat 
   
  Event = WaitWindowEvent() 
  
  If Event = 32770 And webInit = #False
    doweb()
  EndIf
  
Until Event = #PB_Event_CloseWindow 
If hhook : UnhookWindowsHookEx_(hhook) : EndIf
If pDispatch : pDispatch\Release() : EndIf

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_IHTMLAnchorElement:
;3050F1DA-98B5-11CF-BB82-00AA00BDCE0B
Data.l $3050F1DA
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B 

EndDataSection

User avatar
a_carignan
User
User
Posts: 81
Joined: Sat Feb 21, 2009 2:01 am
Location: Canada

Re: WebGadget - retreiving URL of link under pointer

Post by a_carignan »

So a code that correctly displays the links. Thank you :D
User avatar
a_carignan
User
User
Posts: 81
Joined: Sat Feb 21, 2009 2:01 am
Location: Canada

Re: WebGadget - retreiving URL of link under pointer

Post by a_carignan »

Sorry,
I just tested the linins in a google search and the url to them is not showing.
Same for the url of the search images.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: WebGadget - retreiving URL of link under pointer

Post by RASHAD »

Hi

Code: Select all

Prototype.l AccessibleObjectFromPoint(x,y,*ia,*var)
Global AccessibleObjectFromPoint.AccessibleObjectFromPoint,Value.string, vt.VARIANT,*pIAcc.IAccessible,Text$

Olelib = OpenLibrary(#PB_Any,"Oleacc.dll")
If Olelib
  AccessibleObjectFromPoint=GetFunction(Olelib,"AccessibleObjectFromPoint")
Else
  MessageRequester("Error","Could't load the library",#MB_ICONERROR)
  End
EndIf

Procedure ObjectFromPoint( *Value.String,x,y)
  If AccessibleObjectFromPoint(x,y,@*pIAcc,@vt)=#S_OK
    *Value\s=""
    If *pIAcc\get_accValue(vt, @pName) = #S_OK
      Len = SysStringLen_(pName)
      *Value\s = Space(Len)     
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Value\s, len, 0, 0)
      CompilerIf #PB_Compiler_Unicode
        value\s = PeekS(@*Value\s,len,#PB_UTF8)
      CompilerEndIf     
      SysFreeString_(pName)
    EndIf
    *pIAcc\Release()
  EndIf
  ProcedureReturn #True
EndProcedure

LoadFont(0,"Georgia",12)

OpenWindow(0, 0, 0, 800, 600, "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
WebGadget(0, 0, 0, 800, 570 ,"http://www.purearea.net/pb/CodeArchiv/English.html")
TextGadget(1,10,570,780,30,"",#SS_CENTERIMAGE)
SetGadgetFont(1,FontID(0))


Repeat
  Select WaitWindowEvent()
      
    Case #PB_Event_CloseWindow
      Quit = 1           
      
    Case #WM_MOUSEMOVE
      GetCursorPos_ (@p.POINT)
      ObjectFromPoint(@value,p\x,p\y)
      ;Text$ = value\s
      SetGadgetText(1,value\s)       
      
  EndSelect
  
Until Quit = 1

CloseLibrary(Olelib) 
Egypt my love
Post Reply