resizeclass.cls

来自「adsl拨号工具 有很多功能 不错啊 大家试试」· CLS 代码 · 共 141 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ResizeClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉出品
'发布日期：05/08/15
'描  述：拨号上网管理器
'网  站：http://www.mndsoft.com/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'   THE RESEIZE CLASS
'   ~~~~~~~~~~~~~~~~~

'You are free to use this class in your own projects n give
'me some credits when you do. Dont forget to visit my web
'site k?

'                               --- Author, Muhammad Abubakar
'                                       <[e-mail]>
'                                       http://go.to/abubakar

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'Key codes:
'1  ->  top only
'2  ->  left only
'3  ->  top and left
'4  ->  height only
'5  ->  width only
'6  ->  height and width
'-----------------------
Option Explicit

Enum eParams
    RS_TopOnly = 1
    RS_LeftOnly = 2
    RS_Top_Left = 3
    RS_HeightOnly = 4
    RS_WidthOnly = 5
    RS_Height_Width = 6
End Enum
Private Type cInfo
    cControl As Control
    cHeight As Integer
    cWidth As Integer
    cTop As Integer
    cLeft As Integer
    cInfo As Integer
End Type

Private cArray() As cInfo
Private Count As Integer

Private FormHeight As Integer
Private FormWidth As Integer

Public Property Let hParam(ByVal fh As Integer)
    FormHeight = fh
        
End Property
Public Property Let wParam(ByVal fw As Integer)
    FormWidth = fw
End Property
Public Sub Map(rCont As Control, SizeInfo As eParams)
    Count = Count + 1
    ReDim Preserve cArray(Count)
    Set cArray(Count).cControl = rCont
    cArray(Count).cInfo = SizeInfo
    
    Select Case SizeInfo
        Case 1:
            cArray(Count).cTop = FormHeight - rCont.Top
        Case 2:
            cArray(Count).cLeft = FormWidth - rCont.Left
        Case 3:
            cArray(Count).cTop = FormHeight - rCont.Top
            cArray(Count).cLeft = FormWidth - rCont.Left
        Case 4:
            cArray(Count).cHeight = FormHeight - rCont.Height
        Case 5:
            cArray(Count).cWidth = FormWidth - rCont.Width
        Case 6:
            cArray(Count).cHeight = FormHeight - rCont.Height
            cArray(Count).cWidth = FormWidth - rCont.Width
        Case Else:
            Exit Sub
    End Select
    
End Sub

Public Sub rSize(cForm As Form)
    
    On Error Resume Next
    Dim I As Integer, a As Integer, b As Integer
    For I = 1 To Count
        Select Case cArray(I).cInfo
            Case 1:
                cArray(I).cControl.Top = cForm.Height - cArray(I).cTop
            Case 2:
                cArray(I).cControl.Left = cForm.Width - cArray(I).cLeft
            Case 3:
                cArray(I).cControl.Top = cForm.Height - cArray(I).cTop
                cArray(I).cControl.Left = cForm.Width - cArray(I).cLeft
            Case 4:
                b = cForm.Height - cArray(I).cHeight
                If b < 0 Then b = 0
                cArray(I).cControl.Height = b 'cForm.Height - cArray(i).cHeight
            Case 5:
                a = cForm.Width - cArray(I).cWidth
                If a < 0 Then a = 0
                cArray(I).cControl.Width = a 'cForm.Width - cArray(i).cWidth
            Case 6:
                a = cForm.Width - cArray(I).cWidth
                b = cForm.Height - cArray(I).cHeight
                If a < 0 Then a = 0
                If b < 0 Then b = 0
                cArray(I).cControl.Height = b 'cForm.Height - cArray(i).cHeight
                cArray(I).cControl.Width = a 'cForm.Width - cArray(i).cWidth
            
                
        End Select
    Next
    Exit Sub
End Sub