📄 frmpositionlistcard.frm
字号:
VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.2#0"; "ATLEDIT.OCX"
Object = "{E0B099CD-729C-11D2-840D-444553540000}#2.0#0"; "LISTTEXT.OCX"
Begin VB.Form frmPositionListCard
BorderStyle = 1 'Fixed Single
Caption = "新增货位"
ClientHeight = 2220
ClientLeft = 45
ClientTop = 330
ClientWidth = 6210
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
ScaleHeight = 2220
ScaleWidth = 6210
ShowInTaskbar = 0 'False
Begin AtlEdit.TEdit txtInput
Height = 285
Index = 1
Left = 1200
TabIndex = 3
Top = 870
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 = 1200
TabIndex = 1
Top = 360
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 = 1200
TabIndex = 5
Tag = "3"
Top = 1350
Width = 3225
_ExtentX = 5689
_ExtentY = 529
BackColor = -2147483643
MaxLenth = 46
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 = 9
Tag = "1009"
Top = 960
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Default = -1 'True
Height = 350
Index = 0
Left = 4860
Style = 1 'Graphical
TabIndex = 7
Tag = "1001"
Top = 180
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Cancel = -1 'True
Height = 350
Index = 1
Left = 4860
Style = 1 'Graphical
TabIndex = 8
Tag = "1002"
Top = 570
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CheckBox chkPause
Caption = "停用"
Height = 225
Left = 4860
TabIndex = 6
Top = 1800
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Height = 350
Index = 3
Left = 4860
Style = 1 'Graphical
TabIndex = 10
Tag = "1013"
Top = 1380
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.Label lblTitle
Caption = "所属部门(&D)"
Height = 225
Index = 2
Left = 180
TabIndex = 4
Top = 1380
Width = 1125
End
Begin VB.Label lblTitle
Caption = "货位名称(&N)"
Height = 285
Index = 1
Left = 180
TabIndex = 2
Top = 900
Width = 1065
End
Begin VB.Label lblTitle
Caption = "货位编码(&C)"
Height = 195
Index = 0
Left = 180
TabIndex = 0
Top = 420
Width = 1065
End
End
Attribute VB_Name = "frmPositionListCard"
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 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 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
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
'进入新增货位
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = vbModeless) As Long
If IsContinue Then Exit Function
mlngPositionID = 0
mblnIsNew = True
mblnIsChanged = True
Caption = "新增货位"
cmdOKCancel(2).Default = True
cmdOKCancel(2).Visible = True
InitCard strName
If Me.WindowState = 1 Then Me.WindowState = 0
Show intModal
AddCard = mlngPositionID
Refresh
ZOrder 0
Unload MsgForm
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
If IsContinue Then Exit Sub
Strsql = "SELECT * FROM Position WHERE lngPositionID=" & lngID
Set recPosition = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenForwardOnly)
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(0).Default = True
cmdOKCancel(2).Visible = False
cmdOKCancel(3).top = cmdOKCancel(2).top
InitCard
If Me.WindowState = 1 Then Me.WindowState = 0
Show intModal
Refresh
ZOrder 0
Unload MsgForm
End Sub
Private Function IsContinue() As Boolean
Dim lngResult As Long
IsContinue = True
If mblnIsChanged Then
Me.ZOrder 0
lngResult = ShowMsg(Me.hwnd, "上一次编辑的货位还未保存，是否继续编辑它？", vbYesNoCancel + vbQuestion, "货位卡片提示信息")
If lngResult = vbYes Then '继续编辑上一次的货位
SendKeys "%{C}"
Exit Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -