📄 frmitemunitcard.frm
字号:
VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmItemUnitCard
BorderStyle = 3 'Fixed Dialog
Caption = "增加商品单位 "
ClientHeight = 1890
ClientLeft = 45
ClientTop = 330
ClientWidth = 4635
HelpContextID = 10214
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1890
ScaleWidth = 4635
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdUnit
Height = 350
Index = 2
Left = 3360
Style = 1 'Graphical
TabIndex = 6
Tag = "1009"
Top = 1020
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdUnit
Cancel = -1 'True
Height = 350
Index = 1
Left = 3360
Style = 1 'Graphical
TabIndex = 5
Tag = "1002"
Top = 630
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdUnit
Height = 350
Index = 0
Left = 3360
Style = 1 'Graphical
TabIndex = 4
Tag = "1001"
Top = 240
UseMaskColor = -1 'True
Width = 1215
End
Begin AtlEdit.TEdit tedUnitName
Height = 375
Index = 0
Left = 360
TabIndex = 1
Top = 960
Width = 975
_ExtentX = 1720
_ExtentY = 661
maxchar = 6
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 tedUnitName
Height = 375
Index = 1
Left = 1560
TabIndex = 3
Top = 960
Width = 975
_ExtentX = 1720
_ExtentY = 661
maxchar = 9
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 VB.Label lbltitle
Caption = "="
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 4
Left = 1365
TabIndex = 8
Top = 960
Width = 255
End
Begin VB.Label lbltitle
Caption = "计量单位(&U)"
Height = 255
Index = 0
Left = 360
TabIndex = 0
Top = 600
Width = 1095
End
Begin VB.Label lbltitle
Caption = "计量规格(&R)"
Height = 255
Index = 1
Left = 1560
TabIndex = 2
Top = 600
Width = 1095
End
Begin VB.Label lbltitle
Caption = "斤"
Height = 255
Index = 3
Left = 2640
TabIndex = 7
Top = 1080
Width = 495
End
End
Attribute VB_Name = "frmItemUnitCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 计量单位卡片
' 作者：郑权
' 日期：1998.07.21
'
' 功能：完成计量单位的增、删、改操作
'
' 接口： AddCard 增加计量单位记录。
' 参数：intModal 显示模式，strName 用户输入值
' EditCard 修改计量单位记录。
' 参数： lngRecordID 被修改的记录的ID，intModal 显示模式
' DelCard 删除计量单位记录。
' 参数： lngRecordID 被删除的记录的ID
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Type ItemUnitRecord '处理计量单位表的记录
lngUnitID As Long ' 计量单位id
strUnitName As String '计量单位名称
dblFactor As Double '计量规格
lngItemID As Long '商品ID
End Type
'Private WithEvents mclsMainControl As MainControl '主控对象
Private mblnAddRecord As Boolean '是增加记录还是修改记录
Private mblnIsList As Boolean
Private mstrSQLBuffer() As String '暂时存储对数据库的增删改操作
Private mintSQLIndex As Integer 'strSQLBuffer的索引
Private mUnit As ItemUnitRecord '暂存读写记录的数据
Private mstrInitCode As String '暂存编码的初始值，以备判断是否修改
Private ID As Long
Private mIsChanged As Boolean
'引入商品单位
Public Function AddItemUnit(ByVal strItemUnit As String) As Integer
Dim strUnit As String, lngItemID As Long, dblFactor As Double, strTemp As String
On Error GoTo ErrHandle
AddItemUnit = 0
strUnit = StringOut(strItemUnit, Chr(9))
strTemp = StringOut(strItemUnit, Chr(9))
lngItemID = CLng(strTemp)
strTemp = StringOut(strItemUnit, Chr(9))
dblFactor = CDbl(strTemp)
If strUnit = "" Or lngItemID = 0 Or dblFactor <= 0 Then GoTo ErrHandle
tedUnitName(0).Text = strUnit
tedUnitName(1).Text = dblFactor
mUnit.strUnitName = strUnit
mUnit.lngItemID = lngItemID
mUnit.dblFactor = dblFactor
If Not AddUnit Then GoTo ErrHandle
AddItemUnit = 1
ErrHandle:
End Function
Private Function AddUnit() As Boolean
Dim recUnit As rdoResultset, strSql As String
On Error GoTo ErrHandle
AddUnit = False
strSql = "SELECT * FROM ItemUnit WHERE strUnitName='" & mUnit.strUnitName _
& "' AND lngItemID=" & mUnit.lngItemID & " AND dblFactor=" & mUnit.dblFactor
Set recUnit = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, 4)
With recUnit
If .EOF Then
ID = GetNewID("ItemUnit")
.AddNew
!lngUnitID = ID
!strUnitName = mUnit.strUnitName
!lngItemID = mUnit.lngItemID
!dblFactor = mUnit.dblFactor
.Update
AddUnit = True
Else
' .Edit
' .rdocolumns(0).Value = mUnit.lngUnitID
' .rdocolumns(1).Value = mUnit.strUnitName
' .rdocolumns(2).Value = mUnit.lngItemID
' .rdocolumns(3).Value = mUnit.dblFactor
End If
End With
recUnit.Close
ErrHandle:
Err.Number = 0
End Function
'进入新增摘要
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, Optional lngItemID As Long = 0, _
Optional ByVal IsList As Boolean = False) As Long
mblnAddRecord = True
frmItemUnitCard.Caption = "新增计量单位"
cmdUnit(2).Visible = True
mblnIsList = True
InitAddCard strName, lngItemID
Show intModal
AddCard = ID
End Function
'初始化暂存读写记录的数据的自定义类型变量和卡片
Private Sub InitAddCard(Optional strName As String, Optional lngItemID As Long = 0)
Dim strSql As String
Dim recSelect As rdoResultset
Dim strBaseUnit As String
With mUnit
.lngUnitID = 0
.strUnitName = ""
.lngItemID = lngItemID
.dblFactor = 1
If tedUnitName(0).Text <> "" Then mstrInitCode = tedUnitName(0).Text
End With
strSql = "select ItemUnit.strUnitName from item,itemunit " & _
"WHERE Item.lngMinUnitID=ItemUnit.lngUnitID AND item.lngItemID=" & lngItemID
Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not recSelect.EOF Then strBaseUnit = recSelect.rdoColumns(0)
lblTitle(3).Caption = strBaseUnit
tedUnitName(0).Text = Mid(strName, 1, 6)
tedUnitName(1).Text = 1
InitBuffer '清空暂时存储数据库操作的数组
End Sub
'进入修改摘要
Public Sub EditCard(ByVal lngRecordID As Long, Optional intModal As Integer = 0)
mblnAddRecord = False
frmItemUnitCard.Caption = "修改计量单位"
cmdUnit(2).Visible = False
If Not SelectRecord(lngRecordID) Then Exit Sub '查找记录
Show intModal
End Sub
'查找出想修改的摘要表编码记录，存放在自定义类型变量中，设置想修改项
Private Function SelectRecord(ByVal lngRecordID As Long) As Boolean
Dim strSql As String
Dim recSelect As rdoResultset
Dim strBaseUnit As String
SelectRecord = False
With mUnit
.lngUnitID = lngRecordID
strSql = "SELECT * FROM ItemUnit WHERE lngUnitID =" & .lngUnitID
Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recSelect.EOF Then
ShowMsg 0, "当前修改的计量单位不存在，不能修改！", _
vbExclamation + MB_TASKMODAL, Me.Caption
Unload Me
Exit Function
End If
.strUnitName = recSelect!strUnitName
.dblFactor = recSelect!dblFactor
.lngItemID = recSelect!lngItemID
recSelect.Close
strSql = "select itemunit.lngUnitID,ItemUnit.strUnitName from item,itemunit " & _
"WHERE Item.lngMinUnitID=ItemUnit.lngUnitID AND item.lngItemID=" & .lngItemID
Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recSelect.rdoColumns(0) = .lngUnitID Then
tedUnitName(1).Enabled = False
tedUnitName(1).BackColor = &H80000004
Else
tedUnitName(1).Enabled = True
End If
strBaseUnit = recSelect.rdoColumns(1)
lblTitle(3).Caption = strBaseUnit
tedUnitName(1).Text = .dblFactor
tedUnitName(0).Text = Mid(.strUnitName, 1, 6)
InitBuffer '清空暂时存储数据库操作的数组
recSelect.Close
End With
SelectRecord = True
End Function
Private Function ItemUnitIsUsed(ByVal lngUnitID As Long) As Boolean
ItemUnitIsUsed = True
If CheckIDUsed("ItemActivityDetail", "lngUnitID", lngUnitID) Then Exit Function
If CheckIDUsed("StockTakingDetail", "lngUnitID", lngUnitID) Then Exit Function
If CheckIDUsed("PurchaseOrderDetail", "lngUnitID", lngUnitID) Then Exit Function
If CheckIDUsed("CostPriceDetail", "lngUnitID", lngUnitID) Then Exit Function
If CheckIDUsed("Item", "lngStockUnitID", lngUnitID) Then Exit Function
ItemUnitIsUsed = False
End Function
'进入删除摘要，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngRecordID As Long, Optional ByVal lnghWnd As Long = 0) As Boolean
Dim strSql As String
Dim recSelect As rdoResultset
Dim intMsgReturn As Integer
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -