타이틀 바 같은 픽쳐박스(끌기기능)


	HOME \| DEVELOPERS \| CONTACT US \| SITEMAP \| E-MAIL

Home?

Reference?

Secret?

Board?

Photo?

Diary?

About Us?

▶ 타이틀 바 같은 픽쳐박스(끌기기능)

글쓴이 : 키쑤_짱^^-Y

등록일 : 2004/06/14 , IP Address : , 조회수 : 29

Option Explicit

Dim isHeaderClick As Boolean
Dim dx As Long
Dim dy As Long

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Dim p As POINTAPI
        Dim pos As Long
        pos = GetCursorPos(p)
        dx = Me.left - p.X * Screen.TwipsPerPixelX
        dy = Me.top - p.Y * Screen.TwipsPerPixelY
        isHeaderClick = True
        MouseTimer = True
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        isHeaderClick = False
    End If
End Sub

Private Sub MouseTimer_Timer()
    If Not isHeaderClick Then
        MouseTimer.Enabled = False
        Exit Sub
    End If

    Dim p As POINTAPI
    Dim pos As Long
    pos = GetCursorPos(p)

    Me.left = p.X * Screen.TwipsPerPixelX + dx
    Me.top = p.Y * Screen.TwipsPerPixelY + dy
End Sub