pushbutton.cls

VB串口 云台镜头控制系统 完整源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPushButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'********************************************
'声明：
'********************************************
Option Explicit
'当前屏幕上一个像素所包含的twip
Private Scale_X As Integer
Private Scale_Y As Integer

'当前所绘按钮的左上角坐标值
Private baseTop As Integer
Private baseLeft As Integer
'********************************************
'声明：
'********************************************

'*********************************************
'功能：类初始化函数
'*********************************************
Private Sub Class_Initialize()
    Scale_X = Screen.TwipsPerPixelX
    Scale_Y = Screen.TwipsPerPixelY
End Sub
'**********************************************
'功能：设置按钮基准点
'**********************************************
Public Sub SetBasePosition(left As Integer, top As Integer)
    baseLeft = left
    baseTop = top
End Sub
'**********************************************
'功能：绑定物体到Frame，此时限制按钮容器为Frame
'参数：fra:按钮所在容器，此函数中为frame类型的
'      shp:Shape类型的一个矩形
'      pic:要求为一个PictureBox
'      LineA:Line类型
'      LineB:Line类型，这里四个参数所代表的控件将被设为以fra为容器
'**********************************************
Public Sub AttachObjectToFrame(ByRef fra As Frame, ByRef shp As Shape, ByRef pic As PictureBox, ByRef lineR As Line, ByRef lineB As Line)
    Set pic.Container = fra
    With pic
        .top = baseTop
        .left = baseLeft
        .Visible = True    '令其可见:不能漏
    End With
            
    Set shp.Container = fra
    With shp
        .left = pic.left - Scale_X
        .top = pic.top - Scale_Y
        .Visible = True
    End With
            
    Set lineR.Container = fra
    With lineR
        .X1 = pic.left + pic.ScaleWidth() + Scale_X * 2
        .Y1 = pic.top
        .X2 = pic.left + pic.ScaleWidth() + Scale_X * 2
        .Y2 = pic.top + pic.ScaleHeight() + Scale_Y * 2
        .Visible = True
    End With
            
    Set lineB.Container = fra
    With lineB
        .X1 = pic.left
        .Y1 = pic.top + pic.ScaleHeight() + Scale_Y * 2
        .X2 = pic.left + pic.ScaleWidth() + Scale_X * 2
        .Y2 = pic.top + pic.ScaleHeight() + Scale_Y * 2
        .Visible = True
    End With
End Sub
'**********************************************
'功能：绑定物体到Form，此时限制按钮容器为Form
'参数：fra:按钮所在容器，此函数中为frame类型的
'      shp:Shape类型的一个矩形
'      pic:要求为一个PictureBox
'      LineR:Line类型
'      LineB:Line类型，这里四个参数所代表的控件将被设为以frm为容器
'**********************************************
Public Sub AttachObjectToForm(ByRef frm As Form, ByRef shp As Shape, ByRef pic As PictureBox, ByRef lineR As Line, ByRef lineB As Line)
    Set pic.Container = frm
    With pic
        .top = baseTop
        .left = baseLeft
        .Visible = True    '令其可见:不能漏
    End With
            
    Set shp.Container = frm
    With shp
        .left = pic.left - Scale_X
        .top = pic.top - Scale_Y
        .Visible = True
    End With
            
    Set lineR.Container = frm
    With lineR
        .X1 = pic.left + pic.ScaleWidth() + Scale_X * 2
        .Y1 = pic.top
        .X2 = pic.left + pic.ScaleWidth() + Scale_X * 2
        .Y2 = pic.top + pic.ScaleHeight() + Scale_Y * 2
        .Visible = True
    End With
            
    Set lineB.Container = frm
    With lineB
        .X1 = pic.left
        .Y1 = pic.top + pic.ScaleHeight() + Scale_Y * 2
        .X2 = pic.left + pic.ScaleWidth() + Scale_X * 2
        .Y2 = pic.top + pic.ScaleHeight() + Scale_Y * 2
        .Visible = True
    End With
End Sub
'**********************************************
'功能：绑定物体到PictureBox
'参数：pic:按钮所用的PictureBox
'      lab:显示按钮文本用的静态文本框
'      LineT:Line类型
'      LineL:Line类型，这里三个参数所代表的控件将被设为以pic为容器
'**********************************************
Public Sub AttachObjectToPictureBox(ByRef pic As PictureBox, ByRef lab As Label, ByRef lineT As Line, ByRef lineL As Line)
    Set lab.Container = pic
    With lab
        .AutoSize = True
        .top = (pic.ScaleHeight - lab.Height) / 2 '设置位置
        .left = (pic.ScaleWidth - lab.Width) / 2
        .Visible = True    '令其可见:不能漏
    End With
            
    Set lineT.Container = pic
    With lineT
        .BorderWidth = 1
        .X1 = 0
        .Y1 = 0
        .X2 = pic.ScaleWidth()
        .Y2 = 0
        .Visible = True
    End With
            
    Set lineL.Container = pic
    With lineL
        .X1 = 0
        .Y1 = 0
        .X2 = 0
        .Y2 = pic.ScaleHeight()
        .Visible = True
    End With
End Sub