📄 frmpositioncard.frm
字号:
VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Object = "{81110CCB-022B-11D3-A348-0080C89152FF}#1.3#0"; "ORAGLIST.OCX"
Begin VB.Form frmPositionCard
BorderStyle = 1 'Fixed Single
Caption = "新增货位"
ClientHeight = 2220
ClientLeft = 45
ClientTop = 330
ClientWidth = 6210
HelpContextID = 30032
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2220
ScaleWidth = 6210
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin AtlEdit.TEdit txtInput
Height = 285
Index = 1
Left = 1320
TabIndex = 3
Top = 960
Width = 3225
_ExtentX = 5689
_ExtentY = 503
maxchar = 30
RBmenu = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Text = ""
End
Begin AtlEdit.TEdit txtInput
Height = 285
Index = 0
Left = 1320
TabIndex = 1
Top = 390
Width = 3225
_ExtentX = 5689
_ExtentY = 503
maxchar = 16
RBmenu = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Text = ""
End
Begin ListRefer.ListText lstDepartment
Height = 300
Left = 1320
TabIndex = 5
Top = 1500
Width = 3225
_ExtentX = 5689
_ExtentY = 529
CodeSort = -1 'True
BackColor = -2147483643
MaxLenth = 16
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CommandButton cmdOKCancel
Height = 350
Index = 2
Left = 4860
Style = 1 'Graphical
TabIndex = 8
Tag = "1009"
Top = 870
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Height = 350
Index = 0
Left = 4860
Style = 1 'Graphical
TabIndex = 6
Tag = "1001"
Top = 150
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Height = 350
Index = 1
Left = 4860
Style = 1 'Graphical
TabIndex = 7
Tag = "1002"
Top = 510
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CheckBox chkPause
Caption = "停用"
Height = 225
Left = 4860
TabIndex = 10
Top = 1830
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Height = 350
Index = 3
Left = 4860
Style = 1 'Graphical
TabIndex = 9
Tag = "1013"
Top = 1230
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.Label lblTitle
Caption = "所属部门(&D)"
Height = 225
Index = 2
Left = 300
TabIndex = 4
Top = 1530
Width = 1125
End
Begin VB.Label lblTitle
Caption = "货位名称(&N)"
Height = 285
Index = 1
Left = 300
TabIndex = 2
Top = 990
Width = 1065
End
Begin VB.Label lblTitle
Caption = "货位编码(&C)"
Height = 195
Index = 0
Left = 300
TabIndex = 0
Top = 450
Width = 1065
End
End
Attribute VB_Name = "frmPositionCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 货位卡片
' 作者：苏涛
' 日期：1998.06.23
'
' 功能：完成货位表的增、删、改操作
'
' 接口： AddCard 增加货位记录。
' 参数：intModal 显示模式，strName 用户输入值
' EditCard 修改货位记录。
' 参数： lngID 被修改的记录的ID，intModal 显示模式
' DelCard 删除货位记录。
' 参数： lngID 被删除的记录的ID
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text
Private mblnIsInit As Boolean
Private mblnIsList As Boolean
Private mblnIsRefer As Boolean
Private mblnIsNew As Boolean '是新增还是修改操作
Private mblnIsInActive As Boolean
Private mblnIsChanged As Boolean
Private mblnIsDetail As Boolean
Private mblnPIsInActive As Boolean 'NEW--上级停用，EDIT--目的停用
Private mblnPIsDetail As Boolean 'NEW--上级明细，EDIT--目的明细
Private mblnNotExit As Boolean
Private mintLevel As Integer
Private mintOldLevel As Integer
Private mlngLstID As Long
Private mlngPCodeID As Long 'NEW--上级ID，EDIT--目的ID
Private mlngPositionID As Long
Private mstrCode As String
Private mstrNotes As String
Private mstrName As String
Private mstrOldCode As String '以前的CODE
Private mstrOldName As String '以前的NAME
Private mstrOldFullName As String
Private mstrFullName As String
Private mstrStartDate As String
'增加货位
Public Function AddPosition(ByVal strPosition As String) As Integer
Dim strCode As String, strName As String, strTemp As String, blnIsStop As Boolean
Dim lngDepartmentID As Long
AddPosition = 0
If Not GetString(strPosition, strCode, 1) Then Exit Function
If Not GetString(strPosition, strName, 2) Then Exit Function
If Not GetString(strPosition, strTemp, 4) Then Exit Function
blnIsStop = (strTemp = "1")
If Not GetString(strPosition, strTemp, 7) Then Exit Function
lngDepartmentID = CLng(strTemp)
If Not GetString(strPosition, mstrNotes, 8) Then Exit Function
If strCode = "" Or strName = "" Then Exit Function
txtInput(0).Text = strCode
txtInput(1).Text = strName
If ItemIsExist("Department", "lngDepartmentID", lngDepartmentID) Then
mlngLstID = lngDepartmentID
Else
mlngLstID = 0
End If
chkPause.Value = IIf(blnIsStop, 1, 0)
mblnIsNew = True
'chkStop.Value=iif(.IsInActive,1,0)
If Not SaveCard(True) Then Exit Function
AddPosition = 1
End Function
'进入新增货位
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = vbModeless, _
Optional ByVal IsList As Boolean = False) As Long
mlngPositionID = 0
mblnIsNew = True
mblnIsChanged = True
Caption = "新增货位"
cmdOKCancel(2).Visible = True
mblnIsList = IsList
InitCard strName
Show intModal
AddCard = mlngPositionID
End Function
'进入修改货位
Public Sub EditCard(ByVal lngID As String, Optional intModal As Integer = vbModeless, _
Optional strName As String)
Dim recPosition As rdoResultset, strMess As String, strSql As String
strSql = "SELECT * FROM Position WHERE lngPositionID=" & lngID
Set recPosition = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recPosition.EOF Then
If Trim(strName) <> "" Then
strMess = "“" & strName & "”"
Else
strMess = "该"
End If
ShowMsg 0, strMess & "货位不存在，不能进行修改！", vbExclamation, "修改货位"
recPosition.Close
Unload Me
Exit Sub
End If
recPosition.Close
mblnIsNew = False
mblnIsChanged = False
mlngPositionID = lngID
Caption = "修改货位"
cmdOKCancel(2).Visible = False
cmdOKCancel(3).top = cmdOKCancel(2).top
InitCard
Show intModal
End Sub
Private Sub InitCard(Optional strName As String)
Dim recPosition As rdoResultset, strSql As String
mblnIsInit = True
mlngPCodeID = 0
mblnPIsDetail = False
mblnPIsInActive = False
If mblnIsNew Then
txtInput(1).Text = ""
txtInput(0).Text = Trim(strName)
mlngLstID = 0
lstDepartment.Text = ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -