adjustcost.cls

金算盘软件代码

    My.bytRegion = FcmdButton
    My.bytIndex = 0
    frmName.grdCol.Cols = 37
    
    '设置窗体控件颜色
    SetFormColor fccolor
    ApplyFormColor frmName, fccolor
    SeparateLineColor = fccolor.lngGridLineColor   'GRID列分隔线色
    lngBackColor = GetSysColor(COLOR_BTNFACE)
    
   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
    
'    Set mclsPicHook = New SubClass32.SubClass
'    mclsPicHook.hWnd = picInput.hWnd
'    mclsPicHook.Messages(WM_PAINT) = True
    
    My.intAccountYear = gclsBase.FYearOfDate(gclsBase.BaseDate)   '会计年度
    My.bytAccountPeriod = gclsBase.PeriodOfDate(gclsBase.BaseDate)  '会计期间
    My.blnCtrlBinding = True
    My.blnRefresh = False
    My.blnPasteRec = False
    
    ReDim Field(8) As ClassField        '表头输入控件的附加属性
    'redim PicLbl(10) As ClassPicInputField  'PIC输入时的附加属性
    ReDim ColProperty(36) As ClassGridProperty   'GRID附加属性
    
'设置GRID附加属性
'    frmname.lblInput(0).Height = frmname.grdCol.RowHeight(0)
'    frmname.lblTitle(0).Height = frmname.grdCol.RowHeight(0)
    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(1).Caption = "合计"

'   创建Field控件(表头输入)
    CreateField (8)
'    GrdAndLabelInitial
    ReDim strColRow(frmName.grdCol.Cols - 1) As String  '单据体行复制/粘贴存储区
    ReDim arrItemProperty(1) As ItemProperty
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 InitReceiptArray()
    ReceiptType(1).lngReceiptTypeID = 1
    ReceiptType(1).strReceiptTypeName = "采购订单"
    ReceiptType(1).lngReceiptID = 1

    ReceiptType(2).lngReceiptTypeID = 2
    ReceiptType(2).strReceiptTypeName = "商品采购"
    ReceiptType(2).lngReceiptID = 2

    ReceiptType(3).lngReceiptTypeID = 3
    ReceiptType(3).strReceiptTypeName = "直运采购"
    ReceiptType(3).lngReceiptID = 2

    ReceiptType(4).lngReceiptTypeID = 4
    ReceiptType(4).strReceiptTypeName = "受托入库"
    ReceiptType(4).lngReceiptID = 2

    ReceiptType(5).lngReceiptTypeID = 5
    ReceiptType(5).strReceiptTypeName = "受托结算"
    ReceiptType(5).lngReceiptID = 2

    ReceiptType(6).lngReceiptTypeID = 6
    ReceiptType(6).strReceiptTypeName = "加工入库"
    ReceiptType(6).lngReceiptID = 2

    ReceiptType(7).lngReceiptTypeID = 7
    ReceiptType(7).strReceiptTypeName = "加工费用"
    ReceiptType(7).lngReceiptID = 2

    ReceiptType(8).lngReceiptTypeID = 8
    ReceiptType(8).strReceiptTypeName = "采购发票"
    ReceiptType(8).lngReceiptID = 2
    
    ReceiptType(9).lngReceiptTypeID = 9
    ReceiptType(9).strReceiptTypeName = "自制入库"
    ReceiptType(9).lngReceiptID = 2

    ReceiptType(10).lngReceiptTypeID = 10
    ReceiptType(10).strReceiptTypeName = "盘盈入库"
    ReceiptType(10).lngReceiptID = 2

    ReceiptType(11).lngReceiptTypeID = 11
    ReceiptType(11).strReceiptTypeName = "其他入库"
    ReceiptType(11).lngReceiptID = 2

    ReceiptType(12).lngReceiptTypeID = 12
    ReceiptType(12).strReceiptTypeName = "销售订单"
    ReceiptType(12).lngReceiptID = 3
    
    ReceiptType(13).lngReceiptTypeID = 13
    ReceiptType(13).strReceiptTypeName = "商品销售"
    ReceiptType(13).lngReceiptID = 4

    ReceiptType(14).lngReceiptTypeID = 14
    ReceiptType(14).strReceiptTypeName = "直运销售"
    ReceiptType(14).lngReceiptID = 4

    ReceiptType(15).lngReceiptTypeID = 15
    ReceiptType(15).strReceiptTypeName = "委托出库"
    ReceiptType(15).lngReceiptID = 4

    ReceiptType(16).lngReceiptTypeID = 16
    ReceiptType(16).strReceiptTypeName = "委托结算"
    ReceiptType(16).lngReceiptID = 4

    ReceiptType(17).lngReceiptTypeID = 17
    ReceiptType(17).strReceiptTypeName = "加工出库"
    ReceiptType(17).lngReceiptID = 4

    ReceiptType(18).lngReceiptTypeID = 18
    ReceiptType(18).strReceiptTypeName = "分期出库"
    ReceiptType(18).lngReceiptID = 4

    ReceiptType(19).lngReceiptTypeID = 19
    ReceiptType(19).strReceiptTypeName = "分期结算"
    ReceiptType(19).lngReceiptID = 4
    
    ReceiptType(20).lngReceiptTypeID = 20
    ReceiptType(20).strReceiptTypeName = "销售发票"
    ReceiptType(20).lngReceiptID = 4
    
    ReceiptType(21).lngReceiptTypeID = 21
    ReceiptType(21).strReceiptTypeName = "领用出库"
    ReceiptType(21).lngReceiptID = 4

    ReceiptType(22).lngReceiptTypeID = 22
    ReceiptType(22).strReceiptTypeName = "成本调整"
    ReceiptType(22).lngReceiptID = 4

    ReceiptType(23).lngReceiptTypeID = 23
    ReceiptType(23).strReceiptTypeName = "盘亏出库"
    ReceiptType(23).lngReceiptID = 4

    ReceiptType(24).lngReceiptTypeID = 24
    ReceiptType(24).strReceiptTypeName = "其他出库"
    ReceiptType(24).lngReceiptID = 4

    ReceiptType(25).lngReceiptTypeID = 25
    ReceiptType(25).strReceiptTypeName = "受托调价"
    ReceiptType(25).lngReceiptID = 5

    ReceiptType(26).lngReceiptTypeID = 26
    ReceiptType(26).strReceiptTypeName = "代销调拨"
    ReceiptType(26).lngReceiptID = 6