frmprovider1.frm

一个简单的用vb制作的公司贸易管理系统

         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "联系地址(EN)："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   210
         Index           =   3
         Left            =   240
         TabIndex        =   15
         Top             =   1920
         Width           =   1605
      End
      Begin VB.Label Label2 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "公司名称(CH)："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   210
         Index           =   0
         Left            =   240
         TabIndex        =   14
         Top             =   480
         Width           =   1605
      End
      Begin VB.Label Label2 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "公司名称(EN)："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   210
         Index           =   16
         Left            =   240
         TabIndex        =   13
         Top             =   960
         Width           =   1605
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "返回 (&X)"
      Height          =   375
      Left            =   4200
      TabIndex        =   11
      Top             =   6720
      Width           =   1215
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存 (&S)"
      Height          =   375
      Left            =   2040
      TabIndex        =   10
      Top             =   6720
      Width           =   1215
   End
End
Attribute VB_Name = "frmProvider1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Public txtsql As String
Dim gRow As Integer
Dim gCol As Integer

Private Sub cboItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
End Sub

Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode

End Sub

Private Sub cmdExit_Click()
    If mblChange And cmdSave.Enabled Then
        If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            '保存
            Call cmdSave_Click
        End If
    End If
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim intCount As Integer
    Dim SMeg As String
    Dim mrc As ADODB.Recordset
    Dim Msgtext As String

    For intCount = 0 To 8
        If Trim(txtItem(intCount) & " ") = "" Then
            Select Case intCount
              Case 0
                SMeg = "公司名称(CH)"
              Case 1
                SMeg = "公司名称(EN)"
              Case 2
                SMeg = "联系地址(CH)"
              Case 3
                SMeg = "联系地址(EN)"
              Case 4
                SMeg = "所在城市"
              Case 5
                SMeg = "省份/区域"
              Case 6
                SMeg = "邮政编码"
              Case 7
                SMeg = "国家"
              Case 8
                SMeg = "公司主页"
            End Select
            SMeg = SMeg & "不能为空！"
            MsgBox SMeg, vbOKOnly + vbExclamation, "警告"
            txtItem(intCount).SetFocus

            Exit Sub
        End If
    Next intCount

    If Not IsNumeric(Trim(txtItem(6))) Then
        MsgBox "邮政编码请输入数字！", vbOKOnly + vbExclamation, "警告"
        txtItem(6).SetFocus
        Exit Sub
    End If

    If gintPmode = 1 Then
        txtsql = "select * from suppliers where cn_CompanyName ='" & Trim(txtItem(0)) & "'"
        Set mrc = ExecuteSQL(txtsql, Msgtext)
        If mrc.EOF = False Then
            MsgBox "已经存在此供应商的记录！", vbOKOnly + vbExclamation, "警告"
            txtItem(0).SetFocus
            Exit Sub
        End If
        mrc.Close
    End If

    If gintPmode = 2 Then
        '先删除已有记录
        txtsql = "delete from suppliers where SupplierID ='" & Trim(txtNo) & "'"
        Set mrc = ExecuteSQL(txtsql, Msgtext)
    End If

    '再加入新记录
    txtsql = "select * from suppliers"
    Set mrc = ExecuteSQL(txtsql, Msgtext)
    mrc.AddNew

    mrc.Fields(0) = txtNo
    For intCount = 0 To 9
        mrc.Fields(intCount + 1) = Trim(txtItem(intCount))
    Next intCount

    mrc.Update
    mrc.Close

    If gintPmode = 1 Then
        For intCount = 0 To 9
            txtItem(intCount) = ""
        Next intCount

        mblChange = False
        MsgBox "添加供应商信息成功！", vbOKOnly + vbExclamation, "添加供应商信息"

        Unload Me
        If flagPedit Then
            Unload frmProvider
            frmProvider.txtsql = "select * from suppliers"
            frmProvider.Show
        End If

    ElseIf gintPmode = 2 Then
        Unload Me
        If flagPedit Then
            Unload frmProvider
        End If
        frmProvider.txtsql = "select * from suppliers"
        frmProvider.Show

    End If

End Sub

Private Sub Command1_Click()

    frmLinkman3.txtsql = "select * from 工厂联系人 where 部门='" & Trim(txtItem(0)) & "'"
    frmLinkman3.Show
    'frmLinkman4.txtItem(3).Text = Trim(txtItem(0))

End Sub

Private Sub Form_Load()
    Dim sSql As String
    Dim intCount As Integer
    Dim Msgtext As String
    Dim mrcc As ADODB.Recordset

    If gintPmode = 1 Then
        Command1.Enabled = False
        Me.Caption = Me.Caption & "添加"
        txtNo = GetRkno()
    ElseIf gintPmode = 2 Then

        Set mrcc = ExecuteSQL(txtsql, Msgtext)

        If mrcc.EOF = False Then
            With mrcc

                txtNo = mrcc.Fields(0)

                For intCount = 0 To 9
                    If Not IsNull(.Fields(intCount + 1)) Then
                        txtItem(intCount) = .Fields(intCount + 1)
                    End If
                Next intCount

            End With

        End If
        mrcc.Close
        Me.Caption = Me.Caption & "修改"
    ElseIf gintPmode = 3 Then
        Set mrcc = ExecuteSQL(txtsql, Msgtext)
        If mrcc.EOF = False Then
            With mrcc

                txtNo = mrcc.Fields(0)

                For intCount = 0 To 9
                    If Not IsNull(.Fields(intCount + 1)) Then
                        txtItem(intCount) = .Fields(intCount + 1)
                        txtItem(intCount).Enabled = False

                    End If
                Next intCount

            End With
            cmdSave.Enabled = False

        End If
        mrcc.Close
        Me.Caption = Me.Caption & "查看"

    End If

    mblChange = False

End Sub

Private Sub Form_Unload(Cancel As Integer)
    gintPmode = 0
End Sub



Private Sub Grid_DblClick()
    If Grid.Rows = 1 Then Exit Sub

    Text1.Top = Grid.CellTop + Grid.Top
    Text1.Left = Grid.CellLeft + Grid.Left
    
    gRow = Grid.Row
    gCol = Grid.Col
    
    'If gCol <> 5 And gCol <> 6 And gCol <> 8 Then Exit Sub
    
    Text1.Width = Grid.CellWidth '- 2 * Screen.TwipsPerPixelX
    Text1.Height = Grid.CellHeight ' - 2 * Screen.TwipsPerPixelY
     
    Text1.Text = Grid.Text
    ' Show the text box:
    Text1.Visible = True
    Text1.ZOrder 0 ' 把 Text1 放到最前面！
    Text1.SetFocus
    ' Redirect this KeyPress event to the text box:
'    If KeyAscii <> 13 Then
'        SendKeys Chr$(KeyAscii)
'    End If
End Sub

Private Sub Text1_GotFocus()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Grid.SetFocus ' Set focus back to grid, see Text_LostFocus.
        KeyAscii = 0 ' Ignore this KeyPress.
    End If
    If KeyAscii <> 8 And KeyAscii <> 45 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
           ' 'Beep
        KeyAscii = 0
    End If
End Sub
Private Sub Grid_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Grid_DblClick
    End If
End Sub

Private Sub txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True

End Sub

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
    txtItem(Index).BackColor = &HFFFF&
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode

End Sub

Private Sub txtItem_LostFocus(Index As Integer)
    txtItem(Index).BackColor = &H80000005
End Sub

Private Sub Text1_LostFocus()
On Error GoTo Errorhandler

    Dim tmpRow As Integer
    Dim tmpCol As Integer
    ' Save current settings of Grid Row and col. This is needed only if
    ' the focus is set somewhere else in the Grid.
    tmpRow = Grid.Row
    tmpCol = Grid.Col
    ' Set Row and Col back to what they were before Text1_LostFocus:
    Grid.Row = gRow
    Grid.Col = gCol
'    If gCol = 5 Then
''        检测库存商品数量
'        Dim KCSLRst As ADODB.Recordset
'
'        Set KCSLRst = New ADODB.Recordset
'            SQL = "select * from kcdtb where spid=" & Grid.TextMatrix(Grid.RowSel, 11)
'            KCSLRst.Open SQL, Db, 1, 3
'
'            If IsNull(KCSLRst.Fields(4)) Or KCSLRst.EOF Then
'                MsgBox "仓库中无此商品，请确认！", vbOKOnly + 48, "提示"
'                GoTo MOVEOut
'            End If
'            If Val(KCSLRst.Fields(4)) >= Val(Text1.Text) Then
'                  Grid.Text = Text1.Text
'            Else
'                MsgBox "该商品库存数量不足！", vbOKOnly + 48, "提示"
'                GoTo MOVEOut
'            End If
'    ElseIf gCol = 6 Then
'        Grid.Text = Format(Val(Text1.Text), "###0.00") ' Transfer text back to grid.
'    ElseIf gCol = 8 Then
'        If MsgBox("你确信要更改ＰＤＶ？", vbOKCancel + vbCritical, "提示") = vbOK Then
'            Grid.Text = Val(Text1.Text)
'        End If
'    End If
    Text1.SelStart = 0 ' Return caret to beginning.
    Text1.Visible = False ' Disable text box.
    ' Return row and Col contents:
'      Grid.TextMatrix(Grid.RowSel, 7) = Format(Val(Grid.TextMatrix(Grid.RowSel, 6) * Grid.TextMatrix(Grid.RowSel, 5)), "0.00")
'      Grid.TextMatrix(Grid.RowSel, 9) = Format(Val(Grid.TextMatrix(Grid.RowSel, 7) * Grid.TextMatrix(Grid.RowSel, 8)), "0.00")
'      Grid.TextMatrix(Grid.RowSel, 10) = Format(Val(Val(Grid.TextMatrix(Grid.RowSel, 7)) + Val(Grid.TextMatrix(Grid.RowSel, 9))), "0.00")
'

    

    
    Grid.Row = tmpRow
    Grid.Col = tmpCol
MOVEOut:

    

    Exit Sub
Errorhandler:
    Exit Sub
End Sub