Option Explicit
Private Const MResizer = "ResizeGrab" Private WithEvents m_objResizer As MSForms.Label Private m_sngLeftResizePos As Single Private m_sngTopResizePos As Single Private m_blnResizing As Single
Private Sub m_AddResizer() ' ' 유저폼의 오른쪽 아래 코너에 크기조절 버튼을 추가합니다 ' Set m_objResizer = Me.Controls.Add("Forms.label.1", MResizer, True) With m_objResizer With .Font .Name = "Marlett" .Charset = 2 .Size = 14 .Bold = True End With .BackStyle = fmBackStyleTransparent .AutoSize = True .BorderStyle = fmBorderStyleNone .Caption = "o" .MousePointer = fmMousePointerSizeNWSE .ForeColor = RGB(0, 0, 255) .ZOrder .Top = Me.InsideHeight - .Height .Left = Me.InsideWidth - .Width End With End Sub
Private Sub cmdClose_Click() Unload Me End Sub
Private Sub m_objResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then m_sngLeftResizePos = X m_sngTopResizePos = Y m_blnResizing = True End If End Sub Private Sub m_objResizer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then With m_objResizer .Move .Left + X - m_sngLeftResizePos, .Top + Y - m_sngTopResizePos Me.Width = Me.Width + X - m_sngLeftResizePos Me.Height = Me.Height + Y - m_sngTopResizePos .Left = Me.InsideWidth - .Width .Top = Me.InsideHeight - .Height End With Me.cmdClose.Top = UserForm1.Height - Me.cmdClose.Height - 40 Me.cmdClose.Left = UserForm1.Width - Me.cmdClose.Width - 20 End If End Sub Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 1 Then m_blnResizing = False End If End Sub Private Sub UserForm_Initialize()
m_AddResizer End Sub Private Sub UserForm_Terminate()
Me.Controls.Remove MResizer End Sub
|