📄 frmscfind.frm
字号:
TabIndex = 2
Top = 0
Width = 7455
Begin VB.CommandButton CmdFind
Caption = "查询"
Height = 330
Left = 6840
TabIndex = 9
Top = 60
Width = 615
End
Begin VB.TextBox Txtname
Height = 300
Left = 1680
TabIndex = 3
Top = 120
Width = 1455
End
Begin MSComCtl2.DTPicker DTP1
Height = 330
Left = 3720
TabIndex = 5
Top = 75
Width = 1335
_ExtentX = 2355
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarForeColor= 16711680
CalendarTitleBackColor= 255
Format = 62128129
CurrentDate = 36404
End
Begin MSComCtl2.DTPicker DTP2
Height = 330
Left = 5400
TabIndex = 6
Top = 75
Width = 1335
_ExtentX = 2355
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarForeColor= 16711680
CalendarTitleBackColor= 255
Format = 62128129
CurrentDate = 36404
End
Begin VB.Label Label1
Caption = "至:"
ForeColor = &H00FF0000&
Height = 255
Index = 2
Left = 5160
TabIndex = 8
Top = 120
Width = 375
End
Begin VB.Label Label1
Caption = "日期:"
ForeColor = &H00FF0000&
Height = 255
Index = 0
Left = 3240
TabIndex = 7
Top = 120
Width = 615
End
Begin VB.Label Label1
BackColor = &H00C0C0C0&
Caption = "查询内容:"
ForeColor = &H00FF0000&
Height = 255
Index = 1
Left = 840
TabIndex = 4
Top = 120
Width = 975
End
End
End
Begin MSComctlLib.TreeView Tvwdb
Height = 3495
Left = 0
TabIndex = 0
ToolTipText = "双击可修改"
Top = 480
Width = 2535
_ExtentX = 4471
_ExtentY = 6165
_Version = 393217
Indentation = 353
LabelEdit = 1
Style = 7
HotTracking = -1 'True
SingleSel = -1 'True
ImageList = "ImgIcon"
Appearance = 1
End
Begin MSComctlLib.ImageList ImgIcon
Left = 120
Top = 1320
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 12
MaskColor = 12632256
UseMaskColor = 0 'False
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmScFind.frx":284E
Key = "closed"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmScFind.frx":2CA2
Key = "book"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmScFind.frx":30F6
Key = "open"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmScFind.frx":354A
Key = "delta"
EndProperty
EndProperty
End
End
Attribute VB_Name = "FrmScFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim nodX As Node
Dim findtb As Recordset
Dim mIndex As Integer
Private Sub DisplayTree()
Dim intIndex
Dim Sum As Integer
Dim Sum1 As Integer
Dim Taptb As Recordset
Tvwdb.Nodes.Clear
Set nodX = Tvwdb.Nodes.Add()
nodX.Text = "[" & Year(Date) & "年]调用单"
nodX.Tag = "TAP"
nodX.Image = "delta"
Set nodX = Tvwdb.Nodes.Add(1, tvwChild, , "未退还", "closed")
nodX.Tag = "NO"
nodX.Key = "NO"
intIndex = nodX.Index
Set Taptb = New Recordset
If Len(ChFindflag) = 0 Then
Taptb.Open " select * from lendinfo left join client on lendinfo.clino=client.clino where lendinfo.state='未退还' and lendinfo.lend_date>=" & "'" & DTP1.value & "'" & " and lendinfo.lend_date<=" & "'" & DTP2.value & "'" & " order by lendinfo.lend_date", db, adOpenStatic, adLockOptimistic
Else
Taptb.Open " select * from lendinfo left join client on lendinfo.clino=client.clino where lendinfo.state='未退还' and (client.s_name like '%" & Txtname.Text & "%'" & " or lendinfo.model like '%" & Txtname & "%') order by lendinfo.lend_date", db, adOpenStatic, adLockOptimistic
End If
Do Until Taptb.EOF
Set nodX = Tvwdb.Nodes.Add(intIndex, tvwChild, , Trim(Taptb!s_name) & Space(1) & Trim(Taptb!model), "open")
nodX.Tag = Trim(Taptb!lend_info)
Taptb.MoveNext
Loop
Sum = Taptb.RecordCount
' Set nodX = Tvwdb.Nodes.Add(1, tvwChild, , "进行中", "closed")
' nodX.Tag = "PUT"
' nodX.Key = "PUT"
' intIndex = nodX.Index
' Set Taptb = New Recordset
' If Len(ChFindflag) = 0 Then
' Taptb.Open " select * from tap_view where state='进行中' and din_date>=" & "'" & DTP1.value & "'" & " and din_date<=" & "'" & DTP2.value & "'" & " order by dinno", db, adOpenStatic, adLockOptimistic
' Else
' Taptb.Open " select * from tap_view where state='进行中' and (s_name like '%" & Txtname.Text & "%'" & " or model like '%" & Txtname.Text & "%') order by dinno", db, adOpenStatic, adLockOptimistic
' End If
' Do Until Taptb.EOF
' Set nodX = Tvwdb.Nodes.Add(intIndex, tvwChild, , Trim(Taptb!s_name) & Space(1) & Trim(Taptb!model), "open")
' nodX.Tag = Trim(Taptb!dinno)
' Taptb.MoveNext
' Loop
' Sum1 = Taptb.RecordCount
Set nodX = Tvwdb.Nodes.Add(1, tvwChild, , "已退还", "closed")
nodX.Tag = "FINISH"
nodX.Key = "FINISH"
intIndex = nodX.Index
Set Taptb = New Recordset
If Len(ChFindflag) = 0 Then
Taptb.Open " select * from lendinfo left join client on lendinfo.clino=client.clino where lendinfo.state='已退还' and lendinfo.lend_date>=" & "'" & DTP1.value & "'" & " and lendinfo.lend_date<=" & "'" & DTP2.value & "'" & " order by lendinfo.lend_date", db, adOpenStatic, adLockOptimistic
Else
Taptb.Open " select * from lendinfo left join client on lendinfo.clino=client.clino where lendinfo.state='已退还' and (client.s_name like '%" & Txtname.Text & "%'" & " or lendinfo.model like '%" & Txtname & "%') order by lendinfo.lend_date", db, adOpenStatic, adLockOptimistic
End If
Do Until Taptb.EOF
Set nodX = Tvwdb.Nodes.Add(intIndex, tvwChild, , Trim(Taptb!s_name) & Space(1) & Trim(Taptb!model), "open")
nodX.Tag = Trim(Taptb!lend_info)
Taptb.MoveNext
Loop
Me.Caption = "调用资料 当前单数:" & (Sum + Taptb.RecordCount) & " 未退还:" & Sum & " 已退还:" & Taptb.RecordCount
Tvwdb.Nodes(1).Expanded = True
Tvwdb.Nodes(2).Expanded = True
End Sub
Private Sub cmdfind_Click()
Set findtb = New Recordset
If Len(Txtname.Text) = 0 Then
findtb.Open "select top 2 * from lendinfo left join client on lendinfo.clino=client.clino where lendinfo.state='未退还' and lendinfo.lend_date>=" & "'" & DTP1.value & "'" & " and lendinfo.lend_date<=" & "'" & DTP2.value & "'" & " order by lendinfo.lend_date", db, adOpenStatic, adLockOptimistic
Else
findtb.Open "select top 2 * from lendinfo left join client on lendinfo.clino=client.clino where lendinfo.state='未退还' and (client.s_name like '%" & Txtname.Text & "%'" & " or lendinfo.model like '%" & Txtname & "%') order by lendinfo.lend_date", db, adOpenStatic, adLockOptimistic
End If
If findtb.RecordCount <> 0 Then
ChFindflag = findtb!lend_info
Call DisplayTree
Call Find
Else
MsgBox "Sorry,没有此关键字的调用单!!!!", vbCritical, MSG2
Exit Sub
End If
End Sub
Private Sub DatDetail_Reposition()
DatDetail.Caption = DatDetail.Recordset.AbsolutePosition & "/" & DatDetail.Recordset.RecordCount
End Sub
Private Sub DatPrimaryRS_Reposition()
' On Error Resume Next
' If IsNull(DatPrimaryRS.Recordset!start_year) = False Then
' lbltap.Caption = ""
' lbltap.Caption = DatPrimaryRS.Recordset!tap_op
' lbltime.Caption = DatPrimaryRS.Recordset!start_month & "月" & _
' DatPrimaryRS.Recordset!start_day & "日" & DatPrimaryRS.Recordset!start_hour & "时到:" & _
' DatPrimaryRS.Recordset!end_month & "月" & _
' DatPrimaryRS.Recordset!end_day & "日" & DatPrimaryRS.Recordset!end_hour & "时"
' Else
' lbltap.Caption = ""
' lbltime.Caption = ""
' End If
'
' Select Case DatPrimaryRS.Recordset!dflag
' Case -1
' Chk(0).value = 1
' Case 0
' Chk(0).value = 0
' End Select
'
'
' Select Case DatPrimaryRS.Recordset!miflag
' Case -1
' Chk(1).value = 1
' Case 0
' Chk(1).value = 0
' End Select
End Sub
Private Sub Form_Activate()
Txtname.SetFocus
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
DTP1.value = Date - 10
DTP2.value = Date
ChFindflag = ""
Me.Move 0, 0
Me.Height = 4500
Me.Width = 9690
Call DisplayTree
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
ChFindflag = ""
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.Top = 0
Me.Left = 50
End Sub
Private Sub Tool_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo err
Select Case Button.Index
Case 1
'ChAddflag = "MODI"
'frmscmodi.Show 1
Case 2
Call DisplayTree
Case 4
Unload Me
End Select
Exit Sub
err:
Exit Sub
End Sub
Private Sub Tvwdb_DblClick()
' Call PubModify
End Sub
Private Sub Tvwdb_NodeClick(ByVal Node As MSComctlLib.Node)
Node.BackColor = &HFFFFFF
If Node.Tag = "FINISH" Or Node.Tag = "NO" Then Exit Sub
ChFindflag = Node.Tag
mIndex = Node.Index
Call Find
End Sub
Private Sub Txtname_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Txtname.Text = Trim(Txtname.Text)
Call cmdfind_Click
End If
End Sub
Private Sub Find()
Set findtb = New Recordset
findtb.Open "select * from lendinfo where lend_info=" & "'" & ChFindflag & "'", db, adOpenStatic, adLockOptimistic
Set DatPrimaryRS.Recordset = findtb
'Set findtb = New Recordset
'findtb.Open "select * from lendinfo where lend_info=" & "'" & ChFindflag & "'" & " order by lend_date", db, adOpenStatic, adLockOptimistic
'Set DatDetail.Recordset = findtb
End Sub
Private Sub PubModify()
ChAddflag = "MODI"
If ChFindflag = "NO" Or ChFindflag = "FINISH" Then Exit Sub
If Len(ChFindflag) = 0 Then
MsgBox "没有选中要修改的生产资料调用单，无效 ！！！", vbCritical, MSG2
Exit Sub
Else
frmscmodi.Show 1
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -