form4.frm
来自「一套收费计算机系统」· FRM 代码 · 共 481 行
FRM
481 行
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Object = "{E2690E23-9719-101B-9306-0020AF234C9D}#4.1#0"; "CSCMD32.OCX"
Begin VB.Form Form4charge
BorderStyle = 1 'Fixed Single
Caption = "收费"
ClientHeight = 5310
ClientLeft = 45
ClientTop = 330
ClientWidth = 9420
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form4"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5310
ScaleWidth = 9420
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 6480
Top = 3720
Visible = 0 'False
Width = 2055
_ExtentX = 3625
_ExtentY = 661
ConnectMode = 3
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 2
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "FILE NAME=C:\My Documents\花寨子2000.udl"
OLEDBString = ""
OLEDBFile = "C:\My Documents\花寨子2000.udl"
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "交费库"
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.TextBox Text1
Height = 495
Left = 720
TabIndex = 1
Top = 120
Width = 1215
End
Begin CSCmdLibCtl.CSCmdBtn Command1
Height = 855
Left = 6480
OleObjectBlob = "Form4.frx":0000
TabIndex = 20
Top = 4320
Width = 975
End
Begin VB.TextBox Text9
ForeColor = &H000000FF&
Height = 495
Left = 4800
Locked = -1 'True
TabIndex = 19
Top = 4680
Width = 855
End
Begin VB.TextBox Text8
ForeColor = &H000000FF&
Height = 495
Left = 1200
Locked = -1 'True
TabIndex = 17
Top = 4680
Width = 1215
End
Begin VB.TextBox Text7
Height = 495
Left = 4800
Locked = -1 'True
TabIndex = 15
Top = 3960
Width = 855
End
Begin VB.TextBox Text6
Height = 495
Left = 1200
Locked = -1 'True
TabIndex = 13
Top = 3960
Width = 1215
End
Begin VB.TextBox Text5
Height = 495
Left = 6720
Locked = -1 'True
TabIndex = 10
Top = 3000
Width = 495
End
Begin VB.TextBox Text4
Height = 495
Left = 720
Locked = -1 'True
TabIndex = 8
Top = 3000
Width = 3375
End
Begin VB.TextBox Text3
Height = 495
Left = 720
Locked = -1 'True
TabIndex = 6
Top = 2040
Width = 1215
End
Begin VB.TextBox Text2
Height = 495
Left = 720
Locked = -1 'True
TabIndex = 2
Top = 1080
Width = 1215
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1
Bindings = "Form4.frx":04FF
Height = 2535
Left = 2160
TabIndex = 3
Top = 120
Width = 7095
_ExtentX = 12515
_ExtentY = 4471
_Version = 393216
Rows = 10
Cols = 6
MergeCells = 3
DataMember = "chargetable"
_NumberOfBands = 1
_Band(0).Cols = 6
_Band(0).GridLinesBand= 1
_Band(0).TextStyleBand= 0
_Band(0).TextStyleHeader= 0
_Band(0)._NumMapCols= 10
_Band(0)._MapCol(0)._Name= "编号"
_Band(0)._MapCol(0)._RSIndex= 0
_Band(0)._MapCol(1)._Name= "姓名"
_Band(0)._MapCol(1)._RSIndex= 3
_Band(0)._MapCol(2)._Name= "类型"
_Band(0)._MapCol(2)._RSIndex= 8
_Band(0)._MapCol(3)._Name= "交费日期"
_Band(0)._MapCol(3)._RSIndex= 6
_Band(0)._MapCol(4)._Name= "收视费"
_Band(0)._MapCol(4)._RSIndex= 9
_Band(0)._MapCol(4)._Alignment= 7
_Band(0)._MapCol(5)._Name= "初装日期"
_Band(0)._MapCol(5)._RSIndex= 1
_Band(0)._MapCol(5)._Hidden= -1 'True
_Band(0)._MapCol(6)._Name= "地址"
_Band(0)._MapCol(6)._RSIndex= 2
_Band(0)._MapCol(6)._Hidden= -1 'True
_Band(0)._MapCol(7)._Name= "增装盒"
_Band(0)._MapCol(7)._RSIndex= 4
_Band(0)._MapCol(7)._Hidden= -1 'True
_Band(0)._MapCol(8)._Name= "备注"
_Band(0)._MapCol(8)._RSIndex= 5
_Band(0)._MapCol(8)._Hidden= -1 'True
_Band(0)._MapCol(9)._Name= "初装费"
_Band(0)._MapCol(9)._RSIndex= 7
_Band(0)._MapCol(9)._Alignment= 7
_Band(0)._MapCol(9)._Hidden= -1 'True
End
Begin CSCmdLibCtl.CSCmdBtn Command2
Height = 855
Left = 7920
OleObjectBlob = "Form4.frx":0513
TabIndex = 21
Top = 4320
Width = 975
End
Begin VB.Label Label10
Caption = "收视费："
ForeColor = &H000000FF&
Height = 255
Left = 3960
TabIndex = 18
Top = 4800
Width = 855
End
Begin VB.Label Label9
Caption = "交费日期："
ForeColor = &H000000FF&
Height = 255
Left = 120
TabIndex = 16
Top = 4800
Width = 1095
End
Begin VB.Label Label8
Caption = "初装费："
Height = 255
Left = 3960
TabIndex = 14
Top = 4080
Width = 855
End
Begin VB.Label Label7
Caption = "初装日期："
Height = 255
Left = 120
TabIndex = 12
Top = 4080
Width = 1095
End
Begin VB.Label Label6
Height = 375
Left = 7320
TabIndex = 11
Top = 3120
Width = 255
End
Begin VB.Label Label5
Caption = "增装盒："
Height = 255
Left = 5880
TabIndex = 9
Top = 3120
Width = 855
End
Begin VB.Label Label4
Caption = "地址："
Height = 255
Left = 120
TabIndex = 7
Top = 3120
Width = 615
End
Begin VB.Label Label3
Caption = "类型："
Height = 255
Left = 120
TabIndex = 5
Top = 2160
Width = 615
End
Begin VB.Label Label2
Caption = "姓名："
Height = 255
Left = 120
TabIndex = 4
Top = 1200
Width = 615
End
Begin VB.Label Label1
Caption = "编号："
Height = 255
Left = 120
TabIndex = 0
Top = 240
Width = 615
End
End
Attribute VB_Name = "Form4charge"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim entrydate As Date
Dim adostatus As Boolean
'Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
'Dim handle As Long
Private Sub Command1_Click()
'确定收费
adostatus = True
Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields(1).Value = Text1.Text
Adodc1.Recordset.Fields(2).Value = Date
Adodc1.Recordset.Update
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text1.SetFocus
hzzde.rschargetable.Filter = adFilterNone
MSHFlexGrid1.Clear
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
'取消
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text1.SetFocus
hzzde.rschargetable.Filter = adFilterNone
MSHFlexGrid1.Clear
Command1.Enabled = False
End Sub
Private Sub Form_Load()
entrydate = Now()
MSHFlexGrid1.ColWidth(0, 0) = 300
MSHFlexGrid1.ColWidth(1, 0) = 1300
MSHFlexGrid1.ColWidth(2, 0) = 1300
MSHFlexGrid1.ColWidth(3, 0) = 1300
MSHFlexGrid1.ColWidth(4, 0) = 1300
MSHFlexGrid1.ColWidth(5, 0) = 1300
'MSHFlexGrid1.ColWidth(6, 0) = 1300
MSHFlexGrid1.MergeCol(1) = True
MSHFlexGrid1.MergeCol(2) = True
MSHFlexGrid1.MergeCol(3) = True
MSHFlexGrid1.MergeCol(5) = True
MSHFlexGrid1.BackColorFixed = vbCyan
MSHFlexGrid1.BackColorSel = vbBlue
MSHFlexGrid1.BackColorBkg = vbGreen
adostatus = False
Command1.Enabled = False
'hzzde.rschargetable.Open
'Me.ZOrder (1)
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Sort = 1
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
hzzde.rschargetable.Filter = adFilterNone
If adostatus Then
Adodc1.Recordset.Close
'Set Adodc1.Recordset = Nothing
End If
Call history(staff, entrydate, Me.Caption, Now())
Unload Me
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
'编号输入
hzzde.rschargetable.Requery
Dim but As Integer
If Len(Text1.Text) < 6 Then ' 当输入小于六个字母时
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 Then '除0-9，回撤键外其余的输入无效
KeyAscii = 0 '取消输入
End If
End If
If Len(Text1.Text) = 6 Then '当输入等于六个字母时
If KeyAscii = 13 Then '回车的处理
If Left(Text1.Text, 1) <> 1 And Left(Text1.Text, 1) <> 2 Then
MsgBox "输入数据错误，编号必须有六位数字，第一位必须为1或2。", vbOKOnly, "录入错误"
Text1.SetFocus
Else
' Debug.Print hzzde.Recordsets(2).ActiveConnection
' Load frmSplash
' frmSplash.Show
' frmSplash.ZOrder (0)
' handle = SetForegroundWindow(frmSplash.hwnd)
' hzzde.rschargetable.Open
' Unload frmSplash
hzzde.rschargetable.MoveFirst
hzzde.rschargetable.Find "编号='" & Text1.Text & "'", , adSearchForward, 1
If hzzde.rschargetable.EOF Then
but = MsgBox("所输编号不在库中，是否为新用户，" _
& Chr(13) & "如是，请按确定键，如不是，请按取消键。", vbOKCancel, "警示")
If but = vbCancel Then '取消
Text1.SetFocus
' hzzde.rschargetable.Close
Exit Sub
End If
If but = vbOK Then '确定
tnumber = Text1.Text '向新增用户窗口传递编号
Load Form41
Form41.Show vbModal
Text1.SetFocus
' hzzde.rschargetable.Close
Exit Sub
End If
Else
Text2.Text = hzzde.rschargetable.Fields(3).Value
Text3.Text = hzzde.rschargetable.Fields(8).Value
If Text3.Text = "城市户" Then
Text3.BackColor = &HFF8080
End If
If Text3.Text = "农村户" Then
Text3.BackColor = &H80FF80
End If
Text4.Text = hzzde.rschargetable.Fields(2).Value
If hzzde.rschargetable.Fields(4).Value = False Then
Text5.Text = "0"
Label6.Caption = "无"
Else
Text5.Text = "-1"
Label6.Caption = "有"
End If
Text6.Text = hzzde.rschargetable.Fields(1).Value
Text7.Text = hzzde.rschargetable.Fields(7).Value
Text8.Text = Format(Date, "yy-mm-dd")
Text9.Text = hzzde.rschargetable.Fields(9).Value
hzzde.rschargetable.Filter = "编号='" & Text1.Text & "'"
hzzde.rschargetable.Requery
Set MSHFlexGrid1.DataSource = hzzde
MSHFlexGrid1.DataMember = "chargetable"
MSHFlexGrid1.Refresh
hzzde.rschargetable.MoveFirst
Do While Not hzzde.rschargetable.EOF
If Year(hzzde.rschargetable.Fields(6).Value) = Year(Date) Then
MsgBox "请注意，此人今年已有收费记录。", vbOKOnly, "警示"
End If
hzzde.rschargetable.MoveNext
Loop
' MSHFlexGrid1.Redraw
Command1.Enabled = True
Command1.SetFocus
' hzzde.rschargetable.Close
End If
End If
End If
If KeyAscii <> 8 Then '回撤键的处理
KeyAscii = 0 '取消输入
End If
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?