?? 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 + -