billstart.cls

金算盘软件代码

    Next i
    If frmName.cmdButton(0).Visible = False Then
        For i = 0 To frmName.cmdButton.Count - 1
            frmName.cmdButton(i).Visible = True
        Next i
    End If
    If Not frmName.grdCol.Visible Then
        frmName.grdCol.Visible = True
    End If
    For i = 0 To frmName.chkPrint.Count - 1
        frmName.chkPrint(i).Left = frmName.ScaleWidth - 5 * Screen.TwipsPerPixelX _
                                   - frmName.cmdButton(0).Width
        If frmName.chkPrint(i).Visible = False Then
            frmName.chkPrint(i).Visible = True
        End If
    Next i
    frmName.Refresh
End Sub
Private Sub TotalRowAdjust()
 '合计行位置及宽度及当前可视性调整
    Dim i As Integer
    Dim lngWidth As Long
    Dim lngLeft As Long
    Dim lngTop As Long
    Dim lngHeight As Long
    On Error Resume Next
    
    lngHeight = frmName.grdCol.RowHeight(0) - 5
    lngTop = frmName.lblNote(0).Top - lngHeight - 1 * Screen.TwipsPerPixelY

    For i = 0 To frmName.grdCol.Cols - 1
        If i > frmName.lblTotal.Count - 1 Then
            Exit For
        End If
        If i = 0 Then
            lngLeft = frmName.grdCol.Left + 1 * Screen.TwipsPerPixelX
            lngWidth = 4 * frmName.FontSize * 10
            frmName.lblTotal(0).Move lngLeft, lngTop, lngWidth, lngHeight
            frmName.lblTotal(0).Visible = True
        Else
            If frmName.grdCol.ColIsVisible(i) And frmName.grdCol.ColWidth(i) > 0 Then
                ' frmname.lblTotal(i) is visible
                If frmName.grdCol.ColPos(i) + frmName.grdCol.ColWidth(i) > frmName.grdCol.Width Then
                    lngLeft = frmName.grdCol.Left + frmName.grdCol.ColPos(i) + 2 * intSpace
                    lngWidth = IIf(frmName.grdCol.Width - frmName.grdCol.ColPos(i) - intGrdBorderWidth - 4 * intSpace > 0, _
                                    frmName.grdCol.Width - frmName.grdCol.ColPos(i) - intGrdBorderWidth - 4 * intSpace, 0)
                Else
                    lngLeft = frmName.grdCol.Left + frmName.grdCol.ColPos(i) + 2 * intSpace
                    lngWidth = IIf(frmName.grdCol.ColWidth(i) - 4 * intSpace > 0, _
                                    frmName.grdCol.ColWidth(i) - 4 * intSpace, 0)
                End If
            End If
            If frmName.grdCol.LeftCol = i Or (frmName.grdCol.LeftCol = 0 And i = 1) Then
                lngLeft = lngLeft + 5 * frmName.FontSize * 10
                lngWidth = lngWidth - 5 * frmName.FontSize * 10
            End If
            frmName.lblTotal(i).Move lngLeft, lngTop, lngWidth, lngHeight
            frmName.lblTotal(i).Alignment = IIf(ColProperty(i).lngCtrType = TCurrency, 1, 0)
            frmName.lblTotal(i).Visible = frmName.grdCol.ColIsVisible(i) And _
                                frmName.grdCol.ColWidth(i) > 0
        End If
    Next i
End Sub
Private Sub grdColWidthAdjust()
  Dim inti As Integer
  Dim lngSumWidthOfCols As Long
    frmName.grdCol.ColWidth(0) = 0
        
 '-----------------------
    lngSumWidthOfCols = 0
    For inti = 1 To frmName.grdCol.Cols - 1
        lngSumWidthOfCols = lngSumWidthOfCols + frmName.grdCol.ColWidth(inti)
    Next inti
    If lngSumWidthOfCols = 0 Then
        lngSumWidthOfCols = frmName.grdCol.Width
    End If
    If lngSumWidthOfCols < frmName.grdCol.Width - grdBorderWidth Then
        For inti = 0 To frmName.grdCol.Cols - 1
            frmName.grdCol.ColWidth(inti) = frmName.grdCol.ColWidth(inti) / lngSumWidthOfCols * (frmName.grdCol.Width)
        Next inti
    End If
End Sub


Public Sub ButtonLocal(ByVal lngRowNo As Long, ByVal lngColNo As Long, Optional ByVal blnCtrNotResize As Boolean = False)
 'CommandButton 的上下位置及当前可视性
 'GRD当前行上的粘贴控件上下左右位置调整及当前可视性
    GrdInputButtonLocal lngRowNo, lngColNo, blnCtrNotResize
'合计框
    TotalRowAdjust
'    及第三栏控件组
'    Special3Col blnHScroll, blnVScroll
End Sub
Private Sub GrdInputButtonLocal(ByVal lngRowNo As Long, ByVal lngColNo As Long, Optional ByVal blnCtrNotResize As Boolean = False)
'CommandButton 的上下位置及当前可视性
'GRD当前行上的粘贴控件上下左右位置调整及当前可视性
'blnCtrNotResize=true 时表示粘贴控件不改变大小
    Dim i As Integer
    Dim blnHscroll As Boolean
    Dim blnVscroll As Boolean
    Dim lngUsableHeight As Long    'GRID有效高度
    Dim lngUsableWidth As Long     'GRID有效宽度
    Dim lngL As Long, lngT As Long, lngW As Long, lngH As Long
    If Not My.blnCtrlBinding Then
        ' 未绑定grd输入控件状态
        Exit Sub
    End If
    If lngRowNo < frmName.grdCol.FixedRows Or lngRowNo > frmName.grdCol.Rows - 1 _
        Or lngColNo < 1 And lngColNo > frmName.grdCol.Cols - 1 Then
        Exit Sub
    End If
'   grd上粘贴的输入控件
    If ctrInput Is Nothing Then Exit Sub
    ctrInput.Visible = False
    
    If Not blnRowIsVisible(lngRowNo) Then
        Exit Sub
    End If
    
    ScrollBarExist blnHscroll, blnVscroll
    If blnHscroll Then
        lngUsableHeight = frmName.grdCol.Height - gclsEniv.HScrollHeight
    Else
        lngUsableHeight = frmName.grdCol.Height
    End If
    If blnVscroll Then
        lngUsableWidth = frmName.grdCol.Width - gclsEniv.VScrollWidth
    Else
        lngUsableWidth = frmName.grdCol.Width - intGrdBorderWidth
    End If
      
    If frmName.grdCol.ColIsVisible(frmName.grdCol.Col) And frmName.grdCol.ColWidth(frmName.grdCol.Col) > 0 Then
        If Not blnCtrNotResize Then
            lngT = frmName.grdCol.Top + frmName.grdCol.RowPos(lngRowNo) + 0 * intSpace
            lngL = frmName.grdCol.Left + frmName.grdCol.ColPos(lngColNo) + 0 * intSpace
            If frmName.grdCol.ColPos(lngColNo) + frmName.grdCol.ColWidth(lngColNo) > lngUsableWidth Then
                lngW = lngUsableWidth - frmName.grdCol.ColPos(lngColNo) - 2 * intSpace
            Else
                lngW = IIf(frmName.grdCol.ColWidth(lngColNo) - 2 * intSpace > 0, _
                                        frmName.grdCol.ColWidth(lngColNo) - 2 * intSpace, 0)
            End If
'            If frmname.grdCol.RowPos(lngRowNo) + frmname.grdCol.RowHeight(lngRowNo) > lngUsableHeight Then
'                lngH = lngUsableHeight - frmname.grdCol.RowPos(lngRowNo) - 4 * intSpace
'            Else
'                lngH = frmname.grdCol.RowHeight(lngRowNo) - 1 * intSpace
'            End If
            If frmName.grdCol.RowPos(lngRowNo) + frmName.grdCol.RowHeight(0) > lngUsableHeight Then
                lngH = lngUsableHeight - frmName.grdCol.RowPos(lngRowNo) - 4 * intSpace
            Else
                lngH = frmName.grdCol.RowHeight(0) - 0 * intSpace
            End If
            If lngT < frmName.grdCol.Top + frmName.grdCol.RowHeight(0) Or _
                lngT + lngH > frmName.grdCol.Top + lngUsableHeight Or _
                lngL < frmName.grdCol.Left Or _
                lngL > frmName.grdCol.Left + lngUsableWidth Then
                Exit Sub
            Else
                If lngW <= 0 Or lngH <= 0 Then
                    ctrInput.Visible = False
                Else
                    ctrInput.Move lngL, lngT, lngW, lngH
                    ctrInput.Visible = True
                End If
            End If
        Else
            If frmName.grdCol.Col >= 3 Then
                If frmName.grdCol.ColPos(lngColNo) + frmName.grdCol.ColWidth(lngColNo) > lngUsableWidth Then
                    lngW = lngUsableWidth - frmName.grdCol.ColPos(lngColNo) - 2 * intSpace
                Else
                    lngW = IIf(frmName.grdCol.ColWidth(lngColNo) - 2 * intSpace > 0, _
                                        frmName.grdCol.ColWidth(lngColNo) - 2 * intSpace, 0)
                End If
                If lngW < ctrInput.Width Then lngW = ctrInput.Width
            Else
                lngW = ctrInput.Width
            End If
            lngT = frmName.grdCol.Top + frmName.grdCol.RowPos(lngRowNo) + 0 * intSpace
            lngL = frmName.grdCol.Left + frmName.grdCol.ColPos(lngColNo) + 0 * intSpace
            lngH = ctrInput.Height
                        
            If lngL + lngW > frmName.grdCol.Left + lngUsableWidth Then
                lngL = frmName.grdCol.Left + lngUsableWidth - lngW
            End If
            If lngT < frmName.grdCol.Top + frmName.grdCol.RowHeight(0) Or _
                lngT > frmName.grdCol.Top + lngUsableHeight Or _
                lngL < frmName.grdCol.Left Or _
                lngL > frmName.grdCol.Left + lngUsableWidth Then
                Exit Sub
            Else
                ctrInput.Move lngL, lngT, lngW, lngH
                ctrInput.Visible = True
            End If
        End If
    End If
    
'    Special3Col blnHScroll, blnVScroll
    ctrInput.ZOrder 0
End Sub

Public Sub InsertARow(Optional ByVal blnBeforeOrAppend As Boolean = True)
'参数： blnBeforeOrAppend=True 时在当前行前插入一行
'       blnBeforeOrAppend=False时在最后添加一行

    Dim i%, j%
    With frmName.grdCol
        .Redraw = False
        If .Rows = 1 Then
            blnBeforeOrAppend = False
        End If
        If blnBeforeOrAppend Then
            .Rows = .Rows + 1
            For i% = .Rows - 1 To .Row + 1 Step -1
                For j% = 0 To .Cols - 1
                    .TextMatrix(i%, j%) = .TextMatrix(i% - 1, j%)
                Next j%
            Next i%
            For j% = 0 To .Cols - 1
                .TextMatrix(.Row, j%) = ""
            Next j%

        Else
            .Rows = .Rows + 1
        End If
        Dim lngR As Long, lngC As Long
        lngR = .Row
        lngC = .Col
        .Row = .Rows - 1
        For i% = 1 To .Cols - 1
            If ColProperty(i%).blnReadOnly Then
                .Col = i%
                .CellBackColor = RGB(192, 192, 192)
            End If
        Next i%
        .Row = lngR
        .Col = lngC
        .Redraw = True
        If .Rows = 2 Then
            grdCol_EnterCell
        End If
    End With
    BuildNoteMsg True
End Sub
Public Sub CopyAccountProperty(ByVal lngRow As Long)
    Dim intB As Integer
    Dim intF As Integer
    Dim recTmp As Recordset
    Set recTmp = gclsBase.BaseDB.OpenRecordset( _
        "SELECT * FROM Account WHERE lngAccountID=" & _
                            C2Lng(frmName.grdCol.TextMatrix(lngRow, ColProperty(2).bytGrdIDCol)), _
                            dbOpenSnapshot)
    If recTmp Is Nothing Then
        Exit Sub
    End If
    If recTmp.RecordCount = 0 Then
        recTmp.Close
        Exit Sub
    End If
    With recTmp
            .MoveFirst
                    
        '币种
        intB = 5
        intF = 12
        If C2Lng(frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol)) <= 1 Then
            frmName.grdCol.TextMatrix(lngRow, intB) = frmName.lblField(intF).Caption
            frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol) = Field(intF).lngID
        End If
        '汇率
        intB = 6
        intF = 11
        frmName.grdCol.TextMatrix(lngRow, intB) = frmName.lblField(intF).Caption
        '单位
        If !blnIsCustomer Then
            frmName.grdCol.TextMatrix(lngRow, 10) = frmName.lblHead(1).Caption
            frmName.grdCol.TextMatrix(lngRow, ColProperty(10).bytGrdIDCol) = frmName.lblHead(0).Tag
        Else
            frmName.grdCol.TextMatrix(lngRow, 10) = ""
            frmName.grdCol.TextMatrix(lngRow, ColProperty(10).bytGrdIDCol) = "1"
        End If
        '部门
        intB = 11
        intF = 4
        If !blnIsDepartment Then
            frmName.grdCol.TextMatrix(lngRow, intB) = frmName.lblField(intF).Caption
            frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol) = Field(intF).lngID
        Else
            frmName.grdCol.TextMatrix(lngRow, intB) = ""
            frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol) = "1"
        End If
        '职员
        intB = 12
        intF = 3
        If !blnIsEmployee Then
            frmName.grdCol.TextMatrix(lngRow, intB) = frmName.lblField(intF).Caption
            frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol) = Field(intF).lngID
        Else
            frmName.grdCol.TextMatrix(lngRow, intB) = ""
            frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol) = "1"
        End If
        '工程
        intB = 13
        intF = 8
        If !blnIsJob Then
            frmName.grdCol.TextMatrix(lngRow, intB) = frmName.lblField(intF).Caption
            frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol) = Field(intF).lngID
        Else
            frmName.grdCol.TextMatrix(lngRow, intB) = ""
            frmName.grdCol.TextMatrix(lngRow, ColProperty(intB).bytGrdIDCol) = "1"
        End If
        '统计
        intB = 14
        intF =