frmsetprex.frm

金算盘软件代码

    Dim strSql As String
    Dim strsql2 As String
    Dim recTmp As rdoResultset
#If conWan <> 16 Then
    strSql = "SELECT ReceiptType.lngReceiptTypeID as id, ReceiptType.strReceiptTypeName as ""单据类型"", ReceiptType.strPrexReceiptNO as ""单据前缀""," & _
    " ltrim(mm.strReceiptNO) || lpad(mm.lngReceiptNO,4 ,'0') as ""当期最大号""" & _
    " FROM ReceiptType,(Select ReceiptMaxNO.lngReceiptTypeID,ReceiptMaxNO.strReceiptNO, ReceiptMaxNO.lngReceiptNO " _
       & " from ReceiptMaxNO where ReceiptMaxNO.bytPeriod=" & CInt(cboYP(1).Text) & " and ReceiptMaxNO.intYear=" & CInt(cboYP(0).Text) & ") mm " & _
    " where ReceiptType.strPrexReceiptNO=mm.strReceiptNO(+) and ReceiptType.lngReceiptTypeID = mm.lngReceiptTypeID(+) and ReceiptType.lngReceiptTypeID not in (41,48,49,50,51,53) and " _
    & " Mod(ReceiptType.bytVersion ," & gVersionType * 2 & ")>=" & gVersionType
#Else
    If gclsBase.ControlAccount Or Not gclsBase.BaseNoControl Then
        strSql = "SELECT ReceiptType.lngReceiptTypeID as id, ReceiptType.strReceiptTypeName as ""单据类型"", ReceiptType.strPrexReceiptNO as ""单据前缀""," & _
            " ltrim(mm.strReceiptNO) || lpad(mm.lngReceiptNO,4 ,'0') as ""当期最大号""" & _
            " FROM ReceiptType,(Select ReceiptMaxNO.lngReceiptTypeID,ReceiptMaxNO.strReceiptNO, ReceiptMaxNO.lngReceiptNO " _
               & " from ReceiptMaxNO where ReceiptMaxNO.bytPeriod=" & CInt(cboYP(1).Text) & " and ReceiptMaxNO.intYear=" & CInt(cboYP(0).Text) & ") mm " & _
            " Where  ReceiptType.strPrexReceiptNO=mm.strReceiptNO(+) and ReceiptType.lngReceiptTypeID = mm.lngReceiptTypeID(+)  " _
            & " And ReceiptType.lngReceiptTypeID not in (41,48,49,50,51,53) and ReceiptType.lngReceiptTypeID  IN (2,13,34,35,36,37,38,39,40,41,48,49,50,51,53,54,55) And Mod(ReceiptType.bytVersion ," & gVersionType * 2 & ")>=" & gVersionType
    Else
        #If conHos <> 1 Then
            strSql = "SELECT ReceiptType.lngReceiptTypeID as id, ReceiptType.strReceiptTypeName as ""单据类型"", ReceiptType.strPrexReceiptNO as ""单据前缀""," & _
                " ltrim(mm.strReceiptNO) || lpad(mm.lngReceiptNO,4 ,'0') as ""当期最大号""" & _
                " FROM ReceiptType,(Select ReceiptMaxNO.lngReceiptTypeID, ReceiptMaxNO.strReceiptNO,ReceiptMaxNO.lngReceiptNO " _
                   & " from ReceiptMaxNO where ReceiptMaxNO.bytPeriod=" & CInt(cboYP(1).Text) & " and ReceiptMaxNO.intYear=" & CInt(cboYP(0).Text) & ") mm " & _
                " Where  ReceiptType.strPrexReceiptNO=mm.strReceiptNO(+) and ReceiptType.lngReceiptTypeID = mm.lngReceiptTypeID(+)  " _
                & " And ReceiptType.lngReceiptTypeID not in (41,48,49,50,51,53) and ReceiptType.lngReceiptTypeID  IN (41,48,49,50,51,53,54,55) And Mod(ReceiptType.bytVersion," & gVersionType * 2 & ")>=" & gVersionType
        #Else
            strSql = "SELECT ReceiptType.lngReceiptTypeID as id, ReceiptType.strReceiptTypeName as ""单据类型"", ReceiptType.strPrexReceiptNO as ""单据前缀""," & _
                " ltrim(mm.strReceiptNO) || lpad(mm.lngReceiptNO,4 ,'0') as ""当期最大号""" & _
                " FROM ReceiptType,(Select ReceiptMaxNO.lngReceiptTypeID, ReceiptMaxNO.strReceiptNO,ReceiptMaxNO.lngReceiptNO  " _
                   & " from ReceiptMaxNO where ReceiptMaxNO.bytPeriod=" & CInt(cboYP(1).Text) & " and ReceiptMaxNO.intYear=" & CInt(cboYP(0).Text) & ") mm " & _
                " Where  ReceiptType.strPrexReceiptNO=mm.strReceiptNO(+) and ReceiptType.lngReceiptTypeID = mm.lngReceiptTypeID(+) " _
                & " and ReceiptType.lngReceiptTypeID not in (41,48,49,50,51,53) And ReceiptType.lngReceiptTypeID  IN (41,48,49,50,51,53,54,55,56,57,58,59,60,61,62,63) And Mod(ReceiptType.bytVersion ," & gVersionType * 2 & ")>=" & gVersionType
                
        #End If
    End If
#End If
'    strsql2 = "SELECT ReceiptType.lngReceiptTypeID as id, ReceiptType.strReceiptTypeName as ""单据类型"", ' ' as ""单据前缀""," & _
'                " ltrim(mm.strPrex) || lpad(mm.lngReceiptNO,4 ,'0') as ""当期最大号""" & _
'                " FROM ReceiptType,(Select kk.lngReceiptTypeID, VoucherType.strVoucherTypeCode AS strPrex,kk.lngReceiptNO" _
'                   & " from ( Select *  From ReceiptMaxNO where ReceiptMaxNO.lngReceiptTypeID=41) kk ,VoucherType " & _
'                   " where to_number(kk.strReceiptNO)=VoucherType.lngVoucherTypeID(+)" & _
'                   " and kk.bytPeriod=" & CInt(cboYP(1).Text) & " and kk.intYear=" & CInt(cboYP(1).Text) & ") mm " & _
'                " Where  ReceiptType.strPrexReceiptNO=mm.strReceiptNO(+) and ReceiptType.lngReceiptTypeID = mm.lngReceiptTypeID(+) " _
'                & " and ReceiptType.lngReceiptTypeID =41"
'    strSql = strSql & " Union " & strsql2
    strSql = strSql & " Order by 1"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTmp.EOF Then recTmp.MoveLast
    Set datSource.Resultset = recTmp
    recTmp.Close
    Set recTmp = Nothing
End Sub
'初始化会计年度
Private Sub InitYear()
    Dim strSql As String
    Dim recTmp As rdoResultset
    strSql = "SELECT AccountYear.intYear as Num FROM AccountYear order By AccountYear.intYear "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    cboYP(0).Clear
    recTmp.MoveFirst
    With recTmp
        Do While Not .EOF
            cboYP(0).AddItem recTmp!Num
            .MoveNext
        Loop
    End With
    cboYP(0).Text = gclsBase.AccountYear
    mCurYear = CLng(cboYP(0).Text)
End Sub

'初始化会计期间
'SELECT AccountPeriod.bytPeriod, AccountPeriod.bytPeriod
'FROM AccountPeriod;
Private Function initPerid(ByVal intYear As Integer) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    strSql = "SELECT  AccountPeriod.bytPeriod  as Pr FROM AccountPeriod where AccountPeriod.intYear=" & intYear & " order by AccountPeriod.bytPeriod "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    cboYP(1).Clear
    recTmp.MoveFirst
    With recTmp
        Do While Not .EOF
            cboYP(1).AddItem recTmp!Pr
            .MoveNext
        Loop
    End With
    cboYP(1).Text = gclsBase.Period
    mCurPeriod = CLng(cboYP(1).Text)
End Function
'粘贴编辑
Private Sub StickText()
    Dim intCol As Long
    Dim intRow As Long
    With msgList
        If .col <> 2 Then
           ' txtStick.Visible = False
            Exit Sub
        End If
        intCol = .col
        intRow = .Row
        mblnStick = True
        'txtStick.Visible = True
        txtStick.width = .ColWidth(intCol)
        txtStick.Height = .RowHeight(intRow) - 60
        txtStick.top = .top + .RowPos(intRow) + 30
        txtStick.Left = .Left + .ColPos(intCol) + 30
        If Not mblnScorll Then
        txtStick.Text = Trim(.TextMatrix(intRow, 2))
        txtStick.SelStart = 0
        If Len(txtStick.Text) > 0 Then txtStick.SelLength = Len(txtStick.Text)
        End If
    End With
End Sub

Private Sub Form_Resize()
    With msgList
        .RowHeightMin = 275
        .ColWidth(0) = 0
        .ColWidth(1) = 1500
        .ColWidth(2) = .width - 3000
        .ColWidth(3) = 1500
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
     On Error Resume Next
    Utility.UnLoadFormResPicture Me
End Sub

Private Sub msgList_DblClick()
    msgList_KeyPress vbKeyReturn
End Sub

Private Sub msgList_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        With msgList
        If .col <> 2 Then Exit Sub
            StickText
           txtStick.Visible = .RowIsVisible(.Row)
           If txtStick.Visible Then txtStick.SetFocus
        End With
    End If
End Sub
Private Sub msgList_LeaveCell()
    With msgList
        If txtStick.Visible Then
            If txtStick.Text <> .TextMatrix(.Row, 2) Then
                mblnChange = True
                .RowData(.Row) = 1
                .TextMatrix(.Row, 2) = Trim(txtStick.Text)
                'If Trim(txtStick.Text) <> "" Then
                'SaveCard ListID, txtStick.Text
                WriteGrid
            End If
            txtStick.Text = ""
        End If
    End With
  txtStick.Visible = False
End Sub
Private Sub WriteGrid()
    Dim strSql As String
    Dim recTmp As rdoResultset
    
    strSql = "SELECT * FROM ReceiptMaxNO WHERE lngReceiptTypeID=" & ListID & _
        " AND intYear=" & C2lng(cboYP(0).Text) & " AND bytPeriod=" & C2lng(cboYP(1).Text) & _
        " AND ' '||Ltrim(strReceiptNO)=' " & LTrim(msgList.TextMatrix(msgList.Row, 2)) & "'"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If (recTmp.BOF And recTmp.EOF) Then
        msgList.TextMatrix(msgList.Row, 3) = ""
    Else
        msgList.TextMatrix(msgList.Row, 3) = Trim(msgList.TextMatrix(msgList.Row, 2) & Format(recTmp!lngReceiptNo, "0000"))
    End If
    recTmp.Close
    Set recTmp = Nothing
End Sub
Private Sub txtStick_Change()
    If ContainErrorChar(txtStick.Text, "`~!@#$^&*=+'"";:,./?|\") Then
        BKKEY txtStick.hwnd
    End If
    If ListID = 22 And (UCase(txtStick.Text) = "CA" _
            Or UCase(txtStick.Text) = "CB") Then
             BKKEY txtStick.hwnd
             BKKEY txtStick.hwnd
    ElseIf ListID = 41 Then
        BKKEY txtStick.hwnd
    End If
End Sub

Private Sub msgList_Scroll()
    mblnScorll = True
    With msgList
    If .col <> 2 Then
        mblnScorll = False
        Exit Sub
    End If
    If mblnStick Then
        StickText
        txtStick.Visible = .RowIsVisible(.Row)
        If txtStick.Visible Then
            txtStick.SetFocus
            txtStick.SelStart = 0
            If Len(txtStick.Text) > 0 Then txtStick.SelLength = Len(txtStick.Text)
        End If
    End If
    End With
    mblnScorll = False
End Sub

Private Sub txtStick_KeyPress(KeyAscii As Integer)
    With msgList
    If KeyAscii = vbKeyReturn Then
        
            If .Row < .Rows - 1 Then
                .Row = .Row + 1
            Else
                .col = 3
                .Row = 1
                .TopRow = 1
                Exit Sub
            End If
            .SetFocus
            If Not .RowIsVisible(.Row) Then .TopRow = .TopRow + 1
            msgList_KeyPress vbKeyReturn
       
    ElseIf KeyAscii = vbKeyEscape Then
        txtStick.Visible = False
        .SetFocus
    End If
    End With
End Sub

Private Sub txtStick_Validate(Cancel As Boolean)
'    With msgList
'        If txtStick.Visible Then
'            If txtStick.Text <> .TextMatrix(.Row, 2) Then
'                mblnChange = True
'                .RowData(.Row) = 1
'                .TextMatrix(.Row, 2) = txtStick.Text
'                'If Trim(txtStick.Text) <> "" Then
'                'SaveCard ListID, txtStick.Text
'                WriteGrid
'            End If
'            'txtStick.Text = ""
'        End If
'    End With
    
End Sub