frmitemcard.frm

金算盘软件代码

         Height          =   225
         Index           =   3
         Left            =   -74790
         TabIndex        =   30
         Top             =   1395
         Width           =   1095
      End
      Begin VB.Label lblNote 
         Caption         =   "商品产地(&E)"
         Height          =   225
         Index           =   4
         Left            =   -74790
         TabIndex        =   26
         Top             =   570
         Width           =   1095
      End
      Begin VB.Label lblNote 
         AutoSize        =   -1  'True
         Caption         =   "常用货位(&O)"
         Height          =   180
         Index           =   23
         Left            =   -74790
         TabIndex        =   28
         Top             =   1005
         Width           =   990
      End
      Begin VB.Label lblNote 
         AutoSize        =   -1  'True
         Caption         =   "组件单位(&N)"
         Height          =   180
         Index           =   5
         Left            =   -74820
         TabIndex        =   53
         Top             =   570
         Width           =   990
      End
      Begin VB.Label lblNote 
         Caption         =   "组件类型(&T)"
         Height          =   225
         Index           =   9
         Left            =   -70440
         TabIndex        =   55
         Top             =   570
         Width           =   1005
      End
      Begin VB.Label lblNote 
         AutoSize        =   -1  'True
         Caption         =   "商品:"
         Height          =   180
         Index           =   12
         Left            =   -74790
         TabIndex        =   67
         Top             =   420
         Width           =   450
      End
      Begin VB.Label lblNote 
         AutoSize        =   -1  'True
         Caption         =   "含税销售价:"
         Height          =   180
         Index           =   19
         Left            =   -74820
         TabIndex        =   66
         Top             =   690
         Width           =   990
      End
      Begin VB.Label lblNote 
         Caption         =   "商品编码(&C)"
         Height          =   195
         Index           =   0
         Left            =   -74820
         TabIndex        =   0
         Top             =   570
         Width           =   1155
      End
      Begin VB.Label lblNote 
         AutoSize        =   -1  'True
         Caption         =   "计量单位(&I)"
         Height          =   180
         Index           =   6
         Left            =   -71400
         TabIndex        =   12
         Top             =   2190
         Width           =   990
      End
      Begin VB.Label lblNote 
         Caption         =   "核算性质(&R)"
         Height          =   285
         Index           =   24
         Left            =   -71400
         TabIndex        =   2
         Top             =   570
         Width           =   1095
      End
      Begin VB.Label lblNote 
         Caption         =   "所属类型(&L)"
         Height          =   195
         Index           =   2
         Left            =   -74820
         TabIndex        =   10
         Top             =   2190
         Width           =   1125
      End
      Begin VB.Label lblNote 
         Caption         =   "商品名称(&N)"
         Height          =   225
         Index           =   26
         Left            =   -74820
         TabIndex        =   4
         Top             =   1155
         Width           =   1125
      End
      Begin VB.Label lblNote 
         Caption         =   "规格型号(&V)"
         Height          =   225
         Index           =   1
         Left            =   -74820
         TabIndex        =   6
         Top             =   1665
         Width           =   1095
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "Edit"
      Visible         =   0   'False
      Begin VB.Menu mnuNew 
         Caption         =   "增加部件商品"
      End
      Begin VB.Menu mnuDel 
         Caption         =   "删除部件商品"
      End
   End
End
Attribute VB_Name = "frmItemCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''
'
'新增、编辑商品劳务卡片
'
'作者：苏涛
'
'日期:1998-07-14
'
'接口:EditCard(lngID,ShowModual),DelCard(lngID) As Boolean
'
''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text

'Private Const WM_KEYDOWN = &H100

Private mclsGrid As Grid
Private mclsDiscGrid As Grid
Private WithEvents mclsUnitGrid As Grid
Attribute mclsUnitGrid.VB_VarHelpID = -1
Private WithEvents mclsPriceGrid As Grid
Attribute mclsPriceGrid.VB_VarHelpID = -1
Private mblnFirstClick(0 To 11) As Boolean
Private mblnNoFirst(6) As Boolean
Private mblnIsRefer As Boolean
Private mblnIsInit As Boolean
Private mblnIsList As Boolean
Private mblnIsChanged As Boolean
Private mblnIsComItem As Boolean
Private mblnIsNew As Boolean
Private mblnIsExit As Boolean
Private mblnAddCheck As Boolean
Private mblnIsStock As Boolean
Private mblnIsKey As Boolean
Private mbytShowDec As Byte
Private mbytPriceDec As Byte
Private mbytQuantityDec As Byte
Private mintCboIndex As Integer
Private mlngCol As Long
Private mlngRow As Long
Private mlngDiscRow As Long
Private mlngDiscCol As Long
Private mlngPriceRow As Long
Private mlngPriceCol As Long
Private mlngPartRow As Long
Private mlngUnitGridCol As Long
Private mlngUnitGridRow As Long
Private mlngItemID As Long
Private mlngDItemID As Long       '编码合并时的目标ID
Private mlngMinUnitID As Long
Private mlngStockUnitID As Long
Private mlngMinRow As Long
Private mlngStockRow As Long
Private mlngMaxPriceRow As Long
'Private mdblFactor As Double
Private mstrMaxPriceDate As String
Private mstrMinUnit As String
Private mstrStockUnit As String
Private mstrCode As String
Private mstrItem As String
Private mstrNotes As String
Private mstrItemCategory As String
Private mstrUnitIDForDel As String
Private mlngOldLst(0 To 11) As Long

Public Function AddItem(ByVal strItem As String) As Integer
    Dim dblPurchasePrice1 As Double, dblSalePrice1 As Double
    Dim dblRetainPrice As Double, intValidDay As Integer
    Dim intLeadTime As Integer, dblPlanPrice As Double
    Dim dblMinUnitsInStock As Double, dblMaxUnitsInStock As Double
    Dim strItemStyle As String, strCustomerItemCode As String
    Dim strPostalCode As String, strOfficePhone As String
    Dim strHomePhone As String, strBirthdate As String
    Dim strCardNo As String, strTemp As String
    Dim strItemCode As String, strItemName As String
    Dim strUnitStr As String, strInvoiceName As String
    Dim dblNoDiscAmount1 As Double
    Dim dblMinLimitSalePrice1 As Double
    
    On Error GoTo ErrHandle
    AddItem = 0
    cboItem(0).Clear
    cboItem(1).Clear
    cboItem(1).AddItem "组装"
    cboItem(1).AddItem "配比"
    If Not GetString(strItem, strItemCode, 1) Then Exit Function
    If Not GetString(strItem, strItemName, 2) Then Exit Function
    If Not GetString(strItem, strItemStyle, 3) Then Exit Function
    If Not GetString(strItem, strTemp, 4) Then Exit Function
    chkItem(2).Value = IIf((strTemp = "1"), 1, 0)
    If Not GetString(strItem, strTemp, 5) Then Exit Function
    mlngOldLst(1) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 6) Then Exit Function
    mlngOldLst(0) = CLng(strTemp)
    If Not GetString(strItem, mstrMinUnit, 7) Then Exit Function
    If Not GetString(strItem, mstrStockUnit, 8) Then Exit Function
    If Not GetString(strItem, strTemp, 9) Then Exit Function
    mlngOldLst(3) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 10) Then Exit Function
    mlngOldLst(2) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 11) Then Exit Function
    mlngOldLst(4) = CLng(strTemp)
    If Not GetString(strItem, strCustomerItemCode, 12) Then Exit Function
    If Not GetString(strItem, strTemp, 13) Then Exit Function
    dblMinUnitsInStock = CDbl(strTemp)
    If Not GetString(strItem, strTemp, 14) Then Exit Function
    dblMaxUnitsInStock = CDbl(strTemp)
    If Not GetString(strItem, strTemp, 15) Then Exit Function
    intLeadTime = CInt(strTemp)
    If Not GetString(strItem, strTemp, 16) Then Exit Function
    dblPurchasePrice1 = CDbl(strTemp)
    If Not GetString(strItem, strTemp, 18) Then Exit Function
    dblSalePrice1 = CDbl(strTemp)
    If Not GetString(strItem, strTemp, 20) Then Exit Function
    dblPlanPrice = CDbl(strTemp)
    If Not GetString(strItem, strTemp, 21) Then Exit Function
    dblRetainPrice = CDbl(strTemp)
    If Not GetString(strItem, strTemp, 22) Then Exit Function
    intValidDay = CInt(strTemp)
    If Not GetString(strItem, strTemp, 23) Then Exit Function
    chkItem(1).Value = IIf((strTemp = "1"), 1, 0)
'    If Not GetString(strItem, strTemp, 24) Then Exit Function
'    mblnIsComItem = (strTemp = "1")
    If Not GetString(strItem, strTemp, 25) Then Exit Function
    If (strTemp = "1") Then
        cboItem(1).ListIndex = 0
    Else
        cboItem(1).ListIndex = 1
    End If
    If Not GetString(strItem, strTemp, 26) Then Exit Function
    OptItem(1).Value = (strTemp = "1")
    If Not GetString(strItem, mstrNotes, 27) Then Exit Function
    If Not GetString(strItem, strTemp, 28) Then Exit Function
    mlngOldLst(5) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 29) Then Exit Function
    mlngOldLst(6) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 30) Then Exit Function
    mlngOldLst(7) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 31) Then Exit Function
    mlngOldLst(8) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 32) Then Exit Function
    mlngOldLst(9) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 33) Then Exit Function
    mlngOldLst(10) = CLng(strTemp)
    If Not GetString(strItem, strTemp, 35) Then Exit Function
    dblMinLimitSalePrice1 = CDbl(strTemp)
    If Not GetString(strItem, strTemp, 36) Then Exit Function
    dblNoDiscAmount1 = CDbl(strTemp)
    If Not GetString(strItem, strUnitStr, 37) Then Exit Function
    If Not GetString(strItem, strInvoiceName, 38) Then Exit Function
    
    WriteUnit strUnitStr
    txtItem(0).Text = strItemCode
    txtItem(1).Text = strItemName
    txtItem(2).Text = strItemStyle
    txtItem(3).Text = strCustomerItemCode
    txtItem(4).Text = mstrMinUnit
    txtItem(5).Text = intValidDay
    txtItem(6).Text = dblPurchasePrice1
    txtItem(7).Text = dblSalePrice1
    txtItem(8).Text = dblRetainPrice
    txtItem(9).Text = dblMinUnitsInStock
    txtItem(10).Text = dblMaxUnitsInStock
    txtItem(11).Text = intLeadTime
    txtItem(12).Text = dblPlanPrice
    txtItem(14).Text = dblNoDiscAmount1
    txtItem(15).Text = dblMinLimitSalePrice1
    txtItem(16).Text = strInvoiceName
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddItem = 1
ErrHandle:
End Function

Public Property Get getID()
    getID = mlngItemID
End Property

Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim recItem As rdoResultset, strSql As String
    Dim strItem As String
    
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    DelCard = False
    
'    If lngID = mlngItemID And frmItemList.IsShowCard(1) Then
'        ShowMsg lnghWnd, "不能删除正在修改的商品！", vbExclamation + MB_TASKMODAL, "删除商品"
'        Show vbModal
'        GoTo ErrHandle
'    End If
    
    strSql = "SELECT * FROM Item WHERE lngItemID=" & lngID
    Set recItem = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recItem.EOF Then
        recItem.Close
        DelCard = True
        GoTo ErrHandle
    Else
        strItem = Trim(recItem!strItemCode) & " " & Trim(recItem!strItemName)
        recItem.Close
    End If
    If frmItemCard.ItemIsUsed(lngID) Then
        ShowMsg lnghWnd, "商品“" & strItem & "”已经发生业务,不能删除！", _
            vbExclamation + MB_TASKMODAL, "删除商品"
        GoTo ErrHandle
    End If
    
    If ShowMsg(lnghWnd, "你确实要删除商品“" & strItem & "”吗?", _
        vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除商品") = vbNo Then
            GoTo ErrHandle
    End If
    strSql = "DELETE FROM Item WHERE lngItemID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    strSql = "DELETE FROM ItemUnit WHERE lngItemID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    strSql = "DELETE FROM ItemCombination WHERE lngCombinationItemID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    strSql = "DELETE