frmvoucher.frm

金算盘软件代码

                lngLeft = lblTotal(0).Left + lblTotal(0).width + 2 * IntSpace
                lngWidth = IIf(GrdCol.width - GrdCol.ColPos(4) - 0 * intGrdBorderWidth - 1 * IntSpace - lblTotal(0).width > 0, _
                                     GrdCol.ColPos(4) - 0 * intGrdBorderWidth - 1 * IntSpace - lblTotal(0).width, GrdCol.width - intGrdBorderWidth - 6 * IntSpace - lblTotal(0).width)
        ElseIf i = 2 Then
            lngLeft = GrdCol.Left + GrdCol.ColPos(5) + GrdCol.ColWidth(5) + 1 * IntSpace
            If lngLeft > GrdCol.Left + GrdCol.width Then
                lngLeft = GrdCol.Left + GrdCol.width
                lngWidth = 0
            Else
                lngWidth = IIf(GrdCol.Left + GrdCol.width - lngLeft - 2 * IntSpace > 0, _
                                GrdCol.Left + GrdCol.width - lngLeft - 2 * IntSpace, 0)
            End If
        End If
        If i <> 3 Then
            lblTotal(i).Move lngLeft - picFooter.Left, lngTop + 4 * Screen.TwipsPerPixelY, lngWidth, intTotalRowHeight - 4 * Screen.TwipsPerPixelY
        Else
            lblTotal(i).Move lblTotal(1).Left, 1 * Screen.TwipsPerPixelY, lblTotal(1).width, intTotalRowHeight - 4 * Screen.TwipsPerPixelY
        End If
        If i = 0 Then
            lblTotal(i).Visible = True
        Else
            If blnCashLine And (i = 4 Or i = 5) Then
                lblTotal(i).Visible = False
            ElseIf i = 3 Then
                lblTotal(i).Visible = True
            Else
                lblTotal(i).Visible = GrdCol.ColIsVisible(i) And GrdCol.ColWidth(i) > 0
            End If
        End If
    Next i
    RefreshRect picFooter.hwnd, GrdCol.Left - picFooter.Left - 0 * Screen.TwipsPerPixelY, 1 * Screen.TwipsPerPixelX, GrdCol.Left - picFooter.Left + GrdCol.width, intTotalRowHeight + 3 * Screen.TwipsPerPixelY
End Sub
Private 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 Long
    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
    If lngColNo <= 1 Then
        ctrInput.Move -10000, -5000, IIf(GrdCol.ColWidth(lngColNo) - 2 * IntSpace - 2 * SpaceTwRow > 0, GrdCol.ColWidth(lngColNo) - 2 * SpaceTwRow - 2 * IntSpace, 0), 2 * lngOldHeight - 8 * IntSpace
    End If
    If Not blnRowIsVisible(lngRowno) Then
        If ctrInput.Visible Then
            If dtmInput.Left >= 0 Then dtmInput.Move -5000, -5000
            If dtmInput.Visible = False Then
              dtmInput.Visible = True
            End If
            dtmInput.SetFocus
            ctrInput.Visible = False
        End If
        Exit Sub
    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(lngColNo) And GrdCol.ColWidth(lngColNo) > 0 Then
        If Not blnCtrNotResize Then
            lngT = GrdCol.top + GrdCol.RowPos(lngRowno) + 0 * IntSpace
            lngL = GrdCol.Left + GrdCol.ColPos(lngColNo) + 0 * IntSpace
            If GrdCol.ColPos(lngColNo) + GrdCol.ColWidth(lngColNo) > lngUsableWidth Then
                lngW = lngUsableWidth - GrdCol.ColPos(lngColNo) - 0 * IntSpace
            Else
                lngW = IIf(GrdCol.ColWidth(lngColNo) - 0 * IntSpace > 0, _
                                        GrdCol.ColWidth(lngColNo) - 1 * IntSpace, 0)
            End If
            If GrdCol.RowPos(lngRowno) + lngOldHeight + 2 * IntSpace > lngUsableHeight Then
                lngH = lngUsableHeight - GrdCol.RowPos(lngRowno) - 2 * IntSpace
            ElseIf ctrInput.Name <> "picInput" Then
                lngH = lngOldHeight
            Else
                lngH = 2 * lngOldHeight - 0 * IntSpace
            End If
            If lngT < GrdCol.top + lngOldHeight Or _
                lngT + lngH > GrdCol.top + lngUsableHeight Or _
                lngL < GrdCol.Left Or _
                lngL > GrdCol.Left + lngUsableWidth Then
                Exit Sub
            Else
'                If ctrInput.Name = "picInput" Then
'                    lngH = lngH + 2 * Screen.TwipsPerPixelY
'                End If
                If lngW - 2 * SpaceTwRow > 0 Then
                    If Not ctrPicInput Is Nothing Then ctrPicInput.Move 0, 0, lngW - 0 * SpaceTwRow
                    ctrInput.Move lngL + 0 * SpaceTwRow, lngT + 0 * SpaceTwRow, lngW - 0 * SpaceTwRow, lngH - 1 * SpaceTwRow
'                    ctrInput.Visible = True
                Else
                    ctrInput.Visible = False
                    Exit Sub
                End If
            End If
        Else
            If lngColNo >= 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
                If lngW < ctrInput.width Then
                    lngW = ctrInput.width
                Else
                    Dim intJ As Integer
                    For intJ = 0 To lblInput.Count - 1
                        lblInput(intJ).Move lblInput(intJ).Left, lblInput(intJ).top, _
                                             lngW - lblInput(intJ).Left
                        If PicLbl(intJ).lngCtrType = TRefer Then
                             imgPicDown(intJ).Move lngW - imgPicDown(intJ).width
                        End If
                    Next intJ
                    If Not ctrPicInput Is Nothing Then ctrPicInput.Move ctrPicInput.Left, ctrPicInput.top, lngW - ctrPicInput.Left
                End If
            Else
                lngW = ctrInput.width
            End If
            lngT = GrdCol.top + GrdCol.RowPos(lngRowno) + 0 * 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 + lngOldHeight Or _
                lngT > GrdCol.top + lngUsableHeight Or _
                lngL < GrdCol.Left Or _
                lngL > GrdCol.Left + lngUsableWidth Then
                Exit Sub
            Else
                ctrInput.Move lngL + SpaceTwRow, lngT + SpaceTwRow, lngW, lngH
 '               ctrInput.Visible = True
            End If
        End If
    End If
    
    If blnPicIsOne Then
        lblInput(0).Move 0, lngOldHeight \ 2 + 1 * Screen.TwipsPerPixelY, picInput.width  ', picInput.Height
'        If PicLbl(0).lngCtrType = TRefer Then
'            imgPicDown(0).Move picInput.Width - imgPicDown(0).Width, _
'                                        0, imgPicDown(0).Width, lngOldHeight
'        End If
        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
    
    blnPaint = True
'    UpdateWindow GrdCol.hwnd
    If ctrInput.Visible = False Then
        ctrInput.Visible = True
        ctrInput.ZOrder 0
    End If
    
    On Error Resume Next
    ctrInput.Refresh
    If frmMain.ActiveForm.Name = Me.Name Then
        If Not ctrPicInput Is Nothing Then
             If ctrPicInput.Enabled And ctrPicInput.Visible Then ctrPicInput.SetFocus
        End If
    End If
End Sub
' 模板变化时从TEMPLATEFORMAT表中取出模板信息控制显示界面
Private Sub TemplateChange(ByVal lngTempID As Long)
'    blnCashLine = True
    Dim i As Long
    Dim recTmpF As rdoResultset
    Dim bytOldCodeType As Byte
    Dim GrdRow As Long
    
    bytOldCodeType = ColProperty(2).bytCodeType
    On Error Resume Next
    GrdRow = GrdCol.Row
    Set recTmpF = gclsBase.BaseDB.OpenResultset( _
    "SELECT lngPrintSetupID FROM template Where lngtemplateId =" & lngTempID, rdOpenForwardOnly)
    If recTmpF.EOF Then
        recTmpF.Close
        Set recTmpF = Nothing
        Exit Sub
    End If
    lngPrintSetupID = recTmpF!lngPrintSetupID
  
    GrdCol.Redraw = False
    Dim blnOldRefresh As Boolean
    Dim bytCodeType As Byte
    blnOldRefresh = My.blnRefresh
    My.blnRefresh = False
    My.blnCtrlBinding = False
    LblMemo(0).Tag = ""
    LblMemo(8).Tag = ""
   
   Set recTmpF = gclsBase.BaseDB.OpenResultset( _
    "SELECT * FROM templateformat Where lngtemplateId =" & lngTempID, rdOpenForwardOnly)
    With recTmpF
    Do While .EOF = False
        If !strControlType = "T" Then
            lblCaption.Caption = !strControlLabel
        ElseIf !strControlType = "C" Then
            If !bytOrder > 0 And !bytOrder <= GrdCol.Cols - 1 Then
                If !bytOrder = 2 Then
                    '4.编码+名称  5 编码+全称  1编码 2名称 3 全称
                    '6 编码+一级名称+倒数1级名称     '7 编码+一级名称+倒数2级名称
                    '8 编码+一级名称+倒数3级名称     '9 一级名称+倒数1级名称     '10 一级名称+倒数2级名称
                    '11 一级名称+倒数3级名称         '非层次编码 3 编码+名称 1 编码 2 名称
                    ColProperty(2).bytIsCodeField = !bytIsCodeField
                    ColProperty(2).bytCodeType = !bytCodeType
                End If
                ColProperty(!bytOrder).blnUsable = !blnIsScreen
'                ColProperty(!bytOrder).strColCaption = !strControlLabel
                ColProperty(!bytOrder).lngColWidth = (!bytFieldSize) * Me.FontSize * 10
            End If
        ElseIf !strControlType = "F" And !bytOrder = 1 And !blnIsScreen = 1 Then
                LblMemo(0).Tag = "1"
        ElseIf !strControlType = "O" And !bytOrder = 1 And !blnIsScreen = 1 Then
                LblMemo(8).Tag = "1"
        End If
        .MoveNext
    Loop
    End With
    recTmpF.Close
    Set recTmpF = Nothing
    
    #If conVersionType = 4 Then 'STAR Version
            ColProperty(3).blnUsable = False
    #End If
    GrdAndLabelInitial
    SetFrmColor
    FieldButton
    
    If bytOldCodeType <> ColProperty(2).bytCodeType Then
        With GrdCol
        For i = 1 To .Rows - 1
            .TextMatrix(i, 2) = strAccountName(C2lng(.TextMatrix(i, ColProperty(2).bytGrdIDCol)), ColProperty(2).bytCodeType)
        Next i
        End With
    End If
    If Not GrdCol.Visible Then GrdCol.Visible = True
    If GrdCol.Redraw = False Then GrdCol.Redraw = True
    If picFooter.Visible = False Then
        picFooter.Visible = True
        picFooter.ZOrder 0
    End If
    GrdCol.Row = GrdRow
    GrdCol.Refresh
    My.blnRefresh = blnOldRefresh

    My.blnCtrlBinding = True
    If WanNeng Then
        tblReceipt.Refresh
    End If
End Sub

Private Sub chkVoid_Click(ByVal Index As Integer)
    If Index = 0 And chkPrint(1).Value = 1 Then
        '作废
        blnNotChkClick = True
        chkPrint(1).Value = IIf(chkPrint(1).Value = 0, 1, 0)
        blnNotChkClick = False
        If ShowMsg(Me.hwnd, "本张凭证作废后如果保存将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "凭证作废") <> IDYES Then
            Exit Sub
        Else
            blnNotChkClick = True
            chkPrint(2).Value = 0
            chkPrint(1).Value = IIf(chkPrint(1).Value = 0, 1, 0)
            blnNotChkClick = False
        End If
        chkPrint(2).Value = 0
    ElseIf Index = 0 And chkPrint(1).Value = 0 Then
        If Trim(strError) <> "" Then
            chkPrint(2).Value = 1
        End If
    End If
    If chkPrint(Index + 1).Value <> 0 Then
        If chkPrint(2).Value <> 0 Then
            RefreshRect GrdCol.hwnd, (GrdCol.width - 140 * Screen.TwipsPerPixelX) \ 2, lngOldHeight + (GrdCol.Height - 70 * Screen.TwipsPerPixelY) \ 2, (GrdCol.width - 140 * Screen.TwipsPerPixelX) \ 2 + 140 * Screen.TwipsPerPixelX, lngOldHeight + (GrdCol.Height - 70 * Screen.TwipsPerPixelY) \ 2 + 70 * Screen.TwipsPerPixelY
        End If
        If chkPrint(1).Value <> 0 Then
            RefreshRect GrdCol.hwnd, (GrdCol.width - 140 * Screen.TwipsPerPixelX) \ 2, lngOldHeight + (GrdCol.Height - 70 * Screen.TwipsPerPixelY) \ 2, (GrdCol.width - 140 * Screen.TwipsPerPixelX) \ 2 + 140 * Screen.TwipsPerPixelX, lngOldHeight + (GrdCol.Height - 70 * Screen.TwipsPerPixelY) \ 2 + 70 * Screen.TwipsPerPixelY
        End If
    Else
        RefreshRect GrdCol.hwnd, (GrdCol.width - 140 * Screen.TwipsPerPixelX) \ 2, lngOldHeight + (GrdCol.Height - 70 * Screen.Twip