ObjectFromLresult 응용한 웹페이에서 오른쪽 버튼 사용 가능하게 하기

이전의 ObjectFromLresult 함수의 응용입니다. 이전 내용은 단순히 해당 페이지의 웹소스만 얻어왔읍니다.
이번에는 얻어온 개체 HTMLDocument를 활용하여 해당 웹페이지에서 오른쪽 버튼이 사용 가능하도록 해보겠읍니다.
대부부의 소스는 이전의 ObjectFromLresult 와 같으며, 마지막의 2개의 프로시저의 소스만 다릅니다.

웹페이지에서 오른쪽 버튼을 눌르면 다음과 흡사한 팝업메뉴(컨텍스트 메뉴)가 표시됩니다.

웹문서에서 오른쪽 버튼을 누르지 못하게 한 경우는 위와 같은 메뉴가 표시되지 않습니다. 이런 웹 페이지에서 오른쪽 버튼을 눌르면 팝업메뉴가 표시되도록, 각 웹페이지의 이벤트 발생시 처리되는 속성을 제거해 봤읍니다. 이런 식으로 했는되도 않된다면 다른 속성이나, 태그 개체의 이벤트에 설정된 것이 아닌가.

다음은 예의 초기 윈도우 입니다.

원모양을 드레그 하여 웹페이지를 찾으시면 됩니다.
예로 http://www.thiat.com/ 페이지는 오른쪽 버튼이 눌리면 팝업 메뉴가 표시되지 않습니다. 소스를 사용하셔서 실행해보시길.

소습니다.
Option Explicit ' 모든 변수는 선언된 뒤에 사용할 수 있다.

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long ' 현재 커서의 위치를 얻는다.
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long ' 현재 윈도우의 부모 윈도우 핸들을 얻는다.
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long ' 윈도우의 사각형 좌표를 얻는다.
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long ' 사각형 영역을 생성한다.
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long ' 사각형 영역을 합친다.
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long ' 사각형 영역을 윈도우에 적용한다.
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long ' 포인터 아래의 윈도우의 핸들을 얻는다.
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long ' 윈도우를 위치,크기등을 변경
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long ' 위도우의  z순서를 정한다.
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long ' 부모 윈도우를 변경시킨다.
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As GUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long

Private Type GUID
  Data1         As Long
  Data2         As Integer
  Data3         As Integer
  Data4(0 To 7) As Byte
End Type

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Const MIIM_BITMAP = &H80 ' hbmpItem 멤버
Private Const MIIM_CHECKMARKS = &H8 ' hbmpChecked,hbmpUnchecked 멤버
Private Const MIIM_DATA = &H20 ' dwItemData 멤버
Private Const MIIM_FTYPE = &H100 ' fType 멤버
Private Const MIIM_ID = &H2 ' wID 멤버
Private Const MIIM_STATE = &H1 ' fState 멤버
Private Const MIIM_STRING = &H40 ' dwTypeData 멤버
Private Const MIIM_SUBMENU = &H4 ' hSubMenu 멤버
Private Const MIIM_TYPE = &H10 ' fType, dwTypeData 멤버

Private Const MF_SEPARATOR = &H800& ' 분리선
Private Const MFT_SEPARATOR = MF_SEPARATOR ' 분리선

Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const RGN_DIFF = 4

' Image Key. 이미지 키
Private Const IK_GetWindow As String = "Window" ' 윈도우를 찾을 경우의 픽처박스
Private Const IK_Point As String = "Point" ' 윈도우를 찾을 경우 마우스 커서 포인터
Private Const IK_NotDo As String = "WindowPoint" ' 윈도우를 찾지 않을  경우의 픽처박스
Private Const BufferLength As Long = 128 ' 버퍼의 길이

Private Const WM_HTML_GETOBJECT = "WM_HTML_GETOBJECT"

Private SignWindowHwnd As Long ' 포인터 아래의 윈도우를 표시하기 위한 픽처박스 핸들
Private BeforeHwnd As Long ' 이전(이 함수가 호출되기 한단계 전의 함수 호출시) 윈도우 핸들

' 픽처 박스의 크기를 해당 윈도우에 맞게 조정한다.
Private Sub WindowSign()
    Dim MousePoint As POINTAPI ' 마우스의 위치
    Dim Windowhwnd As Long ' 마우스 위치의 윈도우 핸들
    Dim WindowPosition As RECT ' 마우스 아래에 있는 위도우의 위치를 나타낸다.
    Dim rgnPic As Long ' 픽처박스에 표식을 제외한 부분 사각형 영역
    Dim rgnSign As Long ' 표식을 나타내는 도형이 표시되는 사각형 영역
    Dim Sha1Width As Long ' 외부 도형의 폭
    Dim Sha2Width As Long ' 내부 도형의 폭
    Dim Sha1Height As Long ' 외부 도형의 높이
    Dim Sha2Height As Long ' 내부 도형의 높이

    Call GetCursorPos(MousePoint) ' 현재 마우스의 위치를 얻는다(픽셀)
    Windowhwnd = WindowFromPoint(MousePoint.x, MousePoint.y) ' 현재 마우스 위치의 상위 윈도우의 핸들을 얻는다.
    If Not CBool(Windowhwnd) Then Exit Sub ' 윈도우 핸들을 얻지 못하였다면
    If BeforeHwnd = Windowhwnd Then Exit Sub ' 이전의 윈도우 핸들과 같다면
    BeforeHwnd = Windowhwnd ' 포인터 아래의 윈도우 핸들을 백업하여 둔다.(다음 호출시 비교하기 위함)
    Call GetWindowRect(Windowhwnd, WindowPosition) ' 마우스 아래에 있는 윈도우의 크기와,위치를 얻는다.
    With WindowPosition
        Sha1Width = .Right - .Left ' 도형의 폭과 높이 계산
        Sha2Width = Sha1Width - 2
        Sha1Height = .Bottom - .Top
        Sha2Height = Sha1Height - 2
        MoveWindow SignWindowHwnd, .Left, .Top, Sha1Width, Sha1Height, True ' 표식을 하는 윈도우의 크기를, 마우스 아래의 윈도우 크기로 한다.
        Call SetWindowPos(SignWindowHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) ' 그 픽처박스를 최상위 폼으로 한다.(표식이 된 윈도우가 이동된 후에 다시 그 윈도우를 지정하개 되면, 표식 픽처 박스가 최상위가 않되는 상황이 발생하기 때문에 이를 방지)
        ' ※ left와 top가 -값을 갖는 경우가 있다.
    End With
    picShape1.Width = Sha1Width ' 해당 윈도우 표시를 위한 외부 사각형
    picShape1.Height = Sha1Height
    picShape2.Width = Sha2Width ' 해당 윈도우 표시를 위한 내부 사각형
    picShape2.Height = Sha2Height
    rgnPic = CreateRectRgn(2, 2, Sha2Width, Sha2Height) ' 도형을 제외한 사각형 영역, 투명하게 할 사각형 영역을 생성
    rgnSign = CreateRectRgn(0, 0, Sha1Width, Sha1Height) ' 픽처박스 전체 크기의 사격형 영역을 생성
    CombineRgn rgnPic, rgnSign, rgnPic, RGN_DIFF ' 픽처 박스 사각형 영역에서, 투명 부분의 사각형을 뺀 사각형 영역을 만든다.
    SetWindowRgn SignWindowHwnd, rgnPic, True ' 그 사각형 영역을 픽처 박스에 적용시킨다. 따라서 표식 부분을 제외한 부분은 투명이 된다.
End Sub

' 메모리이 이 폼이 로드되는 경우 발생
Private Sub Form_Load()
    picWindowMark.ScaleMode = vbPixels ' 픽처박스의 스케일모드를 픽셀단위로 바꾼다
    picWindowMark.Visible = False
    picShape1.Left = 0 ' 표식 외부 사각형 왼쪽 상단 위치 초기화
    picShape1.Top = 0
    picShape2.Left = 1 ' 표식 내부 사각형 왼쪽 상단 위치 초기화
    picShape2.Top = 1
    SignWindowHwnd = picWindowMark.hwnd ' 포인트 아래의 윈도우를 표시하기 위한 핸들
    Call SetParent(SignWindowHwnd, 0) ' 현재 윈도우의 외곽선을 그릴 픽처박스를 바탕화면의 하위로 폼으로 만든다.(따라서 픽처박스가 바탕화면에서 자유자재로 움직일수 있다)
    Set picPointer.Picture = imlList.ListImages(IK_NotDo).Picture ' 윈도 찾기 위한 픽처 박스의 기본 이미지 설정
    Set Screen.MouseIcon = imlList.ListImages(IK_Point).Picture ' 윈도우를 찾는 경우 포인터의 아이콘 이미지 설정
End Sub

' 메모리에서 이 폼에 제거되는 경우 발생
Private Sub Form_Unload(Cancel As Integer)
    Call SetParent(picWindowMark.hwnd, Me.hwnd) ' 외곽선을 표시할 픽처박스의 부모 윈도우를 원래 상태로 되돌린다.
End Sub

Private Sub picPointer_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        Set picPointer.Picture = imlList.ListImages(IK_GetWindow).Picture
        Screen.MousePointer = vbCustom
        picWindowMark.Visible = True
    End If
End Sub

Private Sub picPointer_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        Call WindowSign ' 픽처박스의 크기를 해당 윈도우 맞게 크기를 조정한다.
    End If
End Sub

Private Sub picPointer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton And Shift = 0 Then
        Set picPointer.Picture = imlList.ListImages(IK_NotDo).Picture
        Screen.MousePointer = vbNormal
        picWindowMark.Visible = False
        EnableMouseLeftButton BeforeHwnd ' 윈도우에 따른 HTML 소스를 얻는다.
    End If
End Sub

Private Sub EnableMouseLeftButton(Whwnd As Long) ' 윈도우 핸들에 의한 웹소스를 얻는다.
    Dim ClassName As String
   
    ClassName = String(100, " ")
    GetClassName Whwnd, ClassName, 100
    If Not InStr(1, ClassName, "Internet Explorer_Server") = 1 Then Exit Sub
    Call SetNull(GetHtmlDocFromHwnd(Whwnd))
End Sub

Private Function GetHtmlDocFromHwnd(ByVal hwnd As Long) As IHTMLDocument2 ' 웹문서 얻기
    Dim ID     As GUID
    Dim lngReg As Long
    Dim lngHnD As Long

    lngHnD = RegisterWindowMessage(WM_HTML_GETOBJECT)
    Call SendMessageTimeout(hwnd, lngHnD, 0, 0, &H2, 1000, lngReg)
    Call ObjectFromLresult(lngReg, ID, 0, GetHtmlDocFromHwnd)
End Function

Private Sub SetNull(WebDoc As MSHTML.HTMLDocument) ' 웹문서에서 오른쪽  버튼이 가능하도록 오른쪽 버튼 관련 이벤트를 제거한다.
    Dim FrameLength As Long
    Dim ForCounter As Long
   
    With WebDoc
        .oncontextmenu = Null
        .onselectstart = Null
        .ondragstart = Null
        .onkeydown = Null
        .onmousedown = Null
        With .body
            .oncontextmenu = Null
            .onselectstart = Null
            .ondragstart = Null
            .onkeydown = Null
            .onmousedown = Null
        End With
        FrameLength = .frames.length
        If FrameLength > 0 Then
        On Error Resume Next
            For ForCounter = 0 To FrameLength - 1
                SetNull .frames(ForCounter).document
            Next ForCounter
        On Error GoTo 0
        End If
    End With
End Sub