mysize.ctl

一套鞋厂的销售管理系统

VERSION 5.00
Begin VB.UserControl XtSize 
   ClientHeight    =   2925
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6270
   DataBindingBehavior=   1  'vbSimpleBound
   ScaleHeight     =   2925
   ScaleWidth      =   6270
   ToolboxBitmap   =   "MySize.ctx":0000
   Begin VB.TextBox TSize 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   0
      Left            =   1800
      TabIndex        =   1
      TabStop         =   0   'False
      Text            =   "0"
      Top             =   1440
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Line Lines 
      Index           =   0
      X1              =   120
      X2              =   3960
      Y1              =   1200
      Y2              =   1200
   End
   Begin VB.Label LSize 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "合计"
      ForeColor       =   &H80000008&
      Height          =   225
      Index           =   0
      Left            =   720
      TabIndex        =   0
      Top             =   480
      Visible         =   0   'False
      Width           =   915
   End
End
Attribute VB_Name = "XtSize"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'自定义变量
Dim SizeKeyArray() As String
Const LineWidth = 20
'缺省属性值:
Const m_def_SizeField = 0
Const m_def_SizeCount = 0
Const m_def_HeadForeColor = 0
Const m_def_HeadBackColor = 0
Const m_def_TextForeColor = 0
Const m_def_TextBackColor = 0
Const m_def_LineColor = 0
Const m_def_SizeName = 0
Const m_def_SizeNumber = 0
Const m_def_SizeType = 0
Const m_def_SizeHead = ""
Const m_def_SizeKey = 0
Const m_def_PrintCount = True
Const m_def_PrintHead = True
'属性变量:
Dim m_SizeField1 As Currency
Dim m_SizeField2 As Currency
Dim m_SizeField3 As Currency
Dim m_SizeField4 As Currency
Dim m_SizeField5 As Currency
Dim m_SizeField6 As Currency
Dim m_SizeField7 As Currency
Dim m_SizeField8 As Currency
Dim m_SizeField9 As Currency
Dim m_SizeField10 As Currency
Dim m_SizeField11 As Currency
Dim m_SizeField12 As Currency
Dim m_SizeField13 As Currency
Dim m_SizeField14 As Currency
Dim m_SizeField15 As Currency
Dim m_SizeField16 As Currency
Dim m_SizeField17 As Currency
Dim m_SizeField18 As Currency
Dim m_SizeField19 As Currency
Dim m_SizeField20 As Currency
Dim m_SizeField21 As Currency
Dim m_SizeField22 As Currency
Dim m_SizeField23 As Currency
Dim m_SizeField24 As Currency
Dim m_SizeField25 As Currency
Dim m_SizeField26 As Currency
Dim m_SizeField27 As Currency
Dim m_SizeField28 As Currency
Dim m_SizeField29 As Currency
Dim m_SizeField30 As Currency
Dim m_HeadForeColor As OLE_COLOR
Dim m_HeadBackColor As OLE_COLOR
Dim m_HeadFont As Font
Dim m_TextForeColor As OLE_COLOR
Dim m_TextBackColor As OLE_COLOR
Dim m_TextFont As Font
Dim m_LineColor As OLE_COLOR
Dim m_SizeName As String
Dim m_SizeNumber As Long
Dim m_SizeType As String
Dim m_SizeHead As String
Dim m_SizeKey As String
Dim m_PrintCount As Boolean
Dim m_PrintHead As Boolean
'事件声明:
Event Click()
Event DblClick()
Event SizeChange()
'事件声明:
'Dim OcxRst As ADODB.Recordset


'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/设置一个值，决定一个对象是否响应用户生成事件。"
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BorderStyle
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "返回/设置对象的边框样式。"
    BorderStyle = UserControl.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
    UserControl.BorderStyle() = New_BorderStyle
    PropertyChanged "BorderStyle"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Appearance
Public Property Get Appearance() As Integer
Attribute Appearance.VB_Description = "返回/设置一个对象在运行时是否以 3D 效果显示。"
    Appearance = UserControl.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As Integer)
On Error Resume Next
    UserControl.Appearance() = New_Appearance
    PropertyChanged "Appearance"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "强制完全重画一个对象。"
    UserControl.Refresh
End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,true
Public Property Get PrintCount() As Boolean
    PrintCount = m_PrintCount
End Property

Public Property Let PrintCount(ByVal New_PrintCount As Boolean)
    m_PrintCount = New_PrintCount
    PropertyChanged "PrintCount"
End Property

'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,true
Public Property Get PrintHead() As Boolean
    PrintHead = m_PrintHead
End Property

Public Property Let PrintHead(ByVal New_PrintHead As Boolean)
    m_PrintHead = New_PrintHead
    PropertyChanged "PrintHead"
End Property
'
'Private Sub TSize_Change(Index As Integer)
'    RaiseEvent SizeChange
'End Sub

'注意！不要删除或修改下列被注释的行！
'MemberInfo=2
Public Function GetCount() As Currency
    GetCount = Val(TSize(0).Text)
End Function

'注意！不要删除或修改下列被注释的行！
'MemberInfo=2
Public Function GetSize(ByVal SizeKey As String) As Currency
    Dim i As Long
    GetSize = 0
    For i = 1 To m_SizeNumber
        If SizeKeyArray(i) = SizeKey Then
            GetSize = Val(TSize(i).Text)
        End If
    Next
End Function

Public Function GetIndexSize(ByVal Index As Integer) As Currency
    GetIndexSize = Val(TSize(Index).Text)
End Function

Private Sub TSize_GotFocus(Index As Integer)
    TSize(Index).SelStart = 0
    TSize(Index).SelLength = 100
End Sub

Private Sub TSize_KeyPress(Index As Integer, KeyAscii As Integer)
    Dim i As Long
    If KeyAscii = 13 Then
        If Index < m_SizeNumber Then
            TSize(Index + 1).SetFocus
        Else
            TSize(0).SetFocus
        End If
    End If
    If KeyAscii = Asc(".") Or (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
        If KeyAscii = Asc(".") Then
            If m_SizeType = "Integer" Then
                KeyAscii = 0
            Else
                For i = 1 To Len(TSize(Index).Text)
                    If Mid(TSize(Index).Text, i, 1) = "." Then
                        KeyAscii = 0
                    End If
                Next
            End If
        End If
    Else
        If KeyAscii = Asc("-") Then
            If TSize(Index).SelStart = 0 Then
            Else
                KeyAscii = 0
            End If
        Else
            KeyAscii = 0
        End If
    End If
End Sub

Private Sub TSize_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    Do Until Len(TSize(Index).Text) = 1 Or Left(TSize(Index).Text, 1) <> "0" Or Mid(TSize(Index).Text, 2, 1) = "."
        TSize(Index).Text = Mid(TSize(Index).Text, 2, 100)
    Loop
End Sub

Private Sub TSize_LostFocus(Index As Integer)
    Dim i As Long
    If TSize(Index).Text = "-" Then
        TSize(Index).Text = "0"
    End If
    For i = 1 To Len(TSize(Index).Text)
        If Mid(TSize(Index).Text, i, 1) = "." Then
            If Len(TSize(Index).Text) = 1 Then
                TSize(Index).Text = 0
            Else
                If i = Len(TSize(Index).Text) Then
                    TSize(Index).Text = Left(TSize(Index).Text, Len(TSize(Index).Text) - 1)
                Else
                    If i = 1 Then
                        TSize(Index).Text = "0" & TSize(Index).Text
                    End If
                End If
            End If
        End If
    Next
    TSize(0).Text = "0"
    For i = 1 To m_SizeNumber
        TSize(0).Text = Val(TSize(0).Text) + Val(TSize(i).Text)
        SizeCount = TSize(0).Text
    Next
    Select Case Index
        Case 1
            SizeField1 = TSize(1).Text
        Case 2
            SizeField2 = TSize(2).Text
        Case 3
            SizeField3 = TSize(3).Text
        Case 4
            SizeField4 = TSize(4).Text
        Case 5
            SizeField5 = TSize(5).Text
        Case 6
            SizeField6 = TSize(6).Text
        Case 7
            SizeField7 = TSize(7).Text
        Case 8
            SizeField8 = TSize(8).Text
        Case 9
            SizeField9 = TSize(9).Text
        Case 10
            SizeField10 = TSize(10).Text
        Case 11
            SizeField11 = TSize(11).Text
        Case 12
            SizeField12 = TSize(12).Text
        Case 13
            SizeField13 = TSize(13).Text
        Case 14
            SizeField14 = TSize(14).Text
        Case 15
            SizeField15 = TSize(15).Text
        Case 16
            SizeField16 = TSize(16).Text
        Case 17
            SizeField17 = TSize(17).Text
        Case 18
            SizeField18 = TSize(18).Text
        Case 19
            SizeField19 = TSize(19).Text
        Case 20
            SizeField20 = TSize(20).Text
        Case 21
            SizeField20 = TSize(21).Text
        Case 22
            SizeField20 = TSize(22).Text
        Case 23
            SizeField20 = TSize(23).Text
        Case 24
            SizeField20 = TSize(24).Text
        Case 25
            SizeField20 = TSize(25).Text
        Case 26
            SizeField20 = TSize(26).Text
        Case 27
            SizeField20 = TSize(27).Text
        Case 28
            SizeField20 = TSize(28).Text
        Case 29
            SizeField20 = TSize(29).Text
        Case 30
            SizeField20 = TSize(30).Text
    End Select
End Sub

'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    m_PrintCount = m_def_PrintCount
    m_PrintHead = m_def_PrintHead
    m_HeadForeColor = m_def_HeadForeColor
    m_HeadBackColor = m_def_HeadBackColor
    Set m_HeadFont = Ambient.Font
    m_TextForeColor = m_def_TextForeColor
    m_TextBackColor = m_def_TextBackColor
    Set m_TextFont = Ambient.Font
    m_LineColor = m_def_LineColor
    m_SizeName = m_def_SizeName
    m_SizeNumber = m_def_SizeNumber
    m_SizeType = m_def_SizeType
    m_SizeHead = m_def_SizeHead
    m_SizeKey = m_def_SizeKey
    TSize(0).Text = m_def_SizeCount
    m_SizeField1 = m_def_SizeField
    m_SizeField2 = m_def_SizeField
    m_SizeField3 = m_def_SizeField
    m_SizeField4 = m_def_SizeField
    m_SizeField5 = m_def_SizeField