frmpz_thpzdefine.frm

一个用VB写的财务软件源码

Case "Previous"
    mnuBrowsePrivious_Click
Case "Next"
    mnuBrowseNext_Click
Case "Last"
    mnuBrowseLast_Click
Case "Help"
    mnuHelpTheme_Click
Case "Quit"
    mnuExit_Click
Case "Delete"
    mnuFileDelete_Click
End Select
End Sub

'设置网格
Public Sub SetGrid()
mFg.Rows = 2
mFg.FormatString = " |<科目代码|<科目名称|<余额方向|<币种"
mFg.ColWidth(0) = 250
mFg.ColWidth(1) = 2900
mFg.ColWidth(2) = 3000
mFg.ColWidth(3) = 840
mFg.ColWidth(4) = 840
End Sub

Private Sub txtHdsskm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub

Private Sub txtHdsskm_LostFocus()
If InStr(1, txtHdsskm.text, "=") > 0 Or Trim(txtHdsskm.text) = "" Then
    Exit Sub
End If
Dim rSt As New Recordset
rSt.Open "Select kmdm,kmmc from tZw_km" + glo.sOperateYear + " where kmdm like '" + txtHdsskm + "%' and IsEndkm=-1", glo.cnnMain, adOpenKeyset, adLockOptimistic
If Not rSt.EOF Then
    Sskm.Kmmc = "" + rSt.Fields(1).value
    Sskm.kmdm = "" + rSt.Fields(0).value
    txtHdsskm.text = Sskm.kmdm + "=" + Sskm.Kmmc
Else
    MsgBox "没有科目代码" + txtHdsskm.text + "!", vbInformation
    Sskm.kmdm = ""
    Sskm.Kmmc = ""
End If
rSt.Close
End Sub

Private Sub txtHdsykm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub

'初始化凭证类别下拉框
Public Sub InitCombo()
Dim rSt As New Recordset
rSt.Open "select signID,sign from tZw_Type" & glo.sOperateYear + " order by signID", glo.cnnMain, adOpenKeyset, adLockPessimistic
cboPzlb.Clear
While Not rSt.EOF
    cboPzlb.AddItem rSt.Fields(1).value
    rSt.MoveNext
Wend
rSt.Close
Set rSt = Nothing
End Sub

Private Sub txtHdsykm_LostFocus()
If InStr(1, txtHdsykm.text, "=") > 0 Or Trim(txtHdsykm.text) = "" Then
    Exit Sub
End If
Dim rSt As New Recordset
rSt.Open "Select kmdm,kmmc from tZw_km" + glo.sOperateYear + " where kmdm like '" + txtHdsykm + "%' and IsEndkm=-1", glo.cnnMain, adOpenKeyset, adLockOptimistic
If Not rSt.EOF Then
    Sykm.Kmmc = "" + rSt.Fields(1).value
    Sykm.kmdm = "" + rSt.Fields(0).value
    txtHdsykm.text = Sykm.kmdm + "=" + Sykm.Kmmc
Else
    MsgBox "没有科目代码" + txtHdsykm.text + "!", vbInformation
    Sykm.kmdm = ""
    Sykm.Kmmc = ""
End If
rSt.Close
End Sub

'检查合法性
Public Function CheckValid() As Boolean
Dim i As Integer
Dim rSt As New Recordset
CheckValid = False
If Trim(txtPZBH) = "" Then
    MsgBox "请输入编号！", vbInformation
    Exit Function
End If
If Trim(txtHdsykm) = "" Then
    MsgBox "请输入收益科目！", vbInformation
    Exit Function
End If
If SqlStringValid(txtHdsykm) = False Then
    MsgBox "收益科目不能含有非法的字符！", vbInformation, "提示"
    Exit Function
End If
If Trim(txtHdsskm) = "" Then
    MsgBox "请输入损失科目！", vbInformation
    Exit Function
End If

If SqlStringValid(txtHdsskm) = False Then
    MsgBox "损失科目不能含有非法的字符！", vbInformation, "提示"
    Exit Function
End If
If Trim(cboPzlb) = "" Then
    MsgBox "请选择凭证类别！", vbInformation
    Exit Function
End If
If Trim(cboThzq) = "" Then
    MsgBox "请选择调汇周期！", vbInformation
    Exit Function
End If
i = 0
rSt.Open "select kmdm,kmmc,IsEndKm from tZw_km" + glo.sOperateYear + " where kmdm='" + Sykm.kmdm + "' or kmdm='" + Sskm.kmdm + "'", glo.cnnMain, adOpenKeyset, adLockPessimistic
While Not rSt.EOF
    i = i + 1
    If rSt.Fields("IsEndKm").value <> -1 Then
        MsgBox "科目" + rSt.Fields("kmdm").value + "=" + rSt.Fields("kmmc").value + "不是末级科目!", vbInformation
        Exit Function
    End If
    rSt.MoveNext
Wend
rSt.Close
If Sykm.kmdm = Sskm.kmdm Then
    i = i + 1
End If
If i <> 2 Then
    MsgBox "有非法科目！请检查。", vbInformation
    Exit Function
End If
rSt.Open "Select DISTINCT(ID) from tZw_zzhdset" + glo.sOperateYear + " where ID='" + txtPZBH.text + "'", glo.cnnMain, adOpenKeyset, adLockPessimistic
If Not (rSt.BOF And rSt.EOF) And fraTitle.Caption = "新增凭证" Then
    MsgBox "编号重复！", vbInformation
    Exit Function
End If
rSt.Close
i = 1
While i < mFg.Rows
    If mFg.TextMatrix(i, 0) = "√" Then
        CheckValid = True
    End If
    i = i + 1
Wend
If Not CheckValid Then
    MsgBox "请选择分录！", vbInformation
End If
End Function

Private Sub txtPZBH_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    SendKeys "{TAB}"
Else
    KeyAscii = IntegerEnabled(KeyAscii)
End If
End Sub

'清除所有信息
Public Sub ClearAll()
If munEdit01Doall.Checked Then
    munEdit01Doall_Click
Else
    munEdit01Doall_Click
    munEdit01Doall_Click
End If
txtPZBH.text = ""
txtHdsykm.text = ""
Sykm.kmdm = ""
Sykm.Kmmc = ""
txtHdsskm.text = ""
Sskm.kmdm = ""
Sskm.Kmmc = ""
txtZY.text = "汇兑损益"
End Sub

'设置菜单状态
Public Sub ControlMenu(ByVal sKey As String)
Select Case sKey
Case "Add"
    mnuNew.Enabled = False
    tbr.Buttons("Append").Enabled = False
    mnuEdit.Enabled = False
    tbr.Buttons("Edit").Enabled = False
    mnuSave.Enabled = True
    tbr.Buttons("Delete").Enabled = False
    mnuFileDelete.Enabled = False
    tbr.Buttons("Save").Enabled = True
    mnuCancel.Enabled = True
    tbr.Buttons("Cancel").Enabled = True
    munEdit01Doall.Enabled = True
    tbr.Buttons("DoAll").Enabled = True
    mnuBrowseFirst.Enabled = False
    tbr.Buttons("First").Enabled = False
    mnuBrowsePrivious.Enabled = False
    tbr.Buttons("Previous").Enabled = False
    mnuBrowseNext.Enabled = False
    tbr.Buttons("Next").Enabled = False
    mnuBrowseLast.Enabled = False
    tbr.Buttons("Last").Enabled = False
    fraTitle.Enabled = True
    mFg.Enabled = True
    txtPZBH.Enabled = True
    cboPzlb.Enabled = True
    fraTitle.Caption = "新增凭证"
Case "Edit"
    mnuNew.Enabled = False
    tbr.Buttons("Append").Enabled = False
    mnuEdit.Enabled = False
    tbr.Buttons("Delete").Enabled = False
    mnuFileDelete.Enabled = False
    tbr.Buttons("Edit").Enabled = False
    mnuSave.Enabled = True
    tbr.Buttons("Save").Enabled = True
    mnuCancel.Enabled = True
    tbr.Buttons("Cancel").Enabled = True
    munEdit01Doall.Enabled = True
    tbr.Buttons("DoAll").Enabled = True
    mnuBrowseFirst.Enabled = False
    tbr.Buttons("First").Enabled = False
    mnuBrowsePrivious.Enabled = False
    tbr.Buttons("Previous").Enabled = False
    mnuBrowseNext.Enabled = False
    tbr.Buttons("Next").Enabled = False
    mnuBrowseLast.Enabled = False
    tbr.Buttons("Last").Enabled = False
    fraTitle.Enabled = True
    mFg.Enabled = True
    txtPZBH.Enabled = False
    cboPzlb.Enabled = True
    fraTitle.Caption = "修改凭证"
Case "Save"
    mnuNew.Enabled = True
    tbr.Buttons("Append").Enabled = True
    mnuEdit.Enabled = True
    tbr.Buttons("Edit").Enabled = True
    mnuSave.Enabled = True
    tbr.Buttons("Delete").Enabled = True
    mnuFileDelete.Enabled = True
    tbr.Buttons("Save").Enabled = False
    mnuCancel.Enabled = False
    tbr.Buttons("Cancel").Enabled = False
    munEdit01Doall.Enabled = False
    tbr.Buttons("DoAll").Enabled = False
    mnuBrowseFirst.Enabled = True
    tbr.Buttons("First").Enabled = True
    mnuBrowsePrivious.Enabled = True
    tbr.Buttons("Previous").Enabled = True
    mnuBrowseNext.Enabled = True
    tbr.Buttons("Next").Enabled = True
    mnuBrowseLast.Enabled = True
    tbr.Buttons("Last").Enabled = True
    fraTitle.Enabled = False
    mFg.Enabled = False
    txtPZBH.Enabled = True
    cboPzlb.Enabled = True
    fraTitle.Caption = "浏览凭证"
Case "Cancel"
    mnuNew.Enabled = True
    tbr.Buttons("Append").Enabled = True
    mnuEdit.Enabled = True
    tbr.Buttons("Edit").Enabled = True
    mnuSave.Enabled = True
    tbr.Buttons("Delete").Enabled = True
    mnuFileDelete.Enabled = True
    tbr.Buttons("Save").Enabled = False
    mnuCancel.Enabled = False
    tbr.Buttons("Cancel").Enabled = False
    munEdit01Doall.Enabled = False
    tbr.Buttons("DoAll").Enabled = False
    mnuBrowseFirst.Enabled = True
    tbr.Buttons("First").Enabled = True
    mnuBrowsePrivious.Enabled = True
    tbr.Buttons("Previous").Enabled = True
    mnuBrowseNext.Enabled = True
    tbr.Buttons("Next").Enabled = True
    mnuBrowseLast.Enabled = True
    tbr.Buttons("Last").Enabled = True
    fraTitle.Enabled = False
    mFg.Enabled = False
    txtPZBH.Enabled = True
    cboPzlb.Enabled = True
    fraTitle.Caption = "浏览凭证"
End Select
End Sub

'取得凭证信息
Public Function GetPz(sCondition As String) As Boolean
Dim rSt As New Recordset
Dim Id As String
On Error Resume Next
Id = ""
rSt.Open "Select * from tZw_zzhdSet" + glo.sOperateYear + sCondition, glo.cnnMain, adOpenKeyset, adLockPessimistic
If rSt.BOF And rSt.EOF Then
    GetPz = False
Else
    GetPz = True
End If
If Not (rSt.EOF And rSt.BOF) Then
    Dim i As String
    i = 1
    While i < mFg.Rows
        mFg.TextMatrix(i, 0) = ""
        i = i + 1
    Wend
End If
tbr.Buttons("DoAll").value = tbrUnpressed
While Not rSt.EOF
    If Id <> "" And Id <> "" + rSt.Fields("ID").value Then Exit Function
    Id = "" + rSt.Fields("ID").value
    txtPZBH.Tag = Id
    txtPZBH.text = Trim("" + rSt.Fields("ID").value)
    Sykm.kmdm = Trim("" + rSt.Fields("sykmdm").value)
    Sykm.Kmmc = Trim("" + rSt.Fields("sykmmc").value)
    txtHdsykm.text = Sykm.kmdm + "=" + Sykm.Kmmc
    Sskm.kmdm = Trim("" + rSt.Fields("sskmdm").value)
    Sskm.Kmmc = Trim("" + rSt.Fields("sskmmc").value)
    txtHdsskm.text = Sskm.kmdm + "=" + Sskm.Kmmc
    cboPzlb.text = Trim("" + rSt.Fields("pzlb").value)
    cboThzq.text = Trim("" + rSt.Fields("thzq").value)
    txtZY.text = Trim("" + rSt.Fields("zy").value)
    SetCheck "" + rSt.Fields("kmdm").value, "" + rSt.Fields("bz").value
    rSt.MoveNext
Wend
End Function

'设置选中的状态
Private Sub SetCheck(ByVal sKmdm As String, ByVal sBz As String)
Dim i As String
i = 1
While i < mFg.Rows
    If Trim(sKmdm) = Trim(mFg.TextMatrix(i, 1)) And Trim(sBz) = Trim(mFg.TextMatrix(i, 4)) Then
        mFg.TextMatrix(i, 0) = "√"
    End If
    i = i + 1
Wend
End Sub