📄 frmxb.frm
字号:
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 150
TabIndex = 23
Top = 1290
Width = 1035
End
Begin VB.Shape Shape1
BorderColor = &H00400000&
FillColor = &H000080FF&
Height = 30
Index = 1
Left = 15
Top = 3585
Width = 9645
End
Begin VB.Shape Shape1
BorderColor = &H00FFFFFF&
FillColor = &H000080FF&
Height = 30
Index = 0
Left = 0
Top = 3585
Width = 9645
End
Begin ComctlLib.ImageList ImageList1
Left = 3120
Top = 600
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 15
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":0442
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":075C
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":0A76
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":0D90
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":10AA
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":13C4
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":16DE
Key = ""
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":19F8
Key = ""
EndProperty
BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":1D12
Key = ""
EndProperty
BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":202C
Key = ""
EndProperty
BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":23DE
Key = ""
EndProperty
BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":26F8
Key = ""
EndProperty
BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":2A12
Key = ""
EndProperty
BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":2D2C
Key = ""
EndProperty
BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmxb.frx":3046
Key = ""
EndProperty
EndProperty
End
Begin VB.Label Label5
Caption = "输入收支记录的日期后可跳到当天第一个收支情况"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 510
Left = 120
TabIndex = 17
Top = 630
Width = 2820
End
Begin VB.Label Label2
Caption = "收支类别"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3450
TabIndex = 10
Top = 2610
Width = 825
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000004&
Caption = "说明"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 5715
TabIndex = 9
Top = 1365
Width = 495
End
Begin VB.Label Label1
Caption = "收支金额"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 3450
TabIndex = 8
Top = 2025
Width = 810
End
Begin VB.Label Label1
Caption = "收支日期"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 3465
TabIndex = 7
Top = 1440
Width = 810
End
Begin VB.Menu year
Caption = "年度(&Y)"
Begin VB.Menu xz
Caption = "查询其它年度..."
End
Begin VB.Menu sp1
Caption = "-"
End
Begin VB.Menu cl
Caption = "年终处理"
End
End
Begin VB.Menu reco
Caption = "记录(&R)"
Begin VB.Menu zj
Caption = "新增收支"
Shortcut = ^A
End
Begin VB.Menu xg
Caption = "修改收支"
Shortcut = ^E
End
Begin VB.Menu SC
Caption = "删除记录"
Shortcut = ^D
End
Begin VB.Menu sp2
Caption = "-"
End
Begin VB.Menu sy
Caption = "上一记录"
Shortcut = ^P
End
Begin VB.Menu XY
Caption = "下一记录"
Shortcut = ^N
End
Begin VB.Menu SP3
Caption = "-"
End
Begin VB.Menu YJS
Caption = "月结算"
End
Begin VB.Menu PX
Caption = "按时间排序"
End
End
Begin VB.Menu TOOLS
Caption = "工具(&T)"
Begin VB.Menu CX
Caption = "查询..."
Shortcut = ^F
End
Begin VB.Menu YD
Caption = "预订..."
End
Begin VB.Menu EX
Caption = "折线式图表..."
End
Begin VB.Menu dc
Caption = "数据导出"
Begin VB.Menu SZ
Caption = "收支详情.."
End
Begin VB.Menu JS
Caption = "每月结算.."
End
End
End
Begin VB.Menu ABOUT
Caption = "关于(&A)"
Begin VB.Menu HELP
Caption = "帮助"
End
Begin VB.Menu EXIT
Caption = "退出"
End
End
End
Attribute VB_Name = "frmxb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public myyear As String
Private Sub MYHELP()
Frmhelp.Show 1
End Sub
Private Sub visok(test As Boolean) '在某些功能启用时，另一些功能不允许用
Dim kk As Integer
If test Then
textfind.Enabled = True
Toolbar1.Buttons.Item(1).Visible = True
zj.Enabled = True
Toolbar1.Buttons.Item(3).Visible = True
sy.Enabled = True
Toolbar1.Buttons.Item(4).Visible = True
XY.Enabled = True
Toolbar1.Buttons.Item(5).Visible = True
xg.Enabled = True
Toolbar1.Buttons.Item(7).Visible = False
Toolbar1.Buttons.Item(8).Visible = False
Slirecon.Enabled = True
For kk = 10 To 16
Toolbar1.Buttons.Item(kk).Visible = True
Next kk
xz.Enabled = True
cl.Enabled = True
YJS.Enabled = True
PX.Enabled = True
YD.Enabled = True
SC.Enabled = True
CX.Enabled = True
EX.Enabled = True
dc.Enabled = True
Text1(0).Locked = True
Text1(1).Locked = True
Text1(2).Locked = True
Combo1.Locked = True
Else
textfind.Enabled = False
Toolbar1.Buttons.Item(1).Visible = False
zj.Enabled = False
Toolbar1.Buttons.Item(3).Visible = False
sy.Enabled = False
Toolbar1.Buttons.Item(4).Visible = False
XY.Enabled = False
Toolbar1.Buttons.Item(5).Visible = False
xg.Enabled = False
Toolbar1.Buttons.Item(7).Visible = True
Toolbar1.Buttons.Item(8).Visible = True
Slirecon.Enabled = False
For kk = 10 To 16
Toolbar1.Buttons.Item(kk).Visible = False
Next kk
xz.Enabled = False
cl.Enabled = False
YJS.Enabled = False
PX.Enabled = False
YD.Enabled = False
SC.Enabled = False
CX.Enabled = False
EX.Enabled = False
dc.Enabled = False
Text1(0).Locked = False
Text1(1).Locked = False
Text1(2).Locked = False
Combo1.Locked = False
End If
End Sub
Private Sub mok() '前进,后退按钮在记录位不同时的不同状态
Dim l As Integer, n As Integer, book As Variant
textfind.Text = Format(Data1.Recordset.Fields(0), "yyyy-mm-dd")
book = Data1.Recordset.Bookmark
Data1.Recordset.MoveFirst
Data1.Recordset.MoveLast
Data1.Recordset.Bookmark = book
n = Data1.Recordset.AbsolutePosition
l = Data1.Recordset.RecordCount - 1
Select Case n
Case 0
Toolbar1.Buttons.Item(3).Enabled = False
sy.Enabled = False
Toolbar1.Buttons.Item(4).Enabled = True
XY.Enabled = True
Case 1 To l - 1
Toolbar1.Buttons.Item(3).Enabled = True
Toolbar1.Buttons.Item(4).Enabled = True
sy.Enabled = True
XY.Enabled = True
Case l
Toolbar1.Buttons.Item(3).Enabled = True
Toolbar1.Buttons.Item(4).Enabled = False
XY.Enabled = False
sy.Enabled = True
End Select
If l = 0 Then
Toolbar1.Buttons.Item(3).Enabled = False
Toolbar1.Buttons.Item(4).Enabled = False
End If
Slirecon.Value = Data1.Recordset.AbsolutePosition
Label10.Caption = Str(Data1.Recordset.AbsolutePosition + 1)
End Sub
Private Sub dctable(tb As String) '导出表为TEXT文件
Dim zb As Database
Dim re As Recordset
Dim refield As Byte
Dim recount As Integer
Dim filenum As Byte
Dim i As Integer
Set zb = OpenDatabase(App.Path + "\zb.mdb")
Set re = zb.OpenRecordset(tb)
refield = re.Fields.Count
re.MoveLast
re.MoveFirst
recount = re.RecordCount
filenum = FreeFile
Open App.Path + "\" + CStr(Date) + ".txt" For Output As filenum
Select Case refield
Case 6
Write #filenum, re.Fields(0).Name, re.Fields(1).Name, re.Fields(2).Name, re.Fields(3).Name, re.Fields(4).Name, re.Fields(5).Name
Case 15
Write #filenum, re.Fields(0).Name, re.Fields(1).Name, re.Fields(2).Name, re.Fields(3).Name, re.Fields(4).Name, _
re.Fields(5).Name, re.Fields(6).Name, re.Fields(7).Name, re.Fields(8).Name, re.Fields(9).Name, _
re.Fields(10).Name, re.Fields(11).Name, re.Fields(12).Name, re.Fields(13).Name, re.Fields(14).Name
End Select
For i = 0 To recount - 1
Select Case refield
Case 6
Write #filenum, CStr(re.Fields(0).Value), re.Fields(1).Value, re.Fields(2).Value, re.Fields(3).Value, CInt(re.Fields(4).Value), re.Fields(5).Value
Case 15
Write #filenum, CStr(re.Fields(0).Value), re.Fields(1).Value, re.Fields(2).Value, re.Fields(3).Value, re.Fields(4).Value, _
re.Fields(5).Value, re.Fields(6).Value, re.Fields(7).Value, re.Fields(8).Value, re.Fields(9).Value, _
re.Fields(10).Value, re.Fields(11).Value, re.Fields(12).Value, re.Fields(13).Value, re.Fields(14).Value
End Select
re.MoveNext
Next i
Close filenum
MsgBox "数据已顺利导出，文件保存为" + App.Path + "\" + CStr(Date) + ".txt。" + Chr(13) + "请及时处理，因为当天若再有数据导出将会被覆盖！", 48, "提示"
End Sub
Private Sub cl_Click()
If Not (Month(Date) = 12 And Day(Date) = 31) Then
Dim n As Integer
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -