form_supplier.frm

来自「仓库扫描管理系统」· FRM 代码 · 共 668 行 · 第 1/2 页

         TabIndex        =   29
         Top             =   465
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "供应商全称:"
         Height          =   255
         Index           =   2
         Left            =   -70800
         TabIndex        =   28
         Top             =   420
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "条码编号:"
         Height          =   255
         Index           =   3
         Left            =   -74640
         TabIndex        =   27
         Top             =   1095
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "供应商地址:"
         Height          =   255
         Index           =   4
         Left            =   -70800
         TabIndex        =   26
         Top             =   1065
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "所属地区:"
         Height          =   255
         Index           =   5
         Left            =   -74640
         TabIndex        =   25
         Top             =   1740
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "邮政编码:"
         Height          =   255
         Index           =   6
         Left            =   -70800
         TabIndex        =   24
         Top             =   1815
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "公司电话:"
         Height          =   255
         Index           =   7
         Left            =   -74640
         TabIndex        =   23
         Top             =   2385
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "传真:"
         Height          =   255
         Index           =   8
         Left            =   -70800
         TabIndex        =   22
         Top             =   2460
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "联系人:"
         Height          =   255
         Index           =   9
         Left            =   -74640
         TabIndex        =   21
         Top             =   3015
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "联系人电话:"
         Height          =   255
         Index           =   10
         Left            =   -70800
         TabIndex        =   20
         Top             =   3105
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "开户银行:"
         Height          =   255
         Index           =   11
         Left            =   -74640
         TabIndex        =   19
         Top             =   3660
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "银行帐户:"
         Height          =   255
         Index           =   12
         Left            =   -70800
         TabIndex        =   18
         Top             =   3735
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "税号:"
         Height          =   255
         Index           =   13
         Left            =   -74640
         TabIndex        =   17
         Top             =   4305
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "电子邮箱:"
         Height          =   255
         Index           =   17
         Left            =   -70800
         TabIndex        =   16
         Top             =   4380
         Width           =   1095
      End
   End
   Begin VB.Data Data1 
      Align           =   2  'Align Bottom
      Connect         =   "Access"
      DatabaseName    =   "E:\datum\应用软件\物流管理\warehouse\DB-Access\hunterPOS.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   0
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "select * from hpos_organization where orgType=1"
      Top             =   6660
      Width           =   10710
   End
End
Attribute VB_Name = "form_supplier"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private sqlData As String
Private isAdd As Boolean

Private Sub cmdAdd_Click()
    isAdd = True
    Data1.Recordset.AddNew
    SSTab1.Tab = 1
    txtFieldGetFocus (1)
    Data1.Recordset.Fields("orgType") = 1
End Sub

Private Sub cmdDelete_Click()
  If Data1.Recordset.RecordCount = 0 Then
    MsgBox "没有记录可删除！", vbCritical, "警告"
    Exit Sub
  End If
  Dim orgId As Integer
  orgId = Data1.Recordset.Fields("orgId")
  Dim rsTmp As Recordset
  Dim sql As String
  sql = "SELECT * FROM hpos_StockIncomeBill_Master WHERE supplier=" + CStr(orgId)
  Set rsTmp = g_db.OpenRecordset(sql)
  If Not rsTmp.EOF Then
     MsgBox "入库单中已经引用该供应商，不能删除！", vbCritical, "警告"
     Exit Sub
  End If
  If MsgBox("真的要删除吗？", vbYesNo + vbDefaultButton2, "提示") = vbYes Then
    Data1.Recordset.Delete
    Data1.Recordset.MoveNext
    SSTab1.Tab = 0
  End If
End Sub

Private Sub cmdEdit_Click()
  If Data1.Recordset.RecordCount = 0 Then
    MsgBox "没有记录可修改，请先新增！", vbCritical, "警告"
    Exit Sub
  End If
    SSTab1.Tab = 1
    txtFieldGetFocus (1)
End Sub

Private Sub cmdQuery_Click()
'Data1.RecordSource = sqlData & " and (orgCode like '%" & txtConditon.Text & "' or fullName='" & txtConditon.Text & "' or shortenedform='" & txtConditon.Text & "')"
Dim fldName As String
If (cmbField.Text = "编号") Then
  fldName = "orgCode"
End If
If (cmbField.Text = "全称") Then
  fldName = "fullName"
End If
If (cmbField.Text = "简称") Then
  fldName = "shortenedform"
End If
Data1.RecordSource = sqlData & " and ( " + fldName + " like " + Chr(34) + "*" + txtConditon.Text + "*" + Chr(34) + ")"
'Data1.RecordSource = "select * from kh where (kh." & cmbField.Text & " " & "like " + Chr(34) + Text1.Text + "*" + Chr(34) + ")"
Data1.Refresh
End Sub

Private Sub cmdRefresh_Click()
  isAdd = False
  'this is really only needed for multi user apps
  txtConditon.Text = "*"
  SSTab1.Tab = 0
  Data1.RecordSource = sqlData
  Data1.Refresh
End Sub



Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdSave_Click()
  If isAdd = False And Data1.Recordset.RecordCount = 0 Then
    MsgBox "没有记录可保存，请先新增！", vbCritical, "警告"
    Exit Sub
  End If
  Data1.UpdateRecord
  Data1.Recordset.Bookmark = Data1.Recordset.LastModified
  MsgBox "保存成功!", vbInformation, "提示"
  SSTab1.Tab = 0
  isAdd = False
End Sub

Private Sub Data1_Error(DataErr As Integer, Response As Integer)
  'This is where you would put error handling code
  'If you want to ignore errors, comment out the next line
  'If you want to trap them, add code here to handle them
  MsgBox "Data error event hit err:" & Error$(DataErr)
  Response = 0  'throw away the error
End Sub

Private Sub Data1_Reposition()
  Screen.MousePointer = vbDefault
  On Error Resume Next
  'This will display the current record position
  'for dynasets and snapshots
'  Data1.Caption = "Record: " & (Data1.Recordset.AbsolutePosition + 1)
  Data1.Caption = "第 " & (Data1.Recordset.AbsolutePosition + 1) & " 条记录！"
  'for the table object you must set the index property when
  'the recordset gets created and use the following line
  'Data1.Caption = "Record: " & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1
End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
  'This is where you put validation code
  'This event gets called when the following actions occur
  Select Case Action
    Case vbDataActionMoveFirst
    Case vbDataActionMovePrevious
    Case vbDataActionMoveNext
    Case vbDataActionMoveLast
    Case vbDataActionAddNew
    Case vbDataActionUpdate
    Case vbDataActionDelete
    Case vbDataActionFind
    Case vbDataActionBookmark
    Case vbDataActionClose
  End Select
  Screen.MousePointer = vbHourglass
End Sub

Private Sub DBGrid1_DblClick()
  SSTab1.Tab = 1
End Sub

Private Sub DBGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
  If (DBGrid1.col = 16 And KeyCode = vbKeyReturn And DBGrid1.row < Data1.Recordset.RecordCount - 1) Then
    DBGrid1.row = DBGrid1.row + 1
    DBGrid1.col = 0
  End If
End Sub

Private Sub Form_Load()
    isAdd = False
  Data1.DatabaseName = g_dbPath
  sqlData = "select * from hpos_organization where orgType=1 "
  Data1.RecordSource = sqlData
  Me.Left = (Screen.Width - Me.Width) / 2
  Me.Top = (Screen.Height - Me.Height) / 2
  
  DBGrid1.AllowAddNew = False
  DBGrid1.AllowUpdate = False
  DBGrid1.AllowDelete = False

   cmbField.AddItem "编号", 0
   cmbField.AddItem "全称", 1
   cmbField.AddItem "简称", 2
  cmbField.Text = "编号"
  
  SSTab1.Tab = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  frm_main.Enabled = True
  Screen.MousePointer = vbDefault
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
    If PreviousTab = 0 Then
        If isAdd = False And Data1.Recordset.RecordCount = 0 Then
          SSTab1.Tab = 0
          MsgBox "没有详细数据可看，请先新增！", vbCritical, "警告"
          Exit Sub
        End If
        txtFieldGetFocus (1)
    End If
End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then     '按回车键
   If (Index < 14) Then
      txtFieldGetFocus (Index + 1)
    End If
    If (Index = 14) Then
      cmdSave.SetFocus
    End If
 End If
End Sub

Private Sub txtFieldGetFocus(i As Integer)
        txtFields(i).SelStart = 0
        txtFields(i).SelLength = Len(txtFields(i).Text)
        txtFields(i).SetFocus

End Sub