frmpz_thpzdefine.frm

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

         AutoSize        =   -1  'True
         Caption         =   "汇兑收益科目:"
         Height          =   180
         Left            =   180
         TabIndex        =   10
         Top             =   795
         Width           =   1170
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "汇兑损失科目:"
         Height          =   180
         Left            =   180
         TabIndex        =   9
         Top             =   1215
         Width           =   1170
      End
      Begin VB.Label labZy 
         AutoSize        =   -1  'True
         Caption         =   "摘  要:"
         Height          =   180
         Left            =   4470
         TabIndex        =   8
         Top             =   1215
         Width           =   630
      End
      Begin VB.Label txt 
         AutoSize        =   -1  'True
         Caption         =   "调汇周期:"
         Height          =   180
         Left            =   4290
         TabIndex        =   7
         Top             =   795
         Width           =   810
      End
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuNew 
         Caption         =   "增加凭证"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuEdit 
         Caption         =   "修改凭证"
         Shortcut        =   ^E
      End
      Begin VB.Menu mnuFileDelete 
         Caption         =   "删除凭证"
      End
      Begin VB.Menu mnuSave 
         Caption         =   "保存"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuCancel 
         Caption         =   "取消(&C)"
      End
      Begin VB.Menu mnuline2 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuPriview 
         Caption         =   "预览(&V)"
         Enabled         =   0   'False
         Visible         =   0   'False
      End
      Begin VB.Menu mnuPrint 
         Caption         =   "打印"
         Enabled         =   0   'False
         Shortcut        =   ^P
         Visible         =   0   'False
      End
      Begin VB.Menu mnuLine3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu munEdit01 
      Caption         =   "凭证(&E)"
      Begin VB.Menu munEdit01Doall 
         Caption         =   "全选"
      End
   End
   Begin VB.Menu mnuBrowse 
      Caption         =   "浏览(&B)"
      Begin VB.Menu mnuBrowseFirst 
         Caption         =   "首张凭证(&F)"
      End
      Begin VB.Menu mnuBrowsePrivious 
         Caption         =   "上张凭证(&P)"
      End
      Begin VB.Menu mnuBrowseNext 
         Caption         =   "下张凭证(&N)"
      End
      Begin VB.Menu mnuBrowseLast 
         Caption         =   "末张凭证(&L)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpTheme 
         Caption         =   "帮助主题(&H)"
      End
   End
End
Attribute VB_Name = "frmPZ_ThpzDefine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'科目结构体
Private Type UDT_km
    kmdm As String
    Kmmc As String
End Type

'损益科目
Private Sykm As UDT_km
'损失科目
Private Sskm As UDT_km


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

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

Private Sub cmdSubjectHelpOne_Click()
With frmUSU_KmHelp
    .ubSelAll = False
    .Show 1, Me
    If .Valid Then
        Sykm.kmdm = .SubjectCode
        Sykm.Kmmc = .SubjectName
        txtHdsykm.text = Sykm.kmdm + "=" + Sykm.Kmmc
    End If
End With

End Sub

Private Sub cmdSubjectHelpTwo_Click()
With frmUSU_KmHelp
    .ubSelAll = False
    .Show 1, Me
    If .Valid Then
        Sskm.kmdm = .SubjectCode
        Sskm.Kmmc = .SubjectName
        txtHdsskm.text = Sskm.kmdm + "=" + Sskm.Kmmc
    End If
End With

End Sub

Private Sub form_load()
'设置网格
SetGrid
'填充网格
FillGrid
'初始化凭证类别下拉框
InitCombo
'清除信息
ClearAll
'恢复缺省状态
mnuCancel_Click
End Sub

'设置网格
Public Sub FillGrid()
Dim rSt As New Recordset
rSt.Open "Select Kmdm,Kmmc,yefx,wbdw from tZw_km" + glo.sOperateYear + " where NOT (wbdw IS NULL or wbdw=' ') and IsEndkm=-1 order by  Kmdm", glo.cnnMain, adOpenKeyset, adLockPessimistic
While Not rSt.EOF
    mFg.TextMatrix(mFg.Rows - 1, 1) = "" + rSt.Fields(0).value
    mFg.TextMatrix(mFg.Rows - 1, 2) = "" + rSt.Fields(1).value
    mFg.TextMatrix(mFg.Rows - 1, 3) = "" + rSt.Fields(2).value
    mFg.TextMatrix(mFg.Rows - 1, 4) = "" + rSt.Fields(3).value
    rSt.MoveNext
    mFg.Rows = mFg.Rows + 1
Wend
mFg.Rows = mFg.Rows - 1
End Sub

'选中记录
Private Sub mFg_DblClick()
If mFg.Row > 0 Then
    If Trim(mFg.TextMatrix(mFg.Row, 0)) = "" Then
        mFg.TextMatrix(mFg.Row, 0) = "√"
    Else
        mFg.TextMatrix(mFg.Row, 0) = ""
    End If
End If
End Sub

'选择首条记录
Private Sub mnuBrowseFirst_Click()
GetPz " order by ID,jlfl"
End Sub

'选择末条记录
Private Sub mnuBrowseLast_Click()
GetPz " order by ID DESC,jlfl"
End Sub

'选择下一条记录
Private Sub mnuBrowseNext_Click()
If Trim(txtPZBH.text) <> "" Then GetPz " where ID>'" + Trim(txtPZBH.text) + "' order by ID,jlfl"
End Sub

'选择上一条记录
Private Sub mnuBrowsePrivious_Click()
If Trim(txtPZBH.text) <> "" Then GetPz " where ID<'" + Trim(txtPZBH.text) + "' order by ID DESC,jlfl"
End Sub

'恢复缺省状态
Private Sub mnuCancel_Click()
If Trim(txtPZBH.Tag) = "" Then mnuBrowseFirst_Click
GetPz " where ID='" + Trim(txtPZBH.Tag) + "'"
ControlMenu "Cancel"
End Sub

'设置编辑状态
Private Sub mnuEdit_Click()
ControlMenu "Edit"
End Sub

'退出
Private Sub mnuExit_Click()
Unload Me
End Sub

'删除
Private Sub mnuFileDelete_Click()
Dim s As String
s = Trim(txtPZBH.text)
If MsgBox("是否删除此凭证?", vbYesNo) = vbYes Then
    glo.cnnMain.Execute "Delete from tZw_ZzhdSet" + glo.sOperateYear + " where ID='" + Trim(s) + "'"
    If Trim(txtPZBH.text) <> "" Then
        If GetPz(" where ID>'" + Trim(txtPZBH.text) + "' order by ID,jlfl") = False Then
            If Not GetPz(" order by ID DESC,jlfl") Then
                mnuNew_Click
            End If
        End If
    End If
'mnuCancel_Click
End If
End Sub

Private Sub mnuHelpTheme_Click()
SendKeys "{F1}"
End Sub

Private Sub mnuNew_Click()
'设置网格
SetGrid
'填充网格
FillGrid
'初始化凭证类别下拉框
InitCombo
'清除信息
ClearAll
'设置新增状态
ControlMenu "Add"
End Sub

'保存
Private Sub mnuSave_Click()
Dim sSQL As String
Dim sTmp As String
Dim i As Integer
Dim No As Integer
On Error Resume Next
If CheckValid Then
    glo.cnnMain.BeginTrans
    If fraTitle.Caption = "修改凭证" Then
        glo.cnnMain.Execute "Delete from tZw_ZzhdSet" + glo.sOperateYear + " where ID='" + Trim(txtPZBH.text) + "'"
    End If
    sSQL = "Insert into tZw_ZzhdSet" + glo.sOperateYear + _
        " (ID,pzlb,SYkmdm,SYkmmc,SSkmdm,SSkmmc,zy,thzq,jlfl,kmdm,kmmc,fx,bz) values ('" + Trim(txtPZBH.text) + _
        "','" + Trim(cboPzlb.text) + "','" + Sykm.kmdm + "','" + Sykm.Kmmc + "','" + _
        Sskm.kmdm + "','" + Sskm.Kmmc + "','" + Trim(txtZY.text) + "','" + Trim(cboThzq.text)
    i = 1
    No = 1
    
    On Error GoTo Err
    While i < mFg.Rows
        If mFg.TextMatrix(i, 0) = "√" Then
            sTmp = sSQL + "'," + CStr(No) + ",'" + mFg.TextMatrix(i, 1) + "','" + mFg.TextMatrix(i, 2) + "','" + Left(mFg.TextMatrix(i, 3), 1) + "','" + mFg.TextMatrix(i, 4) + "')"
            glo.cnnMain.Execute sTmp
            No = No + 1
        End If
        i = i + 1
    Wend
    glo.cnnMain.CommitTrans
    ControlMenu "Save"
End If
Exit Sub
Err:
    glo.cnnMain.RollbackTrans
End Sub

'全选
Private Sub munEdit01Doall_Click()
Dim i As Integer
i = 1
munEdit01Doall.Checked = Not munEdit01Doall.Checked
If munEdit01Doall.Checked Then
    tbr.Buttons("DoAll").value = tbrPressed
Else
    tbr.Buttons("DoAll").value = tbrUnpressed
End If
While i < mFg.Rows
    If munEdit01Doall.Checked Then
        mFg.TextMatrix(i, 0) = "√"
    Else
        mFg.TextMatrix(i, 0) = ""
    End If
    i = i + 1
Wend

End Sub

Private Sub tbr_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "DoAll"
    munEdit01Doall_Click
Case "Append"
    mnuNew_Click
Case "Edit"
    mnuEdit_Click
Case "Save"
    mnuSave_Click
Case "Cancel"
    mnuCancel_Click
Case "First"
    mnuBrowseFirst_Click