📄 frmmember.frm
字号:
VERSION 5.00
Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "THREED32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmMember
Caption = "会员管理"
ClientHeight = 5100
ClientLeft = 60
ClientTop = 630
ClientWidth = 6840
Icon = "frmMember.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 5100
ScaleWidth = 6840
WindowState = 2 'Maximized
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 4575
Left = 0
TabIndex = 6
Top = 630
Width = 6855
_ExtentX = 12091
_ExtentY = 8070
_Version = 393216
FixedCols = 0
AllowBigSelection= 0 'False
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 1
BorderStyle = 0
End
Begin Threed.SSPanel sTool
Height = 645
Left = 0
TabIndex = 0
Top = 15
Width = 6825
_Version = 65536
_ExtentX = 12039
_ExtentY = 1138
_StockProps = 15
BackColor = 12632256
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderWidth = 1
BevelOuter = 1
RoundedCorners = 0 'False
Begin Threed.SSCommand cmdModify
Height = 435
Left = 1500
TabIndex = 4
Top = 75
Width = 1395
_Version = 65536
_ExtentX = 2461
_ExtentY = 767
_StockProps = 78
Caption = "修改会员"
BevelWidth = 1
End
Begin Threed.SSCommand cmdAdd
Height = 435
Left = 90
TabIndex = 1
Top = 75
Width = 1395
_Version = 65536
_ExtentX = 2461
_ExtentY = 767
_StockProps = 78
BevelWidth = 1
Picture = "frmMember.frx":030A
End
Begin Threed.SSCommand cmdDel
Height = 435
Left = 2910
TabIndex = 2
Top = 75
Width = 1395
_Version = 65536
_ExtentX = 2461
_ExtentY = 767
_StockProps = 78
BevelWidth = 1
Picture = "frmMember.frx":1A86
End
Begin Threed.SSCommand cmdCancel
Height = 435
Left = 6045
TabIndex = 5
Top = 75
Width = 1395
_Version = 65536
_ExtentX = 2461
_ExtentY = 767
_StockProps = 78
BevelWidth = 1
Picture = "frmMember.frx":3202
End
Begin Threed.SSCommand cmdSearch
Height = 435
Left = 4485
TabIndex = 3
Top = 75
Width = 1395
_Version = 65536
_ExtentX = 2461
_ExtentY = 767
_StockProps = 78
BevelWidth = 1
Picture = "frmMember.frx":497E
End
End
Begin VB.Menu mnuControl
Caption = "控制中心(&C)"
Begin VB.Menu mnuMemberAdd
Caption = "会员添加(&A)"
Shortcut = ^N
End
Begin VB.Menu mnuMemberModify
Caption = "会员修改(&M)"
Shortcut = ^M
End
Begin VB.Menu mnuMemberDel
Caption = "会员删除(&D)"
Shortcut = {DEL}
End
Begin VB.Menu LIne02
Caption = "-"
End
Begin VB.Menu mnuMemberSearch
Caption = "会员查询(&S)"
Shortcut = {F3}
End
Begin VB.Menu mnuRefresh
Caption = "显示所有会员(&R)"
Shortcut = {F4}
End
Begin VB.Menu Line202
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "关闭返回(&X)"
Shortcut = ^X
End
End
End
Attribute VB_Name = "frmMember"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdAdd_Click()
frmNewForm.Show 1
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdDel_Click()
If Grid1.Text = "" Then
MsgBox "请选定需要删除的会员,然后按删除按钮？ ", vbExclamation, "Design By Yusilong."
Exit Sub
ElseIf MsgBox("真的删除 [ " & Grid1.Text & " ] 吗（Y/N）？ ", vbCritical + vbYesNo, "删除后不能恢复 ：-( ") = vbYes Then
' 删除代码
DelRecord Grid1.Text, "卡号", "Detail"
' 刷新数据
Grid1.RemoveItem Grid1.Row
End If
End Sub
Private Sub cmdModify_Click()
If Grid1.Text = "" Then
MsgBox "请选定需要修改的会员,然后按修改按钮？ ", vbExclamation, "Design By Yusilong."
Exit Sub
Else
frmModifyForm.Show 1
End If
End Sub
Private Sub cmdSearch_Click()
frmMemberSearch.Show 1
'安装数据
If sMemberStr = "" Then Exit Sub
LoadData
End Sub
Private Sub Form_Load()
'安装数据
ConfigGrid
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
sTool.Width = Me.ScaleWidth
Grid1.Width = Me.ScaleWidth + 8
Grid1.Height = Me.ScaleHeight - sTool.Height + 10
End Sub
Private Sub ConfigGrid()
On Error GoTo Err_init
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 9
Grid1.FormatString = "^ 卡号 |^ 姓名 |^ 性别 |^ 电话 |^ 传真 |^ 传呼 |^ 手机 |^ 邮件 |^ 地址 "
Grid1.ColWidth(0) = 1600
Grid1.ColWidth(1) = 800
Grid1.ColWidth(2) = 600
Grid1.ColWidth(3) = 1600
Grid1.ColWidth(4) = 1200
Grid1.ColWidth(5) = 1200
Grid1.ColWidth(6) = 1200
Grid1.ColWidth(7) = 1600
Grid1.ColWidth(8) = 2150
Dim DB As Database, EF As Recordset, HH As Integer, DelNo As Long
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, tempStr As String, sureStr As String, Qy As Integer
Set DB = OpenDatabase(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("Detail", dbOpenTable)
DelNo = EF.RecordCount
Grid1.Rows = EF.RecordCount + 1
If DelNo < 29 Then '缺省29行
Grid1.Rows = 29
End If
Set EF = DB.OpenRecordset("Detail", dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 0
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
Grid1.Text = EF.Fields(1).Value
End If
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(0).Value) Then
Grid1.Text = EF.Fields(0).Value
End If
Grid1.Row = HH
Grid1.Col = 2
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(2).Value) Then
Grid1.Text = EF.Fields(2).Value
End If
Grid1.Row = HH
Grid1.Col = 3
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(3).Value) Then
Grid1.Text = EF.Fields(3).Value
End If
Grid1.Row = HH
Grid1.Col = 4
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(4).Value) Then
Grid1.Text = EF.Fields(4).Value
End If
Grid1.Row = HH
Grid1.Col = 5
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(5).Value) Then
Grid1.Text = EF.Fields(5).Value
End If
Grid1.Row = HH
Grid1.Col = 6
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(6).Value) Then
Grid1.Text = EF.Fields(6).Value
End If
Grid1.Row = HH
Grid1.Col = 7
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(7).Value) Then
Grid1.Text = EF.Fields(7).Value
End If
Grid1.Row = HH
Grid1.Col = 8
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(8).Value) Then
Grid1.Text = EF.Fields(8).Value
End If
EF.MoveNext
HH = HH + 1
Loop
EF.Close
DB.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 8
Grid1.Visible = True
Exit Sub
Err_init:
MsgBox "网络配置错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Grid1_DblClick()
If Grid1.Text = "" Then
' 显示添加
cmdAdd_Click
Else
cmdModify_Click
End If
End Sub
Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If Grid1.Text = "" Then
mnuMemberDel.Enabled = False
mnuMemberModify.Enabled = False
Else
mnuMemberDel.Enabled = True
mnuMemberModify.Enabled = True
End If
PopupMenu mnuControl
End If
End Sub
Private Sub mnuControl_Click()
If Grid1.Text = "" Then
mnuMemberDel.Enabled = False
mnuMemberModify.Enabled = False
Else
mnuMemberDel.Enabled = True
mnuMemberModify.Enabled = True
End If
End Sub
Private Sub mnuExit_Click()
Call cmdCancel_Click
End Sub
Private Sub mnuMemberAdd_Click()
Call cmdAdd_Click
End Sub
Private Sub mnuMemberDel_Click()
Call cmdDel_Click
End Sub
Private Sub mnuMemberModify_Click()
Call cmdModify_Click
End Sub
Private Sub mnuMemberSearch_Click()
Call cmdSearch_Click
End Sub
Public Sub mnuRefresh_Click()
sMemberStr = "" '查询字符串为空
'安装数据
ConfigGrid
End Sub
Private Sub LoadData()
On Error GoTo Err_init
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 9
Grid1.FormatString = "^ 卡号 |^ 姓名 |^ 性别 |^ 电话 |^ 传真 |^ 传呼 |^ 手机 |^ 邮件 |^ 地址 "
Grid1.ColWidth(0) = 1600
Grid1.ColWidth(1) = 800
Grid1.ColWidth(2) = 600
Grid1.ColWidth(3) = 1600
Grid1.ColWidth(4) = 1200
Grid1.ColWidth(5) = 1200
Grid1.ColWidth(6) = 1200
Grid1.ColWidth(7) = 1600
Grid1.ColWidth(8) = 2150
Dim DB As Database, EF As Recordset, HH As Integer, DelNo As Long
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, tempStr As String, sureStr As String, Qy As Integer
Set DB = OpenDatabase(ConData, False, False, Constr)
Set EF = DB.OpenRecordset("Detail", dbOpenTable)
DelNo = EF.RecordCount
Grid1.Rows = EF.RecordCount + 1
If DelNo < 29 Then '缺省29行
Grid1.Rows = 29
End If
Set EF = Nothing
If InStr(1, sMemberStr, "Select", vbTextCompare) > 0 Then
sMemberStr = sMemberStr
Else
sMemberStr = "Select * From Detail Where " & sMemberStr
End If
Set EF = DB.OpenRecordset(sMemberStr, dbOpenDynaset)
HH = 1
Do While Not EF.EOF()
Grid1.Row = HH
Grid1.Col = 0
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
Grid1.Text = EF.Fields(1).Value
End If
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(0).Value) Then
Grid1.Text = EF.Fields(0).Value
End If
Grid1.Row = HH
Grid1.Col = 2
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(2).Value) Then
Grid1.Text = EF.Fields(2).Value
End If
Grid1.Row = HH
Grid1.Col = 3
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(3).Value) Then
Grid1.Text = EF.Fields(3).Value
End If
Grid1.Row = HH
Grid1.Col = 4
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(4).Value) Then
Grid1.Text = EF.Fields(4).Value
End If
Grid1.Row = HH
Grid1.Col = 5
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(5).Value) Then
Grid1.Text = EF.Fields(5).Value
End If
Grid1.Row = HH
Grid1.Col = 6
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(6).Value) Then
Grid1.Text = EF.Fields(6).Value
End If
Grid1.Row = HH
Grid1.Col = 7
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(7).Value) Then
Grid1.Text = EF.Fields(7).Value
End If
Grid1.Row = HH
Grid1.Col = 8
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(8).Value) Then
Grid1.Text = EF.Fields(8).Value
End If
EF.MoveNext
HH = HH + 1
Loop
EF.Close
DB.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 8
Grid1.Visible = True
Exit Sub
Err_init:
MsgBox "网络配置错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -