정보더미

이미지 컨트롤에는 DC가  없다. 그래서 대부분 픽처박스를 사용하는대, 대신 픽처박스를 사용하기 위해서는 많은 양의 리소스가 필요하다. 그러면 이미지 컨트롤에 대한 DC는 얻을수 없지만, 이미지 컨트롤의 picture 속성에 지정된 이미지에 대한 DC를 생성할수 있다. 이 DC를 활용하면 픽처박스에 사용하는 DC와 같은 효과를 낼수 있다. 그러면 리소스 사용을 줄일수 있다.

다음 소스의 초기 화면이다.

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hdcDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020

Public Function CreateDC(sPic As StdPicture) As Long ' 이미지에 대한 DC 생성
   Dim hdcPicture As Long

   hdcPicture = CreateCompatibleDC(ByVal 0&)
   SelectObject hdcPicture, sPic.Handle
   CreateDC = hdcPicture
End Function

Private Sub Command1_Click()
    Dim hdc As Long
   
    Picture1.ScaleMode = vbPixels
    hdc = CreateDC(Image1.Picture) ' 이미지에 대한 DC를 생성한다
    With Picture1
        BitBlt .hdc, 0, 0, .ScaleWidth, .ScaleHeight, hdc, 0, 0, SRCCOPY ' 이미지 복사
    End With
    DeleteDC hdc
End Sub

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

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

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

예제 초기 화면입니다.

원형 이미지로 마우스로 드래그 하여 웹문서 포함하는 윈도우를 지정하면 해당 윈도우의 소스를 얻어옵니다.

요즘은 응용프로그램 내에 웹페이지를 표시하는 윈도우를 포함하는 경우가 많습니다. 그럴때 사용하면 유용합니다.

소스는 다음과 같습니다.
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
        GetHTMLSource BeforeHwnd ' 윈도우에 따른 HTML 소스를 얻는다.
    End If
End Sub

Private Sub GetHTMLSource(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
    txtHTML.Text = GetHtmlDocFromHwnd(Whwnd).documentElement.innerHTML
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

이전의 WindowFromPoint 함수의 소스와 8~90% 소스는 일치합니다. 여기서는 마지막 부분의 GetHtmlDocFromHwnd 함수 프로시저가 중요한 부분입니다.

소스는 다음과 같습니다.
' 마우스 아래 윈도우 찾기
' 메뉴를 찾아 메뉴 목록을 트리에 지정한다.
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 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 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
    End If
End Sub

주석에도 있듯이 WindowFromPoint만으로는 정확한 윈도우를 찾기 힘듭니다.

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As Any, ByVal cbData As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const ERROR_SUCCESS = 0
Private Const KEY_ALL_ACCESS = &HF003F
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const REG_SZ = 1

Private Enum ButtonType
    BT_Creadte ' 생성,쓰기
    BT_Read ' 읽기
    BT_Remove ' 삭제
End Enum

Private Sub Form_Load()
    AddItemToCombo "HKEY_CLASSES_ROOT", HKEY_CLASSES_ROOT
    AddItemToCombo "HKEY_CURRENT_USER", HKEY_CURRENT_USER
    AddItemToCombo "HKEY_LOCAL_MACHINE", HKEY_LOCAL_MACHINE
    AddItemToCombo "HKEY_USERS", HKEY_USERS
    AddItemToCombo "HKEY_CURRENT_CONFIG", HKEY_CURRENT_CONFIG
    cmbRootKey.Text = "HKEY_LOCAL_MACHINE"
    txtPath.Text = "Software\Microsoft\Windows\CurrentVersion\Run\Test"
    txtValueName.Text = "Test"
    txtValue.Text = "Test"
End Sub

Private Sub AddItemToCombo(ByVal Str As String, ByVal Val As Long) ' 콤보박스에 아이템을 추가한다.
    With cmbRootKey
        .AddItem Str
        .ItemData(.ListCount - 1) = Val
    End With
End Sub

Private Sub cmdResitry_Click(Index As Integer) ' 생성,읽기,쓰기,제거 버튼 클릭시
    Dim Result As Long ' 반환값
    Dim RetVal As Long ' 오픈된 키의 핸들

    RetVal = RegOpenKeyEx(cmbRootKey.ItemData(cmbRootKey.ListIndex), txtPath.Text, 0, KEY_ALL_ACCESS, Result) ' 레지스트리 키를 오픈한다.
    If Not RetVal = ERROR_SUCCESS Then ' 열기 실패,존재하지 않는 키라면
        Select Case Index
            Case BT_Creadte ' 생성,쓰기
                RetVal = RegCreateKeyEx(cmbRootKey.ItemData(cmbRootKey.ListIndex), txtPath.Text, 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, Result, REG_CREATED_NEW_KEY)
            Case BT_Read, BT_Remove ' 읽기,삭제
                MsgBox "존재하지 않는 키입니다."
                Exit Sub
        End Select
    End If
    Select Case Index
        Case BT_Creadte ' 생성,쓰기
            RetVal = RegSetValueEx(Result, txtValueName, 0&, REG_SZ, txtValue.Text, CLng(Len(txtValue.Text) + 1))
        Case BT_Read ' 읽기
            Dim ReadDataType As Long
            Dim ReadData As String
            Dim ReadDataLen As Long
           
            RetVal = RegQueryValueEx(Result, txtValueName.Text, 0&, ReadDataType, 0&, ReadDataLen)
            If Not ReadDataLen = 0 Then
                ReadData = String(100, " ")
                ReadDataLen = 100
                RetVal = RegQueryValueEx(Result, txtValueName.Text, 0&, 0&, ByVal ReadData, ReadDataLen)
                txtValue.Text = Left(ReadData, InStr(1, ReadData, Chr(0)) - 1)
            End If
        Case BT_Remove ' 삭제
            If txtValueName.Text = vbNullString Then ' 값명이 지정되지 않았다면
                RetVal = RegDeleteKey(Result, vbNullString)
            Else ' 값명이 지정되었다면
                RetVal = RegDeleteValue(Result, txtValueName.Text)
            End If
    End Select
    RetVal = RegCloseKey(Result) ' 레지스트리 키를 닫는다
End Sub

초기 이미지며, 이 예제에서는 작업관리자 윈도우를 찾아서, 작업 관리자에 해당하는 프로세스를 종료시키다.
작업관리자 대신 다른 윈도우를 찾는 코드를 변경시키면 다른 프로세스를 종료시킬수 있다.

소스이다.
' 지정된 윈도우를 찾아, 찾은 윈도우에 해당하는 프로세스를 종료시킨다.
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const PROCESS_TERMINATE = 1

Private Sub Command1_Click() ' 종료 버튼 클릭
    timFindProcess.Enabled = False
    Unload Me
End Sub

Private Sub timFindProcess_Timer()
    Dim WinHnd As Long ' 윈도우 핸들
   
    WinHnd = CheckWindow
    If Not CBool(WinHnd) Then Exit Sub
    ProcessKill WinHnd
End Sub

Private Function CheckWindow() As Long ' 윈두우를 찾는다.
    CheckWindow = FindWindow(vbNullString, "Windows 작업 관리자") '작업관리자의 윈도우 네임
End Function

Private Sub ProcessKill(ByVal Wnd As Long) ' 윈도우에 해당하는 프로세스를 종료시킨다.
    Dim PID As Long
   
    GetWindowThreadProcessId Wnd, PID
    KillProcessById PID
End Sub

Private Sub KillProcessById(ByVal p_lngProcessId As Long) ' 윈도우에 해당하는 프로세스를 강제 종료시킨다.
  Dim lnghProcess As Long
  Dim lngReturn As Long
 
  lnghProcess = OpenProcess(PROCESS_TERMINATE, False, p_lngProcessId)
  lngReturn = TerminateProcess(lnghProcess, 0&)
End Sub

초기 화면입니다.

' 인터넷 바로가기인 url 파일 만들기
Option Explicit

Private Const CSIDL_FAVORITES = &H6     '즐겨찾기
Private Const CSIDL_STARTMENU = &HB     '시작메뉴
Private Const CSIDL_DESKTOPDIRECTORY = &H10 '바탕화면
Private Const S_OK = 0 ' 성공

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal PIDL As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, PIDL As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Private Enum CSIDLSelectNumber
    CSIDLSN_DeskTop = 0 ' 바탕화면
    CSIDLSN_Favorite ' 즐겨찾기
    CSIDLSN_StartMenu ' 시작메뉴
    CSIDLSN_QuiceMenu ' 빠른실행
End Enum

Private Sub cmdPosition_Click(Index As Integer)
    Dim SaveFolder As String ' 인터넷 바로가기 파일을 생성할 폴더
    Dim fso As Scripting.FileSystemObject
    Dim URLFile As Scripting.TextStream
   
    Select Case Index
        Case CSIDLSN_QuiceMenu
            SaveFolder = Environ("homedrive") & Environ("homepath") & "\" & "Application Data\Microsoft\Internet Explorer\Quick Launch"
        Case Else
            SaveFolder = GetSpecialPath(Switch(Index = CSIDLSN_DeskTop, CSIDL_DESKTOPDIRECTORY, Index = CSIDLSN_Favorite, CSIDL_FAVORITES, Index = CSIDLSN_StartMenu, CSIDL_STARTMENU))
    End Select
    Debug.Print SaveFolder
    SaveFolder = SaveFolder & "\"
    Set fso = New Scripting.FileSystemObject
    Set URLFile = fso.CreateTextFile(SaveFolder & "Test.URL", True)
    With URLFile
        .WriteLine ("[InternetShortcut]")
        .WriteLine ("URL=" & txtURL.Text)
        .Close
    End With
    MsgBox "인터넷 바로가기를 생성했읍니다."
End Sub

Private Function GetSpecialPath(CSIDL As Long) As String ' 지정된 경로를 얻는다
    Dim RValue As Long ' 반환값
    Dim PIDL As Long ' 경로
    Dim Path As String ' 버퍼

    GetSpecialPath = vbNullString
    If SHGetSpecialFolderLocation(0, CSIDL, PIDL) = S_OK Then
        Path = Space$(512)
        RValue = SHGetPathFromIDList(PIDL, ByVal Path)
        GetSpecialPath = Left$(Path, InStr(Path, vbNullChar) - 1)
        CoTaskMemFree PIDL
    End If
End Function

인터넷 바로가기 파일(*.url)의 형식은 다음 링크를 참조하세요 : 인터넷 바로가기인 URL 파일의 형식

 
인터넷 바로가기 파일 만들기 소스 : SHGetSpecialFolderLocation 용한 터넷 바로가기(*.url) 파일 생성

이미지 출처 및 관련 내용 링크 : http://www.cyanwerks.com/file-format-url.html
 

유니코드의 한글은 &hAC00부터 시작하며 초성은 19자, 중성은 21자, 종성은 28자로 이루어저있으면 종성의 첫자는 종성이 없음을 나타냅니다.
그러면 유니코드는 어떤식으로 어떤식으로 생성이되냐면 초성,중성,종성을 각 구성된 자리 수 만큼 곱한 값을 더한 값이니다. 여기에 유니코드 한글 시작값 &hAC00을 더한 값이 유니코드가 됩니다.
이런 형태입니다. 우리가 10시 20분 17초를 초로 환산하면 (10*60 * 60) + (20 * 60) + 17 계산을 하면 37217초라는 값이 나옵니다.
이와 같은 형태로 초성에는 21*28을 곱한 값을 중성에는 28을 곱한 값을 나머지 종성 값을 더한후에 &HAC00을 더하게 되면 유니코드 값이됩니다. 반대로 유니코드를 초성,중성,종성으로 분리 하기 위해서는 먼저 &HAC00를 뺀 갑에서 21*28로 나누눈 값이 초성이 될거이고 나머지 값에서 28로 나눈 값이 중성이고, 그 나머지 값이 종성이 됩니다.

다음은 소스의 초기 화면입니다

Private FirstChar(18) As String ' 초성 테이블 19자
Private MiddleChar(20) As String ' 중성 테이블 21자
Private EndChar(27) As String ' 종성 테이블 28자

Private Sub Form_Load()
    CreateCopyTable Array("ㄱ", "ㄲ", "ㄴ", "ㄷ", "ㄸ", "ㄹ", "ㅁ", "ㅂ", "ㅃ", "ㅅ", "ㅆ", "ㅇ", "ㅈ", "ㅉ", "ㅊ", "ㅋ", "ㅌ", "ㅍ", "ㅎ"), FirstChar
    CreateCopyTable Array("ㅏ", "ㅐ", "ㅑ", "ㅒ", "ㅓ", "ㅔ", "ㅕ", "ㅖ", "ㅗ", "ㅘ", "ㅙ", "ㅚ", "ㅛ", "ㅜ", "ㅝ", "ㅞ", "ㅟ", "ㅠ", "ㅡ", "ㅢ", "ㅣ"), MiddleChar
    CreateCopyTable Array(vbNullString, "ㄱ", "ㄲ", "ㄳ", "ㄴ", "ㄵ", "ㄶ", "ㄷ", "ㄹ", "ㄺ", "ㄻ", "ㄼ", "ㄽ", "ㄾ", "ㄿ", "ㅀ", "ㅁ", "ㅂ", "ㅄ", "ㅅ", "ㅆ", "ㅇ", "ㅈ", "ㅊ", "ㅋ", "ㅌ", "ㅍ", "ㅎ"), EndChar
End Sub

Private Sub txtInputChar_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim FirstCharCode As Long
    Dim MiddleCharCode As Long
    Dim EndCharCode As Long

    If Not KeyCode = vbKeyReturn Then Exit Sub
    If Not Len(txtInputChar) = 1 Then Exit Sub
    If SplitHangul(AscW(Left(txtInputChar.Text, 1)), FirstCharCode, MiddleCharCode, EndCharCode) Then
        labFirstChar.Caption = FirstChar(FirstCharCode)
        labMiddleChar.Caption = MiddleChar(MiddleCharCode)
        labLastChar.Caption = EndChar(EndCharCode)
    Else
        MsgBox "한글 문자가 아닙니다"
    End If
End Sub

Private Sub CreateCopyTable(Sou As Variant, Des() As String) ' Variant 테이블을 스트링 테이블에 복사
    Dim ForCount As Long
    Dim EndCount As Long
   
    EndCount = UBound(Sou)
    For ForCount = 0 To EndCount
        Des(ForCount) = Sou(ForCount)
    Next ForCount
End Sub

Private Function SplitHangul(InCode As Integer, first As Long, middle As Long, last As Long) As Boolean ' 한글의 초중종성 분리
    Dim Code As Long

    SplitHangul = False
    Code = InCode
    Select Case Sgn(InCode)
        Case -1 ' 음수
            If InCode < &HAC00 Then Exit Function
        Case 1, 0 '양수
            Exit Function
    End Select
    Code = Code - &HAC00
    first = Int(Code / (21 * 28))  ' 초성을 분리합니다.
    Code = Code Mod (21 * 28) ' 전체 코드에서 초성을 떼어내고 중성과 종성을 남깁니다.
    middle = Int(Code / 28) '중성을 분리합니다.
    last = Code Mod 28 ' 중성을 떼어내고 종성을 남깁니다.
    SplitHangul = True
End Function

다음 링크는 윈도우에서 한글을 사용하게 되는 경우 코드 페이지 949의 코드 문자표 링크입니다.
http://msdn.microsoft.com/en-us/goglobal/cc305154

초기 이미지는 다음과 같습니다. URL 텍스트 박스에 URL을 입력하고 엔터를 입력하면, 그 URL에 대한 응답 결과를 표시합니다.

소스입니다.
Option Explicit

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As Long, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const BUFFER_LEN = 256

Private Function GetUrlSource(sURL As String) As String
    Dim lReturn As Long ' 읽은 데이타의 바이트 수
    Dim hSession As Long ' WinINet 핸들
    Dim hInternet As Long ' URL을 오픈한 핸들
    Dim iResult As Long  ' 결과
    Dim sBuffer ' 읽은 데이타가 저장되는 버퍼
   
    sBuffer = String(BUFFER_LEN, " ") ' 버퍼 영역 지정
    hSession = InternetOpen("vb wininet", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) ' WinINet 핸들을 얻는다
    If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0) ' URL을 오픈한다.
    If hInternet Then
        iResult = InternetReadFile(hInternet, StrPtr(sBuffer), BUFFER_LEN, lReturn)
        GetUrlSource = MidB(sBuffer, 1, lReturn)
        Do While lReturn <> 0
            iResult = InternetReadFile(hInternet, StrPtr(sBuffer), BUFFER_LEN, lReturn)
            GetUrlSource = GetUrlSource & MidB(sBuffer, 1, lReturn)
        Loop
    End If
    GetUrlSource = StrConv(GetUrlSource, vbUnicode)
    iResult = InternetCloseHandle(hInternet)
    iResult = InternetCloseHandle(hSession)
End Function

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not KeyCode = vbKeyReturn Then Exit Sub
    Text2.Text = GetUrlSource(Text1.Text)
End Sub

여기 보시면 Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As Long, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Boolean 에서 버퍼를 String로 하지 않고 Long로 표시한 이유는 VB에서 API를 사용하는 경우 String 형을 사용하게 되면 호출시 String에 저장된 무자를 유니코드로 간주 ANSI코드로 변경하고,
반환시는 거꾸로 String 형을 ANSI코드로 간주하고 유니코드로 변경하게 됩니다.
 만약 2바이트가 하나의 문자가 되는 데이터가 잘려서 저장이 되었다면 이상한 문자로 변환될수도 있읍니다. 그러면 URL에서 응답한 내용과, 저장된 내용이 다를수가 있읍니다. 그래서 URL에서 응답한 내용을 그대로 보존하기 위해 Long을 사용했읍니다. 이때는
strptr 함수를 사용해서 버퍼 문자열의 주소를 넘겨 주면 됩니다.

나머지 내용에는 별다른 특별한 내용은 없습니다.

WinInet API를 사용한다.
소스
' FTP에서 지정된 디렉토리나 파일 유무를 확인한다.
Option Explicit

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Private Sub Command1_Click()
    Text2.Text = GetUrlSource(Combo1.Text)
    MousePointer = vbDefault
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not KeyCode = vbKeyReturn Then Exit Sub
    If Not Len(Text1.Text) > 0 Then Exit Sub
    MsgBox "URL(파일)이 존재" & IIf(CheckURL(Text1.Text), "합니다.", "하지 않습니다.") ' URL 존재 유무 검사
End Sub

Private Function CheckURL(sURL As String) As Boolean
    Dim hInternet As Long ' 오픈한 URL 핸들
    Dim hSession As Long ' WinInet 핸들
    Dim lReturn As Long ' 반환값
   
    CheckURL = False
    hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0) ' WinInet을 사용하기 위해 초기화 한여, WinInet 핸들들 얻는다.
    If Not CBool(hSession) Then Exit Function ' WinInet 초기화 하지 못한 경우
    hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0) ' URL 확인
    If Not CBool(hInternet) Then
        lReturn = InternetCloseHandle(hSession) ' WinInet 핸들 닫기
        Exit Function
    End If
    CheckURL = True
    lReturn = InternetCloseHandle(hInternet)
    lReturn = InternetCloseHandle(hSession) ' WinInet 핸들 닫기
End Function

실행하면 다음과 같은 창이 뜹니다.

키보드는 눌려지거나 떼어졌을 때 컴퓨터로 눌려지거나 떼어진 키 번호를 보낸다. 이 키 번호를 스캔코드(scan code)라고 한다.
그러나 scan code는 키보드 종류에 따라 다르다. 따라서 윈도우즈는 응용 프로그램 제작자들의 편의를 위해 이 스캔 코드를 가상키(virtual key)로 바꾸어준다.

MapVirtualKey API를 사용하면 가상키 값과 스캔코드 값에 대한 서로 대응 되는 값을 얻을수 있다.

다음 예는 스캔 코드 값을 상호 변환하는 예이다.
초기 화면 폼이다.

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const MAPVK_VK_TO_VSC = 0
Private Const MAPVK_VSC_TO_VK_EX = 3

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) ' 가상키값을 스캔코드 값으로
    If Not ValueCheck(Text1.Text, KeyCode) Then Exit Sub
    Text2.Text = Hex(MapVirtualKey(CLng("&h" & Text1.Text), MAPVK_VK_TO_VSC))
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer) ' 스캔 코드값을 가상키값으로
    If Not ValueCheck(Text2.Text, KeyCode) Then Exit Sub
    Text1.Text = Hex(MapVirtualKey(CLng("&h" & Text2.Text), MAPVK_VSC_TO_VK_EX))
End Sub

Private Function ValueCheck(KeyValue As String, ByVal KeyCode As Long) As Boolean
    ValueCheck = False
    If Not KeyCode = vbKeyReturn Then Exit Function
    If Len(KeyValue) = 0 Then Exit Function
    If CLng("&h" & Text1.Text) = 0 Then Exit Function
    ValueCheck = True
End Function

키보드 관련 윈도우 메세지와, API 함수들 대부분은 가상키값이 사용된다.

다은 링크는 한글 코드 페이지(949)의 문자 코드표 입니다. http://msdn.microsoft.com/en-us/goglobal/cc305154

VB에서 기본 컨트롤들은 ANSI 문자 코드만 지원합니다. 유니코드 문자코드는 지원하지 않습니다.
무슨 말이냐면 기본 컨트롤들에 유니코드 문자열(VB 문자열)을 지정하면 ANSI 문자열로 변환한 후에 사용합니다. 만약 변환될수 없는 문자가 포함되어 있다면 그 문자는 ?로 표시됩니다. 그러나 Microsoft Forms 2.0 Object Library 컨트롤을 추가하면 여기에 포함된 컨트롤들은 유니코드를 지원합니다. 유니코드 문자열을 지정해주면 유니코드 문자코드에 맞는 문자를 표시합니다.
현재 시스템에서 사용하는 문자코드로 표시할수 없는 문자들이라면 위의 함수들을 사용해서 코드로 값을 넣어주시면 됩니다.
갂이라는 문자를 지정한다고 하면 갂에 해당하는 문자 코드 AC02를 ChrW(&hAC02) 처럼 사용해서 문자를 생성해 낼수 있읍니다.

추가로 한글과컴퓨터의 한글에서 특수문자를 입력하고 그에 대한 코드를 알아보기 위해서는 한글 문서를 워드로 저장하고,
워드에서 문서를 열고 특수문자를 선택하면 상단에 글꼴 종류를 알수 있으며, 워드 문서를 다시 웹문서로 저장한 다음,
웹문서를 택스트 파일로 열어보면  &#코드 형식으로 특수문자에 해당하는 유니코드를 알수 있읍니다.

다음 예제는 일반 텍스트 박스와 유니코드를 지원하는 텍스트 박스에서 하나의 유니코드 문자를 표시해본 예이다.
Option Explicit

Private Sub Form_Load()
    Dim Code As Long
   
    Code = &H21B3 ' 문자에 대한 유니코드
    Text1.Font.Name = "MS Mincho"
    TextBox1.Font.Name = "MS Mincho"
    Text1.Font.Size = 71
    TextBox1.Font.Size = 71
    Text1.Text = Chr(Asc(ChrW(Code))) ' Chr에 인수는 ANSI 문자 코드라고 간주한다. 따라서 유니코드를 ANSI코로 바꾸기 위해 ChrW와 Asc를 사용했다.
    TextBox1.Text = ChrW(Code)
End Sub
결과는 다음과 같다

2 다른 방법은, 제어판에서 해당 소리를 없음으로 정해야 한다.
제어판-사운드 및 오디오 장치-소리 탭에서, 하단의 프로그램 이벤트 박스에서 슬라이더를 쭉 아래로 내리면
Window 탐색기가 보인다. 그 아래 Block Pop-up Window와 Information Bar의 소리를 없음으로 설정한다.

ADO를 사용하여 레코드셋을 생성시에는 DB의 컨넥션을 사용한다. 그런데 변경되지 않은 고정된 값만 갇는 레코드셋이라면 실행할때마다 굳이 DB에 접근할 필요는 없다. 리소스만 낭비할 뿐이나. 이럴때사용할수 있는 방법이 가상 레코드셋이다.

아래는 DB에 접근하여 레코드셋을 생성한 후에 파일로 저장하고, 컨넥션과 레코드셋을 닫은 후에, 컨넥션 없이 이전의 저장된 파일로 레코드셋만을 생성한 예이다.

' ADO 사용 우선 ADO를 사용하여 DB 컨넥션을 만들고 레코드셋을 생성한다음, 그 레코드셋을 파일로 저장한 후
' 컨넥션과 레코드셋을 닫고, 파일로부터 레코드셋을 생성한 예로 컨넥션이 없어도 레코드셋 독작적으로 유지할수 있다.
' 변경되지 않는 레코드셋이라면 DB에 연결하여 접근하는 것보다, 생성시만 DB에 접근하여 파일을 생성하고
' 그 다음부터는 파일에 접근하므로서, DB 접근에 의한 리소스를 줄일수 있다.
Option Explicit

Private Sub Command1_Click() ' 컨넥션이 있는 레코드셋 생성
    Dim cn As Connection
    Dim rs As Recordset
   
    Set cn = New Connection
    Set rs = New Recordset
    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents and Settings\LJJ\바탕 화면\새 폴더\db2.mdb;Persist Security Info=False"
    cn.Open
    rs.Open "recfile", cn
    Debug.Print rs.ActiveConnection Is Nothing
    rs.Save
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Private Sub Command2_Click() ' 컨넥션이 없는 레코드셋 생성
    Dim rs As Recordset
    Set rs = New Recordset
   
    rs.Open "recfile"
    Debug.Print rs.ActiveConnection Is Nothing
    rs.Close
    Set rs = Nothing
End Sub

Command1은 DB의 컨넥션을 사용한 레코드셋이고
Command2는 DB의 컨넥션 없이 이전의 저장된 파일에서 레코드셋이다.

기본 이미지입니다. 소스에서 사용한 컨트롤은 Farpoint Spread를 사용했읍니다. 다른 컨트롤을 사용해도 무방합니다.

Private Sub Form_Load()
    With Picture1 ' 픽처박스 크기를 대상 폼의 클라이언트 영역 크기로
        Picture1.Width = Me.ScaleWidth
        Picture1.Height = Me.ScaleHeight
        Picture1.Picture = Me.Picture
    End With
    Call SetParent(Picture1.hWnd, 0) ' 배경이 될 픽처박스를 바탕화면의 하위 폼으로 지정, 폼이 바탕화면의 어느 영역에든 이동 가능하면, 배경이되는 이미지도 바탕화면에서 이동이 가능해야 하므로
    Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED) ' 투명폼을 적용하기 위해, 레이어 스타일 윈도우를 적용시킨다
    SetLayeredWindowAttributes Me.hWnd, fpSpread1.BackColor, 0, LWA_COLORKEY
    Hook Me.hWnd ' 서브 클래싱
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetParent Picture1.hWnd, Me.hWnd ' 원상 복귀
    UnHook Me.hWnd
End Sub

다음은  일반 모듈 소스입니다.

Option Explicit

Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwflags As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) 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
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_EXSTYLE = (-20)
Private Const GWL_WNDPROC = (-4)
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_COLORKEY As Long = &H1
Private Const WM_WINDOWPOSCHANGING = &H46
Private Const WM_ACTIVATEAPP = &H1C
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOSIZE = &H1

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private GetPicturePoint As POINTAPI
Private preWinProc As Long ' 이전 윈도우 프로시저 주소

Public Sub Hook(WinHwnd As Long)
    preWinProc = SetWindowLong(WinHwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Public Sub UnHook(WinHwnd As Long)
    Call SetWindowLong(WinHwnd, GWL_WNDPROC, preWinProc)
End Sub

Public Function WndProc(ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case MSG
        Case WM_WINDOWPOSCHANGING, WM_ACTIVATEAPP
            GetPicturePoint.x = 0
            GetPicturePoint.y = 0
            ClientToScreen Form1.hWnd, GetPicturePoint
            SetWindowPos Form1.Picture1.hWnd, Form1.hWnd, GetPicturePoint.x, GetPicturePoint.y, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE ' 폼과 픽처박스가 위치하게
    End Select
    WndProc = CallWindowProc(preWinProc, hWnd, MSG, wParam, lParam)
End Function

여기서 폼이 움직일때 폼 뒤의 컨트롤이나 폼도 같이 움직일수 있도록 하기 위해서 서브 클래싱을 사용하여
WM_WINDOWPOSCHANGING 윈도우 메세지에 하단의 컨트롤(폼)도 움직이도록 반응하게 하였읍니다.

여러 상황에 대한 처리를 위한 추가적인 코드들이 필요합니다.