billset.cls

金算盘软件代码

    Let mstrAlpha = vData
End Property
Public Property Get strAlpha() As String
    strAlpha = mstrAlpha
End Property

Public Property Let blnSound(ByVal vData As Boolean)
    Let mblnSound = vData
End Property
Public Property Get blnSound() As Boolean
    blnSound = mblnSound
End Property
'确定是否为应收计息单据属性
Public Property Let blnYSJX(ByVal vData As Boolean)
    Let mblnYSJX = vData
End Property
Public Property Get blnYSJX() As Boolean
    blnYSJX = mblnYSJX
End Property

Public Property Let blnIsHaveVoid(ByVal vData As Boolean)
    Let mvarblnIsHaveVoid = vData
End Property

Public Property Get blnIsHaveVoid() As Boolean
    blnIsHaveVoid = mvarblnIsHaveVoid
End Property

'设置权限的属性
Public Property Let blnMayChanged(ByVal vData As Boolean)
    Let My.blnMayChange = vData
End Property
Public Property Get blnMayChanged() As Boolean
  blnMayChanged = My.blnMayChange
End Property

Public Property Get DropButtonWidth() As Integer
     DropButtonWidth = intButtonWidth
End Property
'单据类型属性
Public Property Let ReceiptTypeID(ByVal vData As Integer)
   Let intReceiptTypeID = vData
End Property

Public Property Get ReceiptTypeID() As Integer
     ReceiptTypeID = intReceiptTypeID
End Property
'是否绑定控件属性
Public Property Let blnCtrlBinding(ByVal vData As Boolean)
   Let My.blnCtrlBinding = vData
End Property
Public Property Get blnCtrlBinding() As Boolean
     blnCtrlBinding = My.blnCtrlBinding
End Property
'当前单据ID 属性
Public Property Let lngNowID(ByVal vData As Long)
   Let My.lngNowID = vData
End Property
Public Property Get lngNowID() As Long
     lngNowID = My.lngNowID
End Property
'当前输入区域属性
Public Property Let bytRegion(ByVal vData As Byte)
   Let My.bytRegion = vData
End Property
Public Property Get bytRegion() As Byte
     bytRegion = My.bytRegion
End Property
'前输入区域属性
Public Property Let LastRegion(ByVal vData As Byte)
   Let mLastRegion = vData
End Property
Public Property Get LastRegion() As Byte
     LastRegion = mLastRegion
End Property
'当前输入区域序号属性
Public Property Let bytIndex(ByVal vData As Byte)
   Let My.bytIndex = vData
End Property
Public Property Get bytIndex() As Byte
     bytIndex = My.bytIndex
End Property

'数据是否改变属性
Public Property Let blnIsChanged(ByVal vData As Boolean)
   Let My.blnIsChanged = vData
End Property
Public Property Get blnIsChanged() As Boolean
     blnIsChanged = My.blnIsChanged
End Property
'窗体是否刷新属性
Public Property Let blnRefresh(ByVal vData As Boolean)
   Let My.blnRefresh = vData
End Property
Public Property Get blnRefresh() As Boolean
    blnRefresh = My.blnRefresh
End Property
'是否可行粘贴属性
Public Property Let blnPasteRec(ByVal vData As Boolean)
   Let My.blnPasteRec = vData
End Property
Public Property Get blnPasteRec() As Boolean
    blnPasteRec = My.blnPasteRec
End Property
'是否可删除属性
Public Property Let blnMayDelete(ByVal vData As Boolean)
   Let My.blnMayDelete = vData
End Property
Public Property Get blnMayDelete() As Boolean
    blnMayDelete = My.blnMayDelete
End Property
'是否触发CHANGE事件属性
Public Property Let blnChangeEvent(ByVal vData As Boolean)
   Let My.blnChangeEvent = vData
End Property
Public Property Get blnChangeEvent() As Boolean
    blnChangeEvent = My.blnChangeEvent
End Property
    
'会计年度属性
Public Property Let intAccountYear(ByVal vData As Integer)
   Let My.intAccountYear = vData
End Property
Public Property Get intAccountYear() As Integer
    intAccountYear = My.intAccountYear
End Property
'会计期间属性
Public Property Let bytAccountPeriod(ByVal vData As Byte)
   Let My.bytAccountPeriod = vData
End Property
Public Property Get bytAccountPeriod() As Byte
    bytAccountPeriod = My.bytAccountPeriod
End Property
'GRD原列号属性
Public Property Let lngOldCol(ByVal vData As Long)
   Let My.lngOldCol = vData
End Property
Public Property Get lngOldCol() As Long
    lngOldCol = My.lngOldCol
End Property
'GRD原行号属性
Public Property Let lngOldRow(ByVal vData As Long)
   Let My.lngOldRow = vData
End Property
Public Property Get lngOldRow() As Long
    lngOldRow = My.lngOldRow
End Property
    
Public Property Get grdBorderWidth() As Integer
Attribute grdBorderWidth.VB_UserMemId = 0
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.grdBorderWidth
    grdBorderWidth = intGrdBorderWidth
End Property
Public Property Set Form(ByVal vData As Form)
'当把对象赋值给属性时在 Set 语句左边使用。
'Syntax: Set x.GridName = Form1

    On Error GoTo ErrDo
    
    IntSpace = Screen.TwipsPerPixelX   '粘贴控件之间距
    SPACETWIPS = 2 * Screen.TwipsPerPixelX '单据头控件之列距
    SpaceTwRow = Screen.TwipsPerPixelY   '单据头控件之行距
    Set frmName = vData
    My.blnIsChanged = False
    My.bytRegion = FcmdButton
    My.bytIndex = 0
    If UCase(frmName.Name) = "FRMINVOICE" Then
        blnCashLine = GetSetting(App.title, "36" + CStr(gclsBase.OperatorID), "CashLine", "True")
    ElseIf UCase(frmName.Name) = "FRMPAYABLE" Then
        blnCashLine = GetSetting(App.title, "34" + CStr(gclsBase.OperatorID), "CashLine", "True")
    ElseIf UCase(frmName.Name) = "FRMPAYMENT" Then
        blnCashLine = GetSetting(App.title, "39" + CStr(gclsBase.OperatorID), "CashLine", "True")
    ElseIf UCase(frmName.Name) = "FRMRECEIVE" Then
        blnCashLine = GetSetting(App.title, "40" + CStr(gclsBase.OperatorID), "CashLine", "True")
    End If
    
    If blnCashLine Then
        frmName.GrdCol.TextMatrix(0, 4) = ""
    Else
        frmName.GrdCol.TextMatrix(0, 4) = "金   额"
    End If

'    mblnLeftRight = True '左右结构标志
    mblnLeftRight = False
    
    '给GRDCOL设HOOK
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hWnd = frmName.GrdCol.hWnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    
    Set mclsPicFooter = New SubClass32.SubClass
    mclsPicFooter.hWnd = frmName.picFooter.hWnd
    mclsPicFooter.Messages(WM_PAINT) = True
    

    Set mclsHook = New SubClass32.SubClass
    mclsHook.hWnd = frmName.hWnd
    mclsHook.Messages(WM_PAINT) = True
    mclsHook.Messages(WM_KEYUP) = True
    mclsHook.Messages(WM_NCLBUTTONDOWN) = True
    mclsHook.Messages(WM_GETMINMAXINFO) = True
    Set HookHe = New Hook
    HookHe.SetHookAll frmName.hWnd
    
    Set clsRed = New RecordClass
    My.intAccountYear = gclsBase.FYearOfDate(gclsBase.BaseDate)    '会计年度
    My.bytAccountPeriod = gclsBase.PeriodOfDate(gclsBase.BaseDate)  '会计期间
    My.blnCtrlBinding = True
    My.blnRefresh = False
    My.blnPasteRec = False
'设置GRID附加属性
    lngOldHeight = CLng(frmName.GrdCol.RowHeight(0) / 2)
    'frmName.grdCol.RowHeight(0) = CLng(frmName.grdCol.RowHeight(0) / 2)
    frmName.lblInput(0).Height = lngOldHeight
    frmName.lblTitle(0).Height = lngOldHeight
    frmName.cashInput.SLineIsWidth = False
    ReDim Field(15)
    ReDim ColProperty(27)
    frmName.GrdCol.Cols = 27
    
    ReDim strColRow(frmName.GrdCol.Cols - 1)
'设置GRID属性
    SetColProperty
'创建GRID列粘贴控件
  Dim i As Integer
    For i = 1 To frmName.GrdCol.Cols - 1
        Load frmName.lblTotal(i)
        frmName.lblTotal(i).Caption = ""
        frmName.lblTotal(i).ZOrder 0
        '应付单只有4列显示
        If i >= 4 Then
            Exit For
        End If
    Next i
    frmName.lblTotal(2).Alignment = 1

'   创建Field控件(表头输入)
    CreateField (15)

    Set ctrInput = frmName.refInput(0)
    frmName.GrdCol.Visible = False
'Init Property
    frmName.refInput(0).Comparts = 2
    frmName.refInput(1).Comparts = 2
    frmName.refInput(2).Comparts = 2
'绑定科目记录集
    frmName.refInput(1).SeekCol = "1,2,3"
    If UCase(frmName.Name) = "FRMINVOICE" Or UCase(frmName.Name) = "FRMPAYABLE" Then
        frmName.refInput(1).SQL = clsRed.RecordSQL(CInt(Field(5).bytReferSort), 2)
        Set frmName.refInput(1).Recordset = clsRed.RecordCon(CInt(Field(5).bytReferSort), 2)
    Else     '在收款和付款单中必须是现金/银行科目
        frmName.refInput(1).SQL = clsRed.RecordSQL(CInt(Field(5).bytReferSort), 1)
        Set frmName.refInput(1).Recordset = clsRed.RecordCon(CInt(Field(5).bytReferSort), 1)
    End If
    frmName.refInput(1).AddRefer "<新增>"
    frmName.refInput(1).AddRefer "<修改>"
    frmName.refInput(1).AddRefer "<删除>"
    frmName.refInput(1).Appearance = 0
    frmName.refInput(1).BorderStyle = 0
    frmName.refInput(1).Tag = MsgNO(CInt(Field(5).bytReferSort))
    frmName.refInput(1).Move -50000
'绑定表头单位记录集
'    If UCase(frmName.Name) = UCase("frmInvoice") Then
'        Set frmName.refInput(2).Recordset = clsRed.RecordCon(xCustomer, -1)
'    ElseIf UCase(frmName.Name) = UCase("frmPayable") Then
'        Set frmName.refInput(2).Recordset = clsRed.RecordCon(xCustomer, 1)
'    Else
    frmName.refInput(2).SeekCol = "1,2,3"
        frmName.refInput(2).SQL = clsRed.RecordSQL(xCustomer)
        Set frmName.refInput(2).Recordset = clsRed.RecordCon(xCustomer)
'    End If
    frmName.refInput(2).AddRefer "<新增>"
    frmName.refInput(2).AddRefer "<修改>"
    frmName.refInput(2).AddRefer "<删除>"
    frmName.refInput(2).Appearance = 1
    frmName.refInput(2).BorderStyle = 1
    frmName.refInput(2).Tag = MsgNO(xCustomer)
    frmName.refInput(2).Move -50000
    lngOneTextWidth = frmName.TextWidth("3")  '一个字的显示宽度（TWIPS）
    
    If WanNeng Then
        frmName.tblReceipt.Visible = True
        SetImageList frmName.tblReceipt
        SetToolBarTextImage frmName.tblReceipt, 2, intReceiptTypeID
    End If
    
    Exit Property
ErrDo:
    Unload frmName
End Property
Public Property Get Form() As Object
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.GridName
    Set Form = frmName
End Property
'确定滚动条的存在
Public Sub ScrollBarExist(blnHscroll As Boolean, blnVscroll As Boolean)
    Dim intTotalColsWidth As Long
    intTotalColsWidth = lngSumOfColWidth()
With frmName
    If .GrdCol.Rows <= 2 Then
        '总行数小于2,必无垂直滚动条
        blnVscroll = False
        If intTotalColsWidth >= .GrdCol.width - 0 * intGrdBorderWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If (Not .GrdCol.RowIsVisible(.GrdCol.Rows - 1)) Or (Not .GrdCol.RowIsVisible(1)) Then
        '第一行或最大行不可视(第0行为固定行),必有垂直滚动条
        blnVscroll = True
        If intTotalColsWidth >= .GrdCol.width - 0 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc