📄 frmchoose.frm
字号:
VERSION 5.00
Begin VB.Form frmChoose
BorderStyle = 3 'Fixed Dialog
ClientHeight = 6285
ClientLeft = 45
ClientTop = 330
ClientWidth = 8205
Icon = "frmchoose.frx":0000
LinkTopic = "Form2"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6285
ScaleWidth = 8205
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Caption = "提示："
ForeColor = &H000000FF&
Height = 945
Left = 105
TabIndex = 5
Top = 5205
Width = 7980
Begin VB.CheckBox chkReserved
Caption = "保留当前位置"
ForeColor = &H000040C0&
Height = 225
Left = 690
TabIndex = 9
Top = -15
Width = 1410
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "选定上面的产品之后按确定按钮,〓为目录,◇为产品。"
Height = 360
Left = 5490
TabIndex = 8
Top = 375
Width = 2205
End
Begin VB.Shape Shape2
FillColor = &H0000C0C0&
FillStyle = 0 'Solid
Height = 300
Left = 5055
Shape = 3 'Circle
Top = 180
Width = 495
End
Begin VB.Shape Shape1
FillColor = &H000080FF&
FillStyle = 0 'Solid
Height = 540
Left = 5235
Top = 270
Width = 2610
End
Begin VB.Label Label1
Caption = "2、如果为新的客户或者产品时,请按新建按钮建立。"
ForeColor = &H00404040&
Height = 270
Index = 1
Left = 300
TabIndex = 7
Top = 600
Width = 4425
End
Begin VB.Label Label1
Caption = "1、在文本框中输入关键字,那么列表框中将自动搜索。"
ForeColor = &H00404040&
Height = 270
Index = 0
Left = 300
TabIndex = 6
Top = 330
Width = 4425
End
End
Begin VB.Frame Frame1
BorderStyle = 0 'None
Height = 405
Left = 105
TabIndex = 4
Top = 4725
Width = 8010
Begin VB.CommandButton cmdNew
Caption = "确定(&O)"
Height = 375
Left = 5595
TabIndex = 2
Top = 30
Width = 1110
End
Begin VB.TextBox txtInput
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 15
TabIndex = 1
Top = 45
Width = 5550
End
Begin VB.CommandButton cmdBack
BackColor = &H0000C000&
Cancel = -1 'True
Caption = "返回(&Esc)"
Height = 375
Left = 6720
Style = 1 'Graphical
TabIndex = 3
Top = 30
Width = 1260
End
End
Begin VB.ListBox lstResult
BackColor = &H00E0E0E0&
ForeColor = &H00004000&
Height = 4530
IntegralHeight = 0 'False
Left = 135
Sorted = -1 'True
TabIndex = 0
Top = 150
Width = 7950
End
End
Attribute VB_Name = "frmChoose"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const CB_FINDSTRING = &H14C
Const LB_FINDSTRING = &H18F
Dim DB As Connection
Dim Rec As Recordset
Dim strFieldName As String
Private Sub cmdBack_Click()
On Error Resume Next
Dim lPos As Integer
If Right(StrPathId, 1) = "\" Then
'是目录时
lPos = Len(StrPathId)
Dim sTmp As String
Dim X As Integer
sTmp = Left(StrPathId, lPos - 1)
lPos = lPos - 1
For X = 1 To lPos
If Right(sTmp, 1) <> "\" Then
sTmp = Left(sTmp, lPos - 1)
lPos = lPos - 1
Else
'新的目录时,退出
Exit For
End If
Next
StrPathId = Trim(sTmp)
'还原StrProID
If Right(StrProId, 1) = "\" Then
'是目录时
lPos = Len(StrProId)
sTmp = Left(StrProId, lPos - 1)
lPos = lPos - 1
For X = 1 To lPos
If Right(sTmp, 1) <> "\" Then
sTmp = Left(sTmp, lPos - 1)
lPos = lPos - 1
Else
'新的目录时,退出
Exit For
End If
Next
StrProId = Trim(sTmp)
End If
Select Case strType
Case "Production"
'赋值
strDBPath = ConData
strStorePath = ConData '给出库存状态
strRecName = "select * from tbdproduction where fldpropath='" + StrPathId + "'"
Case "Customer"
strDBPath = ConData
strStorePath = ConData '给出库存状态
strRecName = "select * from tbdcustomer where fldcuspath='" + StrPathId + "'"
Case Else
End Select
'刷新
Call Form_Activate
Else
'最上一层时退出
strValue = ""
Me.Hide
Exit Sub
End If
End Sub
Private Sub cmdNew_Click()
On Error Resume Next
'给出当前值,并且加上前斜杆 \
strValue = lstResult.List(lstResult.ListIndex)
If Trim(strValue) = "" Then
Call cmdBack_Click
Exit Sub
End If
Dim StrId As String
Dim strName As String
Select Case strType
Case "Production"
'取出名称与ID
'strName = Trim(Right$(strValue, Len(strValue) - 13))
'strName = Left(strName, InStr(strName, " ") - 1)
strName = Trim(Left(strValue, 12))
strValue = Trim(Left$(strValue, 12))
'为目录时
If Not (SearchInRecBool(ConData, "tbdproduction", "fldproid", GetNoPos(StrProId + strValue), "fldtruepro")) Then
'重新处理
strDBPath = ConData
strStorePath = ConData '给出库存状态
strRecName = "select * from tbdproduction where fldpropath='" + StrPathId + strName + "\'"
'使用前斜杆来确定当前位置
StrPathId = StrPathId + strName + "\"
StrProId = StrProId + strValue + "\"
strType = "Production"
Me.caption = Me.caption
'刷新列表
Call Form_Activate
Else
'为产品时,直接返回退出。
strValue = GetNoPos(StrProId + strValue)
If strValue <> "" Then
ReservedIT StrPathId, StrProId, "Save"
Me.Hide
Exit Sub
End If
End If
Case "Customer"
strName = Trim(Right$(strValue, Len(strValue) - 12))
strValue = Trim(Left$(strValue, 12))
If Not (SearchInRecBool(ConData, "tbdcustomer", "fldid", GetNoPos(StrProId + strValue), "fldtruecustomer")) Then
strDBPath = ConData
strStorePath = ConData '给出库存状态
strRecName = "select * from tbdcustomer where fldcuspath='" + StrPathId + strName + "\'"
strFieldName = "fldid"
StrPathId = StrPathId + strName + "\"
StrProId = StrProId + strValue + "\"
strType = "Customer"
'刷新列表
Call Form_Activate
Else
strValue = GetNoPos(StrProId + strValue)
If strValue <> "" Then
ReservedIT StrPathId, StrProId, "Save"
Me.Hide
Exit Sub
End If
End If
Case Else
If strValue <> "" Then
ReservedIT StrPathId, StrProId, "Save"
Me.Hide
Exit Sub
End If
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -