frmhwbmquery.frm

用vb和SQLSERVER编译的关于数据库的源程序例子。

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.ocx"
Begin VB.Form frmHwbmQuery 
   Caption         =   "货物查询"
   ClientHeight    =   4950
   ClientLeft      =   2370
   ClientTop       =   2400
   ClientWidth     =   8805
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4950
   ScaleWidth      =   8805
   Begin VB.CommandButton Command 
      Caption         =   "删除(&D)"
      Height          =   345
      Index           =   4
      Left            =   7500
      TabIndex        =   8
      Top             =   600
      Width           =   1125
   End
   Begin VB.CommandButton Command 
      Caption         =   "退出(&X)"
      Height          =   345
      Index           =   1
      Left            =   7500
      TabIndex        =   7
      Top             =   1020
      Width           =   1125
   End
   Begin VB.CommandButton Command 
      Caption         =   "查询(&R)"
      Height          =   345
      Index           =   0
      Left            =   7500
      TabIndex        =   6
      Top             =   180
      Width           =   1125
   End
   Begin VB.Frame Frame 
      Caption         =   "查询条件"
      Height          =   1275
      Left            =   120
      TabIndex        =   1
      Top             =   90
      Width           =   7245
      Begin VB.TextBox Text 
         Height          =   330
         Index           =   1
         Left            =   1320
         TabIndex        =   5
         Top             =   720
         Width           =   2025
      End
      Begin VB.TextBox Text 
         Height          =   330
         Index           =   0
         Left            =   1320
         TabIndex        =   3
         Top             =   300
         Width           =   2025
      End
      Begin VB.Label Label 
         Caption         =   "货物名称:"
         Height          =   195
         Index           =   1
         Left            =   270
         TabIndex        =   4
         Top             =   780
         Width           =   825
      End
      Begin VB.Label Label 
         Caption         =   "货物编码:"
         Height          =   195
         Index           =   0
         Left            =   270
         TabIndex        =   2
         Top             =   360
         Width           =   825
      End
   End
   Begin MSFlexGridLib.MSFlexGrid Flex 
      Height          =   3405
      Left            =   150
      TabIndex        =   0
      Top             =   1440
      Width           =   7215
      _ExtentX        =   12726
      _ExtentY        =   6006
      _Version        =   393216
      Cols            =   6
      AllowUserResizing=   3
      FormatString    =   "|<货物分类码|<货物分类名称|<货物编码|<货物名称|>货物单价"
   End
End
Attribute VB_Name = "frmHwbmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'定义连接数据库的Conn对象变量
Dim Conn As ADODB.Connection

'定义文本框索引值对应的常量
Const TxtHwBmCode = 0
Const TxtHwBmMc = 1

'定义命令按钮索引值对应的常量
Const CmdQuery = 0
Const CmdDel = 4
Const CmdExit = 1

'加载窗体时执行
Private Sub Form_Load()
On Error GoTo Errorhandle
   
   '将网格列表中的内容清空，只保留一个标题行
   Flex.Rows = 1
   
   '调用Conection过程与数据库建立连接
   Connection
      
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

'与数据库建立连接
Private Sub Connection()
   Dim ConnStr As String
On Error GoTo Errorhandle

   ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=;Initial Catalog=fiterp;Data Source=ERP002"

   Set Conn = New ADODB.Connection
   Conn.ConnectionString = ConnStr
   Conn.Open
   
Exit Sub
Errorhandle:
   Set Conn = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

'命令按钮点击事件处理
Private Sub Command_Click(Index As Integer)
On Error GoTo Errorhandle

   Select Case Index
   Case CmdQuery
         LoadData
   Case CmdDel
         DelRecord
   Case CmdExit
         Unload Me
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

'从数据库取出数据在网格列表列出
Private Sub LoadData()
   Dim ItemStr As String
   Dim WhereStr As String
   Dim SqlStr As String
   Dim Rs As ADODB.Recordset
On Error GoTo Errorhandle
   
   Flex.Rows = 1
   
   WhereStr = ""
   
   If Trim(Text(TxtHwBmCode).Text) <> "" Then
      WhereStr = WhereStr & " AND HWBMCODE LIKE '" & Trim(Text(TxtHwBmCode).Text) & "%'"
   End If
   
   If Trim(Text(TxtHwBmMc).Text) <> "" Then
      WhereStr = WhereStr & " AND HWBMMC LIKE '%" & Trim(Text(TxtHwBmMc).Text) & "%'"
   End If
   
   Set Rs = New ADODB.Recordset
   Set Rs.ActiveConnection = Conn
   
   SqlStr = "SELECT HWFLCODE,HWFLMC,HWBMCODE,HWBMMC,HWBMPRICE FROM HWBMREC,HWFLREC WHERE HWFLCODE=HWBMFLCODE "
   SqlStr = SqlStr & WhereStr
   SqlStr = SqlStr & " ORDER BY HWBMFLCODE,HWBMCODE"
   
   Rs.Open SqlStr
   
   Do While Not Rs.EOF
      ItemStr = vbTab & Rs("HWFLCODE") & vbTab & Rs("HWFLMC") & vbTab & Rs("HWBMCODE") & vbTab & Rs("HWBMMC") & vbTab & Rs("HWBMPRICE")
      Flex.AddItem ItemStr
      Rs.MoveNext
   Loop
   
   Rs.Close
   Set Rs = Nothing
   
Exit Sub
Errorhandle:
   Set Rs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

'删除过程。将网格列表当前行编码对应的数据从数据库中删除。
Private Sub DelRecord()
   Dim SqlStr As String
On Error GoTo Errorhandle
   
   If Flex.Rows > 1 Then
      Conn.BeginTrans
      SqlStr = "DELETE HWBMREC WHERE HWBMCODE='" & Trim(Flex.TextMatrix(Flex.Row, 3)) & "'"
      Conn.Execute SqlStr
      Conn.CommitTrans
      Flex.RemoveItem Flex.Row
   End If
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub