frmtransvoucher.frm

金算盘软件代码

Private SpaceTwRow As Integer '= 15 '单据头控件之行距
Dim strColRow() As String       '单据体行复制/粘贴存储区
Dim ColBill As New Collection   '单据内容集合(不包括TransVoucherID和DetailID)

Dim My As clsBillMark           '自定义标志类对象
Dim WithEvents mclsSubClass As SubClass32.SubClass  'Grid回调函数对象
Attribute mclsSubClass.VB_VarHelpID = -1
Dim WithEvents mclsHook As SubClass32.SubClass      '窗体回调函数对象
Attribute mclsHook.VB_VarHelpID = -1
Dim WithEvents KeyPressHook As Hook
Attribute KeyPressHook.VB_VarHelpID = -1
Dim WithEvents mclsMainControl As MainControl       '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Dim ctrInput As Object            '通用输入控件
Dim ctrPicInput As Object         '列表输入为PIC方式时的输入控件
Dim Field(3) As ClassField        '表头输入控件的附加属性
Dim PicLbl(10) As ClassPicInputField        'PIC输入时的附加属性
Dim ColProperty(33) As ClassGridProperty    'GRID附加属性
Dim FormClipRect As RECT
Dim GridClipRect As RECT
Dim frmColor As FormColor
Dim lngCurVoucherID As Long     '当前的凭证ID
Dim intGrdBorderWidth As Long
Dim intGrdBorderHeight As Long
Dim lngOldID As Long
Dim strOldText As String
Dim blnCanSave As Boolean
Dim blnBusy As Boolean
Dim strFunction As String
Dim blnIsVoucher As Boolean     '是否已经生成了凭证
Dim blnKeyDown As Boolean
Dim blnButtonDisable As Boolean
Dim blnNotScroll As Boolean
Dim blnShowWizard As Boolean    '是否是从公式窗口进入的
Dim blnNotRaiseEvent As Boolean '是否不激活事件标志
Dim blnUnloaded As Boolean  '是否已经UNLOAD 窗口标志
Dim clsRed As RecordClass
Dim clsBase As BaseFunction
Dim lngPreViewDigit As Long '预演时对凭证号的保存变量
Dim blnZeroRecordNum As Boolean '
Dim strOldFre As String     '保存旧的转帐周期
Dim ReceiptID As Long       '单据ID
Dim blnEdit As Boolean  '修改权限
Dim blnView As Boolean  '查看权限

Dim lngVoucherTypeType As Long '凭证类型的类型（受付转）
Dim blnMouseDown As Boolean


Private Sub GrdAndLabelInitial()
'列表及LABEL控件初始化
    Dim intI As Integer
    '--------------------------
    '转帐凭证只显示1--8列
    '--------------------------
    grdCol.ColWidth(0) = 0
    
    For intI = 9 To grdCol.Cols - 1
        grdCol.ColWidth(intI) = 0
    Next intI
    For intI = 1 To 8
        If grdCol.ColWidth(intI) = 0 Then
            grdCol.ColWidth(intI) = ColProperty(intI).lngColWidth
        End If
    Next intI
End Sub
Private Sub FieldButton()
 'fields控件位置调整
    Dim i As Integer
    Dim lngL As Long
    Dim bln5RowIsVisible
    
    If Me.WindowState = 1 Then Exit Sub
    If Not Me.Visible Then Exit Sub
    '------------------------------
    On Error Resume Next
    If Me.width < lngDefaultWidth Then
        Me.width = lngDefaultWidth
    End If
    If Me.Height < lngDefaultHeight Then
        Me.Height = lngDefaultHeight
    End If
    On Error GoTo 0
    '-------------------------------
    bln5RowIsVisible = False
    If WanNeng Then
        LblBack.Move 50, tblReceipt.Height + 30 * Screen.TwipsPerPixelY, Me.ScaleWidth - 75 - 75, Me.ScaleHeight - (tblReceipt.Height + 22 * Screen.TwipsPerPixelY) - 50 - 75
    Else
        LblBack.Move 50, LblBack.top, Me.ScaleWidth - cmdButton(0).width - 75 - 50 - 75 - 50, Me.ScaleHeight - LblBack.top - 50 - 75
    End If
    
    lblCaption.Move LblBack.Left + LblBack.width \ 2 - lblCaption.width \ 2, LblBack.top + 3 * Screen.TwipsPerPixelY
    
    lblFieldCaption(0).Move LblBack.Left + 75, lblCaption.top + lblCaption.Height + 50, _
                8 * lblFieldCaption(0).FontSize * 10, lblFieldCaption(0).FontSize * 22
   
    lblFU.Move LblBack.Left + LblBack.width - 100 - lblFU.width, _
                  lblFieldCaption(0).top
    
    lblField(0).Move lblFieldCaption(0).Left + lblFieldCaption(0).width + 1 * Screen.TwipsPerPixelX, _
                     lblFieldCaption(0).top - 2 * Screen.TwipsPerPixelX, Field(0).bytFieldSize * Me.FontSize * 10, _
                     lblFieldCaption(0).Height + 4 * Screen.TwipsPerPixelX
            
    lblField(1).Move lblFU.Left - spinInput.width - 5 * Screen.TwipsPerPixelX, lblFU.top - 2 * Screen.TwipsPerPixelX, _
                    spinInput.width + 2 * Screen.TwipsPerPixelX, 285 + 0 * Screen.TwipsPerPixelX
    lblFieldCaption(1).Move lblField(1).Left - lblField(1).width + 2 * Screen.TwipsPerPixelX, lblFU.top, _
                    lblFieldCaption(1).width, lblField(1).Height - 10
    
    lblField(0).Visible = True
    lblFieldCaption(0).Visible = True
    lblField(1).Visible = True
    lblFieldCaption(1).Visible = True
 '备注栏的位置调整
    Dim lngMemoTop As Long
    lngMemoTop = LblBack.top + LblBack.Height - lblmemo(0).Height - 6 * Screen.TwipsPerPixelY - 100
    
    lblmemo(0).Move LblBack.Left + 5 * Screen.TwipsPerPixelX, _
                 lngMemoTop
    
    lblmemo(3).Move LblBack.Left + LblBack.width - 4 * Screen.TwipsPerPixelX - lblmemo(3).width, _
               lngMemoTop + 1 * Screen.TwipsPerPixelY
    lblmemo(2).Move lblmemo(3).Left - 3 * Screen.TwipsPerPixelX - lblmemo(2).width, _
                      lngMemoTop + 2 * Screen.TwipsPerPixelY
    lblmemo(1).Move lblmemo(0).Left + lblmemo(0).width + 3 * Screen.TwipsPerPixelX, _
                 lngMemoTop + 2 * Screen.TwipsPerPixelY, _
                 lblmemo(2).Left - 3 * Screen.TwipsPerPixelX - (lblmemo(0).Left + lblmemo(0).width + 3 * Screen.TwipsPerPixelX)
'GRID位置调整
    grdCol.Redraw = False
    bln5RowIsVisible = True
    Dim lngTop As Long
    If bln5RowIsVisible Then
        lngTop = lblField(0).top + lblField(0).Height + SpaceTwRow * 4
    Else
        lngTop = lblFieldCaption(lblField.Count - 1).top + SpaceTwRow
    End If
    grdCol.Move LblBack.Left + 120, lngTop + 45, LblBack.width - 2 * 50 - 120, _
                LblBack.Height - (lngTop + 45 - LblBack.top) - 445
    grdColWidthAdjust
    If Me.Visible = False Then
        SetFrmColor
    End If
    lngL = Me.ScaleWidth - cmdButton(0).width - 75
    For i = 0 To cmdButton.Count - 1
        If WanNeng Then
            cmdButton(i).Left = -2000
        Else
            cmdButton(i).Left = lngL
        End If
    Next i
    grdCol.Redraw = True
End Sub
Private Sub grdColWidthAdjust()
  Dim intI As Integer
  Dim lngSumWidthOfCols As Long
    grdCol.ColWidth(0) = 0
        
 '-----------------------
    lngSumWidthOfCols = 0
    For intI = 1 To grdCol.Cols - 1
        lngSumWidthOfCols = lngSumWidthOfCols + grdCol.ColWidth(intI)
    Next intI
    If lngSumWidthOfCols = 0 Then
        lngSumWidthOfCols = grdCol.width
    End If
    For intI = 0 To grdCol.Cols - 1
        grdCol.ColWidth(intI) = ColProperty(intI).lngColWidth 'grdCol.ColWidth(inti) / lngSumWidthOfCols * (grdCol.Width)
        If intI > 8 Then grdCol.ColWidth(intI) = 0
    Next intI
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
    Dim blnPicIsOne As Boolean
    If Not My.blnCtrlBinding Then
        ' 未绑定grd输入控件状态
        Exit Sub
    End If
    If lngRowno < grdCol.FixedRows Or lngRowno > grdCol.Rows - 1 _
        Or lngColNo < 1 And lngColNo > grdCol.Cols - 1 Then
        Exit Sub
    End If
'   grd上粘贴的输入控件
    If ctrInput Is Nothing Then Exit Sub
    ctrInput.Move -5000, -5000
    If Not ctrPicInput Is Nothing Then
        ctrPicInput.Move -5000, -5000
    End If
    txtInput.Move -5000
    If UCase(ctrInput.Name) = UCase("imgExproler") Then
        '按钮不调整大小
        ctrInput.Move -5000
        Exit Sub
    End If
    
    If Not blnRowIsVisible(lngRowno) Then
        Exit Sub
    End If
    If grdCol.ColWidth(grdCol.col) < 490 Then
        grdCol.ColWidth(grdCol.col) = 490
    End If
    
    ScrollBarExist blnHscroll, blnVscroll
    If blnHscroll Then
        lngUsableHeight = grdCol.Height - gclsEniv.HScrollHeight
    Else
        lngUsableHeight = grdCol.Height
    End If
    If blnVscroll Then
        lngUsableWidth = grdCol.width - gclsEniv.VScrollWidth
    Else
        lngUsableWidth = grdCol.width - intGrdBorderWidth
    End If
    If blnCtrNotResize Then
        If ctrInput.Name = "picInput" Then
            If lblInput.UBound = 0 Then
                blnCtrNotResize = False
                blnPicIsOne = True
            End If
        End If
    Else
        blnPicIsOne = True
    End If

    If grdCol.ColIsVisible(grdCol.col) And grdCol.ColWidth(grdCol.col) > 0 Then
        If Not blnCtrNotResize Then
            lngT = grdCol.top + grdCol.RowPos(lngRowno) + 2 * IntSpace
            lngL = grdCol.Left + grdCol.ColPos(lngColNo) + IntSpace
            If grdCol.ColPos(lngColNo) + grdCol.ColWidth(lngColNo) > lngUsableWidth Then
                lngW = lngUsableWidth - grdCol.ColPos(lngColNo) - 2 * IntSpace
            Else
                lngW = IIf(grdCol.ColWidth(lngColNo) - 2 * IntSpace > 0, _
                                        grdCol.ColWidth(lngColNo) - 2 * IntSpace, 0)
            End If
            If grdCol.RowPos(lngRowno) + grdCol.RowHeight(0) > lngUsableHeight Then
                lngH = lngUsableHeight - grdCol.RowPos(lngRowno) - 4 * IntSpace
            Else
                lngH = grdCol.RowHeight(0) - 2 * IntSpace
            End If
            
            If lngT < grdCol.top + grdCol.RowHeight(0) Or _
                lngT + lngH > grdCol.top + lngUsableHeight Or _
                lngL < grdCol.Left Or _
                lngL > grdCol.Left + lngUsableWidth Then
                Exit Sub
            Else
                ctrInput.Move lngL, lngT - 0 * Screen.TwipsPerPixelY, lngW, lngH - 1 * Screen.TwipsPerPixelY
                ctrInput.Visible = True
            End If
        Else
            If grdCol.col >= 2 Then
                If grdCol.ColPos(lngColNo) + grdCol.ColWidth(lngColNo) > lngUsableWidth Then
                    lngW = lngUsableWidth - grdCol.ColPos(lngColNo) - 2 * IntSpace
                Else
                    lngW = IIf(grdCol.ColWidth(lngColNo) - 2 * IntSpace > 0, _
                                        grdCol.ColWidth(lngColNo) - 2 * IntSpace, 0)
                End If
                
                Dim intijk As Integer
                For intijk = 0 To lblInput.Count - 1
                    lblInput(intijk).Move lblInput(intijk).Left, lblInput(intijk).top, _
                                         lngW - lblInput(intijk).Left
                    If PicLbl(intijk).lngCtrType = TRefer Then ' And UCase(TypeName(ctrPicInput)) = "LISTTEXT"
                         imgPicDown(intijk).Move lblInput(intijk).Left + lblInput(intijk).width - imgPicDown(intijk).width - 1 * Screen.TwipsPerPixelY, _
                                             lblInput(intijk).top + 0 * Screen.TwipsPerPixelY
                    End If
                Next intijk
                If My.bytIndex >= 0 And My.bytIndex <= lblInput.Count - 1 Then
                    If Not ctrPicInput Is Nothing Then
                        If PicLbl(My.bytIndex).lngCtrType = TRefer Then 'And UCase(TypeName(ctrPicInput)) = "LISTTEXT"
                            'ctrPicInput.Visible = False
                            ctrPicInput.Move -5000
                            ctrPicInput.Move lblInput(My.bytIndex).Left + 1 * Screen.TwipsPerPixelX, 0, lblInput(My.bytIndex).width - 2 * Screen.TwipsPerPixelX, lblInput(My.bytIndex).Height + 15
                        End If
                    End If
                End If
            Else
                lngW = ctrInput.width
            End If
            lngT = grdCol.top + grdCol.RowPos(lngRowno) + 2 * IntSpace
            lngL = grdCol.Left + grdCol.ColPos(lngColNo) + IntSpace
            lngH = ctrInput.Height
                        
            If lngL + lngW > grdCol.Left + lngUsableWidth Then
                lngL = grdCol.Left + lngUsableWidth - lngW
            End If
            If lngT < grdCol.top + grdCol.RowHeight(0) Or _
                lngT > grdCol.top + lngUsableHeight Or _
                lngL < grdCol.Left Or _
                lngL > grdCol.Left + lngUsableWidth Then
                Exit Sub
            Else
                ctrInput.Move lngL, lngT, lngW, lngH
                ctrInput.Visible = True
            End If
        End If
    End If
    If blnPicIsOne And ctrInput.Name = "picInput" Then
        lblInput(0).Move 0, 0 * Screen.TwipsPerPixelY, picInput.width  ', picInput.Height
        If Not ctrPicInput Is Nothing Then
            ctrPicInput.Move lblInput(0).Left, lblInput(0).top, picInput.width
        End If
'    ElseIf Not ctrPicInput Is Nothing Then
'        If My.bytRegion = FPicture And My.lngOldCol = lngColNo Then
'            ctrPicInput.Move lblInput(My.bytIndex).Left, lblInput(My.bytIndex).top, lblInput(My.bytIndex).width
'        ElseIf lngColNo >= 2 Then
'            ctrPicInput.Move ctrPicInput.Left, ctrPicInput.top, lblInput(1).width
'        End If
    End If
    
    ctrInput.ZOrder 0
    If Not ctrPicInput Is Nothing Then
        On Error Resume Next
        If ctrPicInput.Enabled And ctrPicInput.Visible Then ctrPicInput.SetFocus
    End If

End Sub
' 模板变化时从TEMPLATEFORMAT表中取出模板信息控制显示界面
Private Sub TemplateChange(ByVal lngTempID As Long)
    My.blnRefresh = False
    My.blnCtrlBinding = False
    GrdAndLabelInitial
    FieldButton
    My.blnRefresh = True
    My.blnCtrlBinding = True
End Sub

Private Sub cmbInput_Click()
    SaveInput2Form
End Sub

Private Sub cmbInput_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeySpace Then
        SendKeys "%{Down}"
    End If
End Sub
Private Sub Button_Click(Index As Integer)
    On Error Resume Next
    SaveInput2Form
    
    If grdCol.Rows - 1 >= 1 Then
        If blnNotNullRow(grdCol.Rows - 1) = False Then
            grdCol.TextMatrix(grdCol.Rows - 1, 1) = ""
        End If
    End If
    
    
    If Not ctrPicInput Is Nothing Then
        ctrPicInput.Move -10000, -5000
    End If
    If Not ctrInput Is Nothing Then
        If UCase(ctrInput.Name) = UCase("SpinInput1") Then
        Else
            ctrInput.Move -10000, -5000
        End If
    End If
    txtInput.Visible = False