frmtool.frm

这个是VB环境开发的,我也是转载的把原来的Access数据库改成了SQl Server数据库.希望大家可以借鉴

         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column07 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
            ColumnWidth     =   810.142
         EndProperty
         BeginProperty Column01 
            ColumnWidth     =   1305.071
         EndProperty
         BeginProperty Column02 
            ColumnWidth     =   2564.788
         EndProperty
         BeginProperty Column03 
            ColumnWidth     =   1035.213
         EndProperty
         BeginProperty Column04 
            ColumnWidth     =   824.882
         EndProperty
         BeginProperty Column05 
            Object.Visible         =   0   'False
         EndProperty
         BeginProperty Column06 
            Object.Visible         =   0   'False
            ColumnWidth     =   915.024
         EndProperty
         BeginProperty Column07 
            Object.Visible         =   0   'False
            ColumnWidth     =   870.236
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   16
      Top             =   0
      Width           =   7620
      _ExtentX        =   13441
      _ExtentY        =   979
      ButtonWidth     =   979
      ButtonHeight    =   926
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   8
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "新 增"
            Key             =   "new"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保 存"
            Key             =   "save"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "删 除"
            Key             =   "dele"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "查 找"
            Key             =   "find"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Object.Visible         =   0   'False
            Style           =   3
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Object.Visible         =   0   'False
            Caption         =   "修 改"
            Key             =   "print"
            ImageIndex      =   7
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退 出"
            Key             =   "exit "
            ImageIndex      =   6
         EndProperty
      EndProperty
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   6600
         Top             =   0
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   7
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmTool.frx":3F60
               Key             =   ""
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmTool.frx":45DC
               Key             =   ""
            EndProperty
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmTool.frx":4C58
               Key             =   ""
            EndProperty
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmTool.frx":4D6C
               Key             =   ""
            EndProperty
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmTool.frx":53E8
               Key             =   ""
            EndProperty
            BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmTool.frx":5A64
               Key             =   ""
            EndProperty
            BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "FrmTool.frx":5CF8
               Key             =   ""
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "FrmtoolInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ReT As New ADODB.Recordset
Public InsertType As String

Private Sub CmdInsert_Click()
If FrmtoolInfo.InsertType = "frmtoolio" Then
   frmtoolio.txtProd = txtEname
   frmtoolio.txttype = txttype
   frmtoolio.lblprod = txtid
End If
Unload Me
End Sub

Private Sub dtgrd_Click()
 CmdInsert.Enabled = True
     On Error GoTo l
       txtid = dtgrd.Columns(0).Text
       Toolbar1.Buttons(6).Enabled = True
    Exit Sub
l: Exit Sub
End Sub

Private Sub dtgrd_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
dtgrd_Click
End Sub

Private Sub Form_Load()
ReT.Open "select * from toolstock", cn, adOpenKeyset, adLockBatchOptimistic
Set dtgrd.DataSource = ReT
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set ReT = Nothing
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo gl
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim Re As String
Dim Oldi As Integer
Select Case Trim(Button.Key)
   Case "new"
    frmE.Enabled = True
    txtid = ""
    txtEname = ""
    txtS = ""
    txtunit = ""
    txttype = ""
    txtstock = ""
    Toolbar1.Buttons(1).Enabled = False
    Toolbar1.Buttons(2).Enabled = True
    Toolbar1.Buttons(6).Enabled = False
    Toolbar1.Buttons(3).Enabled = False
    ReT.AddNew
    txtEname.SetFocus
   Case "save"
    If txtEname <> "" Or txttype <> "" Then
       ReT.Filter = "tname='" & txtEname & " ' and etype='" & txttype & "'"
       If Not (ReT.BOF Or ReT.EOF) Then
          MsgBox " 该工具已经存在! ", , ginfo
          ReT.Filter = ""
          ReT.Requery
          Exit Sub
       End If
       If ReT.RecordCount <= 1 Then
          ReT!ID = 1
       Else
          ReT!ID = ReT.RecordCount
       End If
       ReT!tname = txtEname
       ReT!etype = txttype
       ReT!eunit = txtunit
       ReT!estock = 0
    End If
    ReT.UpdateBatch adAffectCurrent
    ReT.MoveLast
    Toolbar1.Buttons(1).Enabled = True
    Toolbar1.Buttons(2).Enabled = False
    Toolbar1.Buttons(6).Enabled = True
    Toolbar1.Buttons(3).Enabled = True
   Case "dele"
    Re = MsgBox(" 你确定要删除数据吗？ ", vbYesNo + vbQuestion + vbDefaultButton2, ginfo)
    If Re = vbYes Then
    If txtid = "" Then
       txtid = dtgrd.Columns(0).Text
    End If
     ReT.Find "id=" & txtid
     Oldi = ReT.RecordCount
     cmd.ActiveConnection = cn
     cmd.CommandText = "delete * from toolstock where id=" & txtid
     cmd.Execute
     cmd.ActiveConnection = Nothing
     ReT.MoveNext
     If Not (ReT.EOF Or ReT.BOF) Then
        Do While Not ReT.EOF
           If Val(txtid) <= ReT.Fields!ID Then
              ReT.Fields!ID = ReT.Fields!ID - 1
              ReT.UpdateBatch adAffectCurrent
              ReT.MoveNext
           Else
                Exit Do
           End If
           Loop
     End If
    ReT.Requery
    End If
    Exit Sub
   Case "find"
    Re = InputBox("请输入工具名称：", "查询信息", , 1000, 1000)
    If Re <> "" Then
       ReT.Find "tname='" & Re & "'"
       If ReT.BOF Or ReT.EOF Then
          MsgBox " 对不起，没找到该记录！", , ginfo
          ReT.MoveFirst
          Exit Sub
      End If
    End If
   Case "exit"
     Unload Me
End Select
Exit Sub
gl: MsgBox err.Description
End Sub

Private Sub txtid_Change()
  If txtid <> "" Then
      ReT.Find "id=" & txtid
      If Not (ReT.BOF Or ReT.EOF) Then
        txtEname = ReT!tname
        txttype = ReT!etype & ""
        txtunit = ReT!eunit & ""
        txtEstock = ReT!estock
        txtlow = ReT!elowstock
        txthigh = ReT!ehighstock
    End If
  End If
End Sub