main_jbxx_fwxmgl.frm

一个比较完整的数据库编程技巧”洗浴管理系统“

      Top             =   0
      Visible         =   0   'False
      Width           =   1905
      _ExtentX        =   3360
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   1
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=XYGLXT"
      OLEDBString     =   "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=XYGLXT"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "select * from 消费项目价格表"
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "服务项目管理"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   405
      Left            =   3360
      TabIndex        =   2
      Top             =   90
      Width           =   2025
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "服务项目管理"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   3360
      TabIndex        =   1
      Top             =   60
      Width           =   2025
   End
End
Attribute VB_Name = "main_jbxx_fwxmgl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs1 As New ADODB.Recordset   '定义数据集对象
Dim i, j As Integer      '定义行数和列数
Dim txtSQL As String     '定义一个字符串变量

Private Sub cmddel_Click()
On Error Resume Next
Adodc1.Recordset.Delete
End Sub

Private Sub CmdFind_Click()
  Dim msg As String
  msg = InputBox("项目编号", "系统提示")
  If msg = "" Then Exit Sub
     Adodc1.RecordSource = "select * from 消费项目价格表 where 项目编号='" + msg + "'"
     Adodc1.Refresh

End Sub

Private Sub Form_Load()
 '定义MS1表的总行数、总列数
 MS1.Rows = 102
 MS1.Cols = 7
 '定义MS1表的宽度
 MS1.ColWidth(0) = 12 * 25 * 1
 MS1.ColWidth(1) = 12 * 25 * 3
 MS1.ColWidth(2) = 12 * 25 * 6
 MS1.ColWidth(3) = 12 * 25 * 3
 MS1.ColWidth(4) = 12 * 25 * 3
 MS1.ColWidth(5) = 12 * 25 * 4
 MS1.ColWidth(6) = 12 * 25 * 7
 '设置固定行、列
 MS1.FixedRows = 1
 MS1.FixedCols = 1
 '定义MS1表的表头
 MS1.TextMatrix(0, 0) = "xh"
 MS1.TextMatrix(0, 1) = "项目编号"
 MS1.TextMatrix(0, 2) = "名称"
 MS1.TextMatrix(0, 3) = "简称"
 MS1.TextMatrix(0, 4) = "单位"
 MS1.TextMatrix(0, 5) = "单价"
 MS1.TextMatrix(0, 6) = "说明"
 '定义MS1表的列序号
 For i = 1 To 101
     MS1.TextMatrix(i, 0) = i
 Next i
 '设置窗体标题
 Me.Caption = Me.Caption & "     操作员： " & frm_main.St1.Panels(3).Text
End Sub
Private Sub Form_Unload(Cancel As Integer)
 frm_main.Enabled = True     '设置frm_main窗体有效
End Sub
Private Sub MS1_Click()     '单击MS1表格
  If MS1.Row >= 1 And MS1.TextMatrix(MS1.Row - 1, 2) <> "" Then
     Text1.Visible = True     '设置text1可见
     Text1.SetFocus     'text1获得焦点
  End If
End Sub
Private Sub MS1_Entercell()    '确定text1在MS1表格中的位置
  Dim X As String, y As String, p As String
  If MS1.CellWidth <= 0 Or MS1.CellHeight <= 0 Then Exit Sub
     X = MS1.TextMatrix(MS1.FixedRows, MS1.Col)
     y = MS1.TextMatrix(MS1.Row, 0)
     If y <> "" Then
        If MS1.Col - MS1.LeftCol <= 3 Then
           MS1.LeftCol = MS1.LeftCol + 1
        End If
        If MS1.CellWidth > 0 And MS1.CellHeight > 0 Then
           Text1.Width = MS1.CellWidth
           Text1.Height = MS1.CellHeight
           Text1.Left = MS1.CellLeft + MS1.Left
           Text1.Top = MS1.CellTop + MS1.Top
        End If
        X = MS1.TextMatrix(MS1.FixedRows, MS1.Col)
        y = MS1.TextMatrix(MS1.Row, 0)
        p = MS1.TextMatrix(MS1.Row, MS1.Col)
        Text1.Text = MS1.Text     '赋值给text1.text
     End If
End Sub
Private Sub MS1_RowColChange()
'格式化MS1表格的第5列
 For i = 1 To 101
  If MS1.TextMatrix(i, 1) <> "" Then
   MS1.TextMatrix(MS1.Row, 5) = Format(Val(MS1.TextMatrix(MS1.Row, 5)), "#0.00")
  End If
 Next i
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then     '按回车键，text1向右移动
  Text1.Text = MS1.Text
  If MS1.Col = 6 Then
     MS1.Row = MS1.Row + 1
     MS1.Col = 1
   Else
     If MS1.Col + 1 <= MS1.Cols - 1 Then
        MS1.Col = MS1.Col + 1
      Else
        If MS1.Row + 1 <= MS1.Rows - 1 Then
           MS1.Row = MS1.Row + 1
           MS1.Col = 1
        End If
     End If
  End If
 End If
 If KeyCode = vbKeyUp Then     '按向上键，text1向上移动
    If MS1.Row > 1 Then MS1.Row = MS1.Row - 1
 End If
 If KeyCode = vbKeyDown Then     '按向下键，text1向下移动
    If MS1.Row < 99 Then MS1.Row = MS1.Row + 1
 End If
 If KeyCode = vbKeyLeft Then     '按向左键，text1向左移动
    If Text1.Text <> "" Then
       Text1.SelStart = 0
       Text1.SelLength = Len(Text1.Text)
    End If
    If MS1.Col - 6 <= MS1.Cols + 1 Then
       MS1.Col = MS1.Col - 1
       If MS1.Col = 0 Then MS1.Col = 1
      Else
       If MS1.Row + 1 <= MS1.Row - 1 Then
          MS1.Row = MS1.Row + 1
          MS1.Col = 1
       End If
    End If
 End If
 If KeyCode = vbKeyRight Then     '按向右键，text1向右移动
    If Text1.Text <> "" Then
       Text1.SelStart = 0
       Text1.SelLength = Len(Text1.Text)
    End If
    If MS1.Col + 1 <= MS1.Cols - 1 Then
       MS1.Col = MS1.Col + 1
      Else
       If MS1.Row + 1 <= MS1.Rows - 1 Then
          MS1.Row = MS1.Row + 1
          MS1.Col = 1
       End If
    End If
 End If
End Sub
Private Sub Text1_Change()
  MS1.Text = Text1.Text             '将text1的值赋给MS1.text
  If MS1.Col = 3 Then
     If MS1.TextMatrix(MS1.Row, 2) = "" Then   '当第2列为空时
        MsgBox ("无名称,请重新输入！")
        MS1.Col = 2                            '到达第2列
     End If
  End If
End Sub
Private Sub Comdj_Click()
 '文本框的大小和位置等于MS1中网格的大小和位置
 Text1.Width = MS1.CellWidth
 Text1.Height = MS1.CellHeight
 Text1.Left = MS1.CellLeft + MS1.Left
 Text1.Top = MS1.CellTop + MS1.Top
 MS1.Enabled = True
 '设置控件有效或无效
 Combc.Enabled = True
 Comqx.Enabled = True
 Comdj.Enabled = False
 Text1.Visible = True
 Text1.Enabled = True
 Text1.SetFocus
 '清空MS1表格中的数据
 For i = 1 To 101
 For j = 1 To 6
     MS1.TextMatrix(i, j) = ""
 Next j
 Next i
End Sub
Private Sub Combc_Click()
 If MS1.TextMatrix(1, 1) <> "" Then
  For i = 1 To 101
   '查询项目编号等于MS1.TextMatrix(i, 1)的记录
   txtSQL = "select * from 消费项目价格表 where 项目编号= '" + Trim(MS1.TextMatrix(i, 1)) + "'"
   Set rs1 = ESQL(txtSQL)     '执行SQL语句
   If rs1.RecordCount > 0 Then     '当记录大于零时
    MsgBox "项目编号" & Trim(MS1.TextMatrix(i, 1)) & "已存在，请重新输入！"
   Else
    If MS1.TextMatrix(i, 1) <> "" And MS1.TextMatrix(i, 3) <> "" Then
   '添加新记录到"消费项目价格表"中
    rs1.AddNew
    If MS1.TextMatrix(i, 1) <> "" Then rs1.Fields("项目编号") = Trim(MS1.TextMatrix(i, 1))
    If MS1.TextMatrix(i, 3) <> "" Then rs1.Fields("简称") = Trim(MS1.TextMatrix(i, 3))
    If MS1.TextMatrix(i, 2) <> "" Then rs1.Fields("名称") = Trim(MS1.TextMatrix(i, 2))
    If MS1.TextMatrix(i, 4) <> "" Then rs1.Fields("单位") = Trim(MS1.TextMatrix(i, 4))
    If MS1.TextMatrix(i, 5) <> "" Then rs1.Fields("单价") = Trim(MS1.TextMatrix(i, 5))
    If MS1.TextMatrix(i, 6) <> "" Then rs1.Fields("说明") = Trim(MS1.TextMatrix(i, 6))
    rs1.Update
    '设置控件有效或无效
    Combc.Enabled = False
    Comdj.Enabled = True
    Comqx.Enabled = False
    Text1.Visible = False
    MS1.Enabled = False
    End If
   End If
   Next i
 Else
  MsgBox ("填写数据不完整,请核对,再保存")
  '到达第1列、第1行
  MS1.Col = 1
  MS1.Row = 1
 End If
End Sub
Private Sub Comqx_Click()     '取消操作
  For i = 1 To 101
      For j = 1 To 6
          MS1.TextMatrix(i, j) = ""
      Next j
  Next i
  MS1.Enabled = False
  Text1.Visible = False
  Comdj.Enabled = True
  Comdj.SetFocus
End Sub
Private Sub comend_Click()
 frm_main.Enabled = True
 Unload Me
End Sub