PureBasic Forums - English

Code: Select all

; CaptureText
; Author: fizban (ported from a VC++ code of Nibu Babu Thomas)
; Original source: http://nibuthomas.wordpress.com/2008/08/15/capturing-text-from-under-your-mouse-cursor/
; Date:  31. August 2008
; OS: Windows 

EnableExplicit

;-Gadgets
Enumeration
  #txtValue
  #txtName
  #edValue
  #edName
  #imgCursor  
  #frmOptions
  #txtDrag
  #chkCopy
  #chkHide
  #chkAlwaysTop
EndEnumeration

;-Images
Enumeration
  #picHand
  #picNo
EndEnumeration

;-Prototypes
Prototype.l ProtoAccessibleObjectFromPoint(x.l,y.l,*ia,*var)
Global AccessibleObjectFromPoint.ProtoAccessibleObjectFromPoint
Define hdll.l

;Applications must initialize the COM library before they can call COM library functions 
CoInitialize_(0)
hdll=OpenLibrary(#PB_Any,"Oleacc.dll")
AccessibleObjectFromPoint=GetFunction(hdll,"AccessibleObjectFromPoint")

Procedure SetWindowTopMost(hWnd.l,TopMost.l)
  Define After.l
  If Topmost : After=#HWND_TOPMOST : Else : After=#HWND_NOTOPMOST :EndIf
  SetWindowPos_( hWnd, After, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE )
EndProcedure

Procedure TextFromWindowPosition(*Name.String, *Value.String)  
  Define CursorPos.point,vt.VARIANT,*pIAcc.IAccessible,pName.l,len.l
  GetCursorPos_(@CursorPos) 
  If AccessibleObjectFromPoint(CursorPos\x,CursorPos\y,@*pIAcc,@vt)=#S_OK
    *Name\s=""
    If *pIAcc\get_accName(vt, @pName) = #S_OK 
      len = SysStringLen_(pName)
      *Name\s = Space(len) 
      WideCharToMultiByte_(#CP_ACP, 0,pName, -1, @*Name\s, len, 0, 0)    
      SysFreeString_(pName)
    EndIf
    *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)    
      SysFreeString_(pName)
    EndIf
    *pIAcc\Release() 
  EndIf
  ProcedureReturn #True
EndProcedure  

;-Main
Define dragging.b,Btn.l,ev.l,hdc.l,PositionBeforeMove.Point
Define name.string,value.string,SystemPath.s
Define handcursor   = LoadCursor_(0,#IDC_HAND) 
Define normalcursor = LoadCursor_(0,#IDC_ARROW) 
Define nocursor = LoadCursor_(0,#IDC_NO) 


If OpenWindow(0, 0, 0, 540, 408, "Capture text", #PB_Window_SystemMenu | #PB_Window_ScreenCentered| #PB_Window_MinimizeGadget) And CreateGadgetList(WindowID(0)) 
  CreateGadgetList(WindowID(0))
  TextGadget(#txtName,14,14,46,16,"Name:")
  EditorGadget(#edName, 14, 30, 516, 110) 
  TextGadget(#txtValue,14,148,44,16,"Value:")
  EditorGadget(#edValue, 14, 164, 516, 160)
  CreateImage(#picHand,40,40)
  ;Image Gadgets do not properly handle directly monochrome icons. So we use an image to draw the icon
  ;see http://www.purebasic.fr/english/viewtopic.php?t=33943
  hdc=StartDrawing(ImageOutput(#picHand))
    Box(0,0,40,40,GetSysColor_(#COLOR_3DFACE))
    DrawImage (handcursor,0,0)
  StopDrawing()
  CreateImage(#picNo,40,40)
  hdc=StartDrawing(ImageOutput(#picNo))
    Box(0,0,40,40,GetSysColor_(#COLOR_3DFACE))
    DrawImage (nocursor,0,0)
  StopDrawing()
  ImageGadget(#imgCursor,140,334,40,40,ImageID(#picHand))
  TextGadget(#txtDrag,54,346,80,40,"Drag me around:")
  Frame3DGadget(#frmOptions,38,324,460,76,"")
  CheckBoxGadget(#chkCopy,240,336,240,20,"&Copy to clipboard on mouse up")
  CheckBoxGadget(#chkHide,240,356,240,20,"Hide window on drag")
  CheckBoxGadget(#chkAlwaysTop,240,376,240,20,"Always on top")
  ;Set the icon for the window using one of the standard icons
  SystemPath=Space(255) 
  GetSystemDirectory_(SystemPath,255) 
  SendMessage_(WindowID(0),#WM_SETICON,#False,ExtractIcon_(0,SystemPath+"\shell32.dll",73))
;--Main loop
  Repeat 
  Ev = WaitWindowEvent() 
    Select Ev
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case #imgCursor
            If EventType()=#PB_EventType_LeftClick 
              SetCapture_(WindowID(0))
              SetCursor_(handcursor)
              SetGadgetState(#imgCursor,ImageID(#picNo))
              dragging=#True
              If GetGadgetState(#chkHide) 
                PositionBeforeMove\x=WindowX(0)
                PositionBeforeMove\y=WindowY(0)
                ExamineDesktops()
                ResizeWindow(0,DesktopWidth(0),DesktopHeight(0),#PB_Ignore ,#PB_Ignore )
              EndIf
            EndIf
          Case #chkAlwaysTop
            SetWindowTopMost(WindowID(0),GetGadgetState(#chkAlwaysTop))
        EndSelect
      Case #WM_MOUSEMOVE 
        If dragging=#True
          TextFromWindowPosition(@name,@value)
          SetGadgetText(#edName,name\s )
          SetGadgetText(#edValue,value\s)
        EndIf
      Case  #WM_LBUTTONUP 
        If dragging=#True
          ReleaseCapture_()
          SetCursor_(normalcursor)
          SetGadgetState(#imgCursor,ImageID(#picHand))
          dragging=#False
          If GetGadgetState(#chkCopy)
            SetClipboardText(name\s + #CRLF$ + value\s)
          EndIf
        EndIf
        If GetGadgetState(#chkHide) 
          ResizeWindow(0,PositionBeforeMove\x,PositionBeforeMove\y,#PB_Ignore ,#PB_Ignore )
        EndIf      
    EndSelect
  Until Ev = #PB_Event_CloseWindow 
EndIf
CoUninitialize_() 
CloseLibrary(hdll) 

Code: Select all

x = DesktopMouseX()
y = DesktopMouseY()
pos.q = y<<32 + x
hWnd = WindowFromPoint_(pos)

Code: Select all

DrawImage (handcursor,0,0)

Code: Select all

DrawIconEx_(hdc, 0,0, handcursor, 0,0,0,0,#DI_NORMAL)

Code: Select all

DrawImage (nocursor,0,0)

Code: Select all

DrawIconEx_(hdc, 0,0, nocursor, 0,0,0,0,#DI_NORMAL)