📄 frmzjmx.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmZjmx
Caption = "资金明细"
ClientHeight = 7500
ClientLeft = 60
ClientTop = 345
ClientWidth = 8940
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7500
ScaleWidth = 8940
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame2
Height = 735
Left = 0
TabIndex = 12
Top = 0
Width = 8895
Begin VB.TextBox txtName
Height = 375
Left = 3960
Locked = -1 'True
TabIndex = 16
Top = 240
Width = 4815
End
Begin VB.TextBox txtCode
Height = 390
Left = 960
Locked = -1 'True
TabIndex = 14
Top = 240
Width = 2055
End
Begin VB.Label Label6
Caption = "名称"
Height = 255
Left = 3480
TabIndex = 15
Top = 360
Width = 615
End
Begin VB.Label Label5
Caption = "资金账号"
Height = 255
Left = 120
TabIndex = 13
Top = 320
Width = 855
End
End
Begin VB.CommandButton cmdExit
Caption = "退出(&E)"
Height = 495
Left = 5040
TabIndex = 7
Top = 6840
Width = 1575
End
Begin VB.CommandButton cmdOk
Caption = "确定(&O)"
Height = 495
Left = 1560
TabIndex = 6
Top = 6840
Width = 1575
End
Begin VB.Frame Frame1
Height = 6135
Left = 0
TabIndex = 0
Top = 600
Width = 8895
Begin VB.TextBox txtModifyDate
Height = 375
Left = 960
Locked = -1 'True
TabIndex = 19
Top = 5480
Width = 1575
End
Begin VB.TextBox txtYt
Height = 975
Left = 960
MultiLine = -1 'True
TabIndex = 4
Top = 3840
Width = 7815
End
Begin VB.TextBox txtBz
Height = 375
Left = 960
TabIndex = 5
Top = 4920
Width = 7815
End
Begin VB.TextBox txtMx
Height = 1935
Left = 960
MultiLine = -1 'True
TabIndex = 3
Top = 1800
Width = 7815
End
Begin VB.TextBox txtJe
Alignment = 1 'Right Justify
Height = 390
Left = 960
TabIndex = 2
Top = 1080
Width = 1695
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Left = 960
TabIndex = 1
Top = 360
Width = 1695
_ExtentX = 2990
_ExtentY = 661
_Version = 393216
Format = 23789569
CurrentDate = 37713
End
Begin VB.Label Label8
Caption = "更新日期："
Height = 255
Left = 120
TabIndex = 18
Top = 5520
Width = 975
End
Begin VB.Label Label7
Caption = "用途："
Height = 255
Left = 120
TabIndex = 17
Top = 3840
Width = 615
End
Begin VB.Label Label4
Caption = "备注："
Height = 255
Left = 120
TabIndex = 11
Top = 4920
Width = 615
End
Begin VB.Label Label3
Caption = "明细："
Height = 255
Left = 120
TabIndex = 10
Top = 1800
Width = 615
End
Begin VB.Label Label2
Caption = "金额："
Height = 255
Left = 120
TabIndex = 9
Top = 1080
Width = 855
End
Begin VB.Label Label1
Caption = "日期："
Height = 255
Left = 120
TabIndex = 8
Top = 360
Width = 735
End
End
End
Attribute VB_Name = "frmZjmx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public msStatus As String
Public msZjzh As String
Public msName As String
Public mlFatherID As Long
Public mlID As Long
Public mtFsrq As Date
Public mcFsje As Currency
Public msZjmx As String
Public msComment As String
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error Resume Next
Dim lID As Long, tFsrq As Date, tModifyDate As Date
Dim lsvItem As MSComctlLib.ListItem
Dim iCount As Long
Dim cFsje As Currency, sZjmx As String, sComment As String, sZjyt As String
Dim sSQL As String
Dim rsTemp As ADODB.Recordset
If CheckItem = False Then Exit Sub
If msStatus = "New" Then
lID = GetID
tFsrq = Format(DTPicker1.Value, "YYYY-MM-DD")
cFsje = txtJe.Text
sZjmx = txtMx.Text
sZjyt = txtYt.Text
sComment = txtBz.Text
tModifyDate = Format(txtModifyDate.Text, "YYYY-MM-DD")
sSQL = "insert into zjls(id,fatherid,zjzh,fsrq,fsje,zjmx,zjyt,comment,modifydate)" & _
" values(" & lID & "," & mlFatherID & ",'" & msZjzh & "','" & tFsrq & "'," & cFsje & ",'" & sZjmx & "','" & sZjyt & "','" & sComment & "','" & tModifyDate & "')"
GDB.Execute (sSQL)
ElseIf msStatus = "Modify" Then
tFsrq = Format(DTPicker1.Value, "YYYY-MM-DD")
cFsje = txtJe.Text
sZjmx = txtMx.Text
sZjyt = txtYt.Text
sComment = txtBz.Text
tModifyDate = Format(Date, "YYYY-MM-DD")
sSQL = "update zjls set fsrq='" & tFsrq & "',fsje=" & cFsje & ", zjmx='" & sZjmx & "',zjyt='" & sZjyt & "',comment='" & sComment & "',modifydate='" & tModifyDate & "' where id=" & mlID
GDB.Execute (sSQL)
End If
If msStatus = "New" Then
iCount = frmLC.lsvDetail.ListItems.Count + 1
Set lsvItem = frmLC.lsvDetail.ListItems.Add(iCount, "U" & iCount)
lsvItem.Text = iCount
lsvItem.SubItems(1) = tFsrq
lsvItem.SubItems(2) = cFsje
lsvItem.SubItems(3) = sZjmx
lsvItem.SubItems(4) = sZjyt
lsvItem.SubItems(5) = sComment
lsvItem.Tag = lID
txtMx.Text = ""
txtBz.Text = ""
txtYt.Text = ""
txtJe.Text = ""
DTPicker1.SetFocus
ElseIf msStatus = "Modify" Then
Unload Me
End If
End Sub
Private Function CheckItem() As Boolean
CheckItem = False
If IsNumeric(txtJe.Text) = False Then
MsgBox "请输入正确的金额！", vbInformation + vbOKOnly, "警告"
Exit Function
End If
CheckItem = True
End Function
Private Function GetID() As Long
Dim sSQL As String
Dim rsTemp As Recordset
Dim lMaxID As Long
Dim lTempID As Long
sSQL = "select max(ID) as MaxID from zjls "
Set rsTemp = GDB.Execute(sSQL)
With rsTemp
Do While Not .EOF
lMaxID = IIf(IsNull(rsTemp!maxid), 0, rsTemp!maxid)
.MoveNext
Loop
End With
lTempID = IIf(IsNull(lMaxID), 0, lMaxID) + 1
GetID = lTempID
rsTemp.Close
Set rsTemp = Nothing
End Function
Private Sub cmdOk_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{tab}"
End If
End Sub
Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{tab}"
End If
End Sub
Private Sub Form_Load()
If msStatus = "New" Then
Call SetFatherInfo(mlFatherID)
DTPicker1.Value = Date
txtModifyDate = Format(Date, "YYYY-MM-DD")
txtJe.Text = ""
txtMx.Text = ""
txtBz.Text = ""
ElseIf msStatus = "Modify" Then
Call SetFatherInfo(mlFatherID)
Call SetDetailInfo(mlID)
ElseIf msStatus = "Browser" Then
Call SetFatherInfo(mlFatherID)
Call SetDetailInfo(mlID)
Frame1.Enabled = False
Frame2.Enabled = False
End If
End Sub
Private Sub SetDetailInfo(ByVal lID As Long)
Dim sSQL As String
Dim rsTemp As Recordset
sSQL = "select * from zjls where ID=" & lID
Set rsTemp = GDB.Execute(sSQL)
With rsTemp
Do While Not .EOF
DTPicker1.Value = IIf(IsNull(rsTemp!fsrq), "1900-01-01", rsTemp!fsrq)
txtJe.Text = IIf(IsNull(rsTemp!fsje), 0, Format(rsTemp!fsje, "#.00"))
txtMx.Text = IIf(IsNull(rsTemp!zjmx), "", rsTemp!zjmx)
txtYt.Text = IIf(IsNull(rsTemp!zjyt), "", rsTemp!zjyt)
txtBz.Text = IIf(IsNull(rsTemp!comment), "", rsTemp!comment)
txtModifyDate.Text = IIf(IsNull(rsTemp!modifydate), "1900-01-01", rsTemp!modifydate)
.MoveNext
Loop
End With
rsTemp.Close
Set rsTemp = Nothing
End Sub
Private Sub SetFatherInfo(ByVal FatherID As Long)
Dim sSQL As String
Dim rsTemp As Recordset
sSQL = "select * from zjzh where id=" & FatherID
Set rsTemp = GDB.Execute(sSQL)
With rsTemp
Do While Not .EOF
msZjzh = rsTemp!zjzh
msName = rsTemp!Name
txtCode.Text = rsTemp!zjzh
txtName.Text = rsTemp!Name
.MoveNext
Loop
End With
rsTemp.Close
Set rsTemp = Nothing
End Sub
Private Sub txtBz_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{tab}"
End If
End Sub
Private Sub txtJe_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{tab}"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -