submitadjust.cls

金算盘软件代码

'会计年度属性
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
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.grdBorderWidth
    grdBorderWidth = intGrdBorderWidth
End Property

Public Property Set Form(ByVal vData As Form)
'当把对象赋值给属性时在 Set 语句左边使用。
'Syntax: Set x.GridName = Form1
    IntSpace = Screen.TwipsPerPixelX   '粘贴控件之间距
    SPACETWIPS = 2 * Screen.TwipsPerPixelX '单据头控件之列距
    SpaceTwRow = Screen.TwipsPerPixelY   '单据头控件之行距
    If gclsBase Is Nothing Then GoTo EndProc
    Set frmName = vData
    Set NewQ = New UnitCtrl
    NewQ.SetWin frmName.QuanInput.hWnd
    NewQ.font = frmName.font

    My.blnIsChanged = False
    My.bytRegion = FcmdButton
    My.bytIndex = 0
    SetRight
    
    SetFormColor fccolor
    SeparateLineColor = fccolor.lngGridLineColor
    ApplyFormColor frmName, fccolor
    NewQ.BackColor = fccolor.lngBackColor
    
    Set clsRecord = New RecordClass
    
    '给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 mclsHook = New SubClass32.SubClass
    mclsHook.hWnd = frmName.hWnd
    mclsHook.Messages(WM_PAINT) = True
    mclsHook.Messages(WM_KEYUP) = True
    mclsHook.Messages(WM_GETMINMAXINFO) = True
    Set HookHe = New Hook
    HookHe.SetHookAll frmName.hWnd
        
    My.intAccountYear = gclsBase.FYearOfDate(gclsBase.BaseDate)   '会计年度
    My.bytAccountPeriod = gclsBase.PeriodOfDate(gclsBase.BaseDate)  '会计期间
    My.blnCtrlBinding = True
    My.blnRefresh = False
    My.blnPasteRec = False
    
    ReDim Field(14) As ClassField        '表头输入控件的附加属性
    'redim PicLbl(10) As ClassPicInputField  'PIC输入时的附加属性
    ReDim ColProperty(43) As ClassGridProperty   'GRID附加属性
    frmName.GrdCol.Cols = 42 + 1
    SetColProperty
'创建GRID列粘贴控键
  Dim i As Integer
    For i = 1 To frmName.GrdCol.Cols
        Load frmName.lblTotal(i)
        frmName.lblTotal(i).Caption = ""
        frmName.lblTotal(i).ZOrder 0
        If i < frmName.GrdCol.Cols Then
            If ColProperty(i).lngCtrType = tCurrency Then
                frmName.lblTotal(i).Alignment = vbRightJustify
            End If
        End If
    Next i

'   创建Field控件(表头输入)
    CreateField (9)
'    GrdAndLabelInitial
    ReDim strColRow(frmName.GrdCol.Cols - 1) As String  '单据体行复制/粘贴存储区
    ReDim arrItemProperty(1) As ItemProperty
'设置默认小数位数
    BillPublic.CurRateDec gclsBase.NaturalCurId, intCurDec, intRateDec
EndProc:
    #If conWan = 1 Then
         SetToolBar True
    #End If
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()
    If frmName.GrdCol.Rows <= 2 Then
        '总行数小于2,必无垂直滚动条
        blnVscroll = False
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If (Not frmName.GrdCol.RowIsVisible(frmName.GrdCol.Rows - 1)) Or (Not frmName.GrdCol.RowIsVisible(1)) Then
        '第一行或最大行不可视(第0行为固定行),必有垂直滚动条
        blnVscroll = True
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth Then
        blnHscroll = True
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight - gclsEniv.HScrollHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth < frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
        blnHscroll = False
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    
    If intTotalColsWidth < frmName.GrdCol.width - 2 * intGrdBorderWidth _
        And intTotalColsWidth > frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight Then
            blnVscroll = True
            blnHscroll = True
        Else
            blnVscroll = False
            blnHscroll = False
        End If
    End If

EndProc:
    If frmName.GrdCol.ScrollBars = flexScrollBarNone Or _
       frmName.GrdCol.ScrollBars = flexScrollBarVertical Then
        blnHscroll = False
    End If
    If frmName.GrdCol.ScrollBars = flexScrollBarNone Or _
       frmName.GrdCol.ScrollBars = flexScrollBarHorizontal Then
        blnVscroll = False
    End If

End Sub
'在GRID上的下一个增加行
Public Sub NextLineWithAdded()
    Dim intNewRow As Integer
    If frmName.GrdCol.Row < frmName.GrdCol.Rows - 1 Then
        intNewRow = frmName.GrdCol.Row + 1
    Else
        frmName.GrdCol.Rows = frmName.GrdCol.Rows + 1
        frmName.GrdCol.TextMatrix(frmName.GrdCol.Rows - 1, 0) = "0"
        intNewRow = frmName.GrdCol.Row + 1
    End If
    If Not blnRowIsVisible(intNewRow) Then
        frmName.GrdCol.TopRow = frmName.GrdCol.TopRow + 1
    End If
    frmName.GrdCol.Row = intNewRow
    If frmName.GrdCol.col = 0 Then
        frmName.GrdCol.col = 1
    End If
End Sub
'在GRID上确定行是否可见
Public Function blnRowIsVisible(ByVal RowNo As Integer) As Boolean
    '该行高度完全可视时为TRUE
    Dim blnHscroll As Boolean, blnVscroll As Boolean
    If frmName.GrdCol.Rows <= 1 Then
        frmName.GrdCol.Rows = 2
    End If
    If RowNo > frmName.GrdCol.Rows - 1 Then
        blnRowIsVisible = False
    End If
    If frmName.GrdCol.RowIsVisible(RowNo) = False Then
        blnRowIsVisible = False
        Exit Function
    End If
    Call ScrollBarExist(blnHscroll, blnVscroll) '判断是否滚动条
    If blnHscroll Then
        '下边有滚动水平条
        If frmName.GrdCol.RowPos(RowNo) + frmName.GrdCol.RowHeight(RowNo) > frmName.GrdCol.Height - gclsEniv.HScrollHeight Then
            blnRowIsVisible = False
        Else
            blnRowIsVisible = True
        End If
   Else
        '下边无水平滚动条
        If frmName.GrdCol.RowPos(RowNo) + frmName.GrdCol.RowHeight(RowNo) > frmName.GrdCol.Height Then
            blnRowIsVisible = False
        Else
            blnRowIsVisible = True
        End If
   End If
End Function

'各列宽度之和
Public Function lngSumOfColWidth() As Long
    Dim i As Integer, lngSum As Long
    lngSum = 0
    For i = 0 To frmName.GrdCol.Cols - 1
        lngSum = lngSum + frmName.GrdCol.ColWidth(i)
    Next i
    lngSumOfColWidth = lngSum
End Function

Public Function dblTotalOfCol(ByVal intCol As Integer) As Double
'GRID列合计
    Dim lngRow As Long
    Dim dblTmp As Double
    dblTmp = 0
    For lngRow = 1 To frmName.GrdCol.Rows - 1
        dblTmp = dblTmp + C2Dbl(strGrdCell(lngRow, intCol))
    Next lngRow
    dblTotalOfCol = dblTmp
End Function

'---------------------------------
'单据类型数组初始化
'---------------------------------
Private Sub Class_Initialize()
    intGrdBorderWidth = Screen.TwipsPerPixelX
    intGrdBorderHeight = Screen.TwipsPerPixelY
'    InitTabName
'    InitReceiptArray
End Sub
'---------------------------------
'确定GRID上的某一行是否为空行
'出口：为TRUE时不是空行,为FALSE时是空行
'---------------------------------
Public Function blnNotNullRow(ByVal lngRow As Long) As Boolean
    Dim intI As Integer
    If frmName.Visible Then
        blnNotNullRow = IIf(Trim(frmName.GrdCol.TextMatrix(lngRow, 1)) = "", False, True)
    Else
        blnNotNullRow = IIf(C2lng(frmName.GrdCol.TextMatrix(lngRow, ColProperty(1).bytGrdIDCol)) = 0, False, True)
    End If
'    For inti = 0 To frmName.grdCol.Cols - 1
'        If frmName.grdCol.TextMatrix(lngRow, inti) <> "" And frmName.grdCol.TextMatrix(lngRow, inti) <> "0" Then
'            blnNotNullRow = True
'            Exit Function
'        End If
'    Next
End Function
'--------------------------------------
'在GRID上删除一行
'入口：行号
'--------------------------------------
Public Function blnDeleteARow(ByVal lngRow As Long) As Boolean
    Dim i%
    With frmName.GrdCol
        If .Rows <= 2 Then
            InsertARow False
            .Row = lngRow
        End If
        .RemoveItem .Row
        My.bytRegion = FcmdButton
        My.bytIndex = 0
        InputCtrInvisible
        setAllItemproperty
        BuildNoteMsg True
        WriteTotalRow
        blnDeleteARow = True
        My.blnIsChanged = True
    End With
    blnSelectedBill
End Function