📄 frm_krcx.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frm_shtx
BorderStyle = 3 'Fixed Dialog
Caption = "送花提醒"
ClientHeight = 2712
ClientLeft = 2760
ClientTop = 3756
ClientWidth = 5592
Icon = "frm_krcx.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 2712
ScaleWidth = 5592
ShowInTaskbar = 0 'False
Begin VB.CheckBox Check1
Caption = "查看已送花客人"
Height = 270
Index = 1
Left = 120
TabIndex = 8
Top = 2430
Width = 1590
End
Begin VB.CheckBox Check1
Caption = "查看未送花客人"
Height = 270
Index = 0
Left = 120
TabIndex = 7
Top = 2160
Width = 1605
End
Begin VB.CommandButton Command1
Enabled = 0 'False
Height = 450
Index = 1
Left = 1725
MaskColor = &H00FFFFFF&
Picture = "frm_krcx.frx":000C
Style = 1 'Graphical
TabIndex = 6
Top = 2175
UseMaskColor = -1 'True
Width = 1236
End
Begin VB.CommandButton Command1
Enabled = 0 'False
Height = 450
Index = 2
Left = 3000
MaskColor = &H00FFFFFF&
Picture = "frm_krcx.frx":2C42
Style = 1 'Graphical
TabIndex = 5
Top = 2175
UseMaskColor = -1 'True
Width = 1236
End
Begin VB.CommandButton Command1
Cancel = -1 'True
Default = -1 'True
Height = 450
Index = 3
Left = 4275
MaskColor = &H00FFFFFF&
Picture = "frm_krcx.frx":554C
Style = 1 'Graphical
TabIndex = 4
Top = 2175
UseMaskColor = -1 'True
Width = 1236
End
Begin MSComctlLib.Slider Slider1
Height = 345
Left = 2370
TabIndex = 1
Top = 60
Width = 3180
_ExtentX = 5609
_ExtentY = 614
_Version = 393216
LargeChange = 2
SelStart = 3
Value = 3
End
Begin MSComctlLib.ListView ListView1
Height = 1650
Left = 90
TabIndex = 0
Top = 435
Width = 5400
_ExtentX = 9525
_ExtentY = 2921
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
HotTracking = -1 'True
HoverSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 6
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "姓名"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 1
Text = "性别"
Object.Width = 1058
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 2
Text = "生日"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "电话"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "地址"
Object.Width = 3528
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 5
Text = "已送花"
Object.Width = 1411
EndProperty
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "3"
BeginProperty Font
Name = "Arial"
Size = 10.8
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 1125
TabIndex = 3
Top = 90
Width = 120
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "提醒天数： 天"
Height = 180
Left = 132
TabIndex = 2
Top = 132
Width = 1464
End
End
Attribute VB_Name = "frm_shtx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rec As Recordset
Dim itmx As ListItem
Private Sub OKButton_Click()
End Sub
Private Sub Check1_Click(Index As Integer)
If Check1(0).Value = 1 And Check1(1).Value = 1 Then
sqlstr = "select * from 客户表"
Else
If Check1(0).Value = 1 And Check1(1).Value = 0 Then
sqlstr = "select * from 客户表 where 是否已送花='否'"
Else
If Check1(0).Value = 0 And Check1(1).Value = 1 Then
sqlstr = "select * from 客户表 where 是否已送花='是'"
Else
sqlstr = "select * from 客户表 where 是否已送花=''"
End If
End If
End If
Set rec = db.OpenRecordset(sqlstr)
ListView1.ListItems.Clear
Do While Not rec.EOF
Set itmx = ListView1.ListItems.Add(, , rec.Fields("姓名"))
For i = 1 To 5
If i = 2 Then
itmx.SubItems(i) = Format(rec.Fields(i), "yyyy-mm-dd")
Else
itmx.SubItems(i) = IIf(IsNull(rec.Fields(i)), "", rec.Fields(i))
End If
Next i
rec.MoveNext
Loop
If ListView1.ListItems.Count = 0 Then
Command1(1).Enabled = False
Command1(2).Enabled = False
Else
Command1(1).Enabled = True
Command1(2).Enabled = True
End If
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 1 '打印
dytr_main Me, 1, Me.Caption, "客户表"
Case 2 '删除
If MsgBox("真的想删除列表中显示的记录吗？", vbYesNo + vbQuestion + vbDefaultButton2, "提示") = vbNo Then
Exit Sub
End If
If Check1(0).Value = 1 And Check1(1).Value = 1 Then
sqlstr = "delete * from 客户表"
Else
If Check1(0).Value = 1 And Check1(1).Value = 0 Then
sqlstr = "delete * from 客户表 where 是否已送花='否'"
Else
If Check1(0).Value = 0 And Check1(1).Value = 1 Then
sqlstr = "delete * from 客户表 where 是否已送花='是'"
Else
sqlstr = "delete * from 客户表 where 是否已送花=''"
End If
End If
End If
db.Execute sqlstr
ListView1.ListItems.Clear
Case 3
Unload Me
End Select
End Sub
Private Sub Form_Load()
frmcen Me
n = GetSetting(App.title, "Options", "送花提醒", "3")
Label2 = n
Slider1.Value = Val(n)
sqlstr = "select * from 客户表 where 是否已送花='否'"
Set rec = db.OpenRecordset(sqlstr)
ListView1.ListItems.Clear
Do While Not rec.EOF
mm = Trim(Str(Month(rec.Fields("生日"))))
dd = Trim(Str(Day(rec.Fields("生日"))))
yy = Trim(Str(Year(Date)))
ymd = yy + "-" + mm + "-" + dd
If (CDate(ymd) - n <= Date) And (CDate(ymd) >= Date) Then
Set itmx = ListView1.ListItems.Add(, , rec.Fields("姓名"))
For i = 1 To 5
If i = 2 Then
itmx.SubItems(i) = Format(rec.Fields(i), "yyyy-mm-dd")
Else
itmx.SubItems(i) = IIf(IsNull(rec.Fields(i)), "", rec.Fields(i))
End If
Next i
End If
rec.MoveNext
Loop
If ListView1.ListItems.Count = 0 Then
Command1(1).Enabled = False
Command1(2).Enabled = False
Else
Command1(1).Enabled = True
Command1(2).Enabled = True
MsgBox "有一客人在 " + Str((CDate(ymd) - Date)) + " 天后过生日，您需要送花了", vbOKOnly + vbInformation, "提示"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.title, "Options", "送花提醒", Label2
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
If MsgBox("确定已经为〖" + Item.Text + "〗客人送鲜花吗？", vbYesNo + vbQuestion + vbDefaultButton2, "提示") = vbNo Then
Exit Sub
End If
db.Execute "update 客户表 set 是否已送花='是' where 姓名='" + itmx.Text + "' and 生日=#" + Item.SubItems(2) + "#"
Item.SubItems(5) = "是"
End Sub
Private Sub Slider1_Scroll()
Label2 = Slider1.Value
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -