캐럿 생성

캐럿(Caret)이란 텍스트 박스(입력 상자)에서 입력 위치를 나타내주는 일잔적인 I자 모양을 캐럿이라고 한다.
비트맵을 로드 하여 캐럿을 생성하고, 텍스트 박스에 캐럿을 표시하는 형태이며
윈도우 활성,비활성을 알아보기 위해서 서브 클래싱을 사용했으면
WM_ACTIVATE 윈도우 메세지로, 윈두우 프로시저에서 윈도우 활성,비활성을 확인한다.

다음은 소스이다.
' 모듈 소스
Option Explicit

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 WA_INACTIVE = 0
Private Const WM_ACTIVATE = &H6

Public PreviosWindowProcedure As Long

Public Function WndProc(ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If MSG = WM_ACTIVATE And Not ((wParam & &HFFFF&) = WA_INACTIVE) Then
        Form1.TextShowCaret
    End If
    WndProc = CallWindowProc(PreviosWindowProcedure, hWnd, MSG, wParam, lParam)
End Function

'폼 소스
Option Explicit

Private Declare Function CreateCaret Lib "user32" (ByVal hWnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DestroyCaret Lib "user32" () As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Const IMAGE_BITMAP = 0
Private Const LR_LOADFROMFILE = &H10

Private BitmapID As Long ' 이미지 핸들
Private FilePath As String ' 파일 경로

Private Sub Form_Load()
    FilePath = App.Path & "\mypic.bmp"
    BitmapID = LoadImage(App.hInstance, FilePath, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
    PreviosWindowProcedure = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, PreviosWindowProcedure
    DestroyCaret
    DeleteObject BitmapID
    BitmapID = 0
End Sub

Private Sub txtCaret_Click()
    TextShowCaret
End Sub

Private Sub txtCaret_GotFocus()
    TextShowCaret
End Sub

Public Sub TextShowCaret()
    If BitmapID = 0 Then Exit Sub
    With txtCaret
        .SetFocus
        CreateCaret .hWnd, BitmapID, 0, 0
        ShowCaret .hWnd
    End With
End Sub