frmadd2.frm

西南医院管理系统。

         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   120
         TabIndex        =   3
         Top             =   2080
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "姓 名"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   120
         TabIndex        =   2
         Top             =   1280
         Width           =   975
      End
      Begin VB.Label Label1 
         Caption         =   "ID 号"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   120
         TabIndex        =   1
         Top             =   480
         Width           =   975
      End
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      X1              =   0
      X2              =   9600
      Y1              =   5720
      Y2              =   5720
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   9600
      Y1              =   5700
      Y2              =   5700
   End
End
Attribute VB_Name = "FrmAdd2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a '保存图片地址
Private Sub Command1_Click()
FrmAdd3.Show
End Sub
Private Sub Command10_Click()
If Text1.Text = "" Then
    MsgBox "ID号不能为空", vbOKOnly + vbInformation, "系统信息"
    Text1.SetFocus
    Exit Sub
End If
If Text2.Text = "" Then
    MsgBox "ID无效,请重输", vbOKOnly + vbInformation, "系统信息"
    Text1.Text = ""
    Text1.SetFocus
    Exit Sub
End If
If Text3.Text = "" Then
    MsgBox "请填写主诉", vbOKOnly + vbInformation, "系统信息"
    Text3.SetFocus
    Exit Sub
End If
If Text5.Text = "" Then
    MsgBox "请填写诊断", vbOKOnly + vbInformation, "系统信息"
    Text5.SetFocus
    Exit Sub
End If
If Text7.Text = "" Then
    MsgBox "请选择用药情况", vbOKOnly + vbInformation, "系统信息"
    Text7.SetFocus
    Exit Sub
End If
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
Command9.Enabled = True
Command10.Enabled = False
addnew '添加新记录
Data1.Recordset.Update
Data1.Refresh
MsgBox "保存成功", vbOKOnly + vbInformation, "系统消息"
disp '赋值
locked '锁定
End Sub

Private Sub Command11_Click()
Unload Me
FrmMdi.mnuadd2.Checked = False
End Sub

Private Sub Command12_Click()
a = ""
Image1.Picture = LoadPicture(none)
End Sub

Private Sub Command2_Click()
CommonDialog1.Filter = "图片文件(*.jpg)|*.jpg|所有文件(*.*)|*.*"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
    a = CommonDialog1.FileName
   Image1.Picture = LoadPicture(a)
End If
End Sub

Private Sub Command3_Click()
If Data1.Recordset.RecordCount < 1 Then
   MsgBox "数据库中没有数据", vbOKOnly + vbCritical, "系统消息"
   Exit Sub
End If
Data1.Recordset.MoveFirst
disp '赋值
End Sub

Private Sub Command4_Click()
If Data1.Recordset.RecordCount < 1 Then
   MsgBox "数据库中没有数据", vbOKOnly + vbCritical, "系统消息"
   Exit Sub
End If
Data1.Recordset.MovePrevious
If Data1.Recordset.BOF Then
   Data1.Recordset.MoveFirst
End If
disp '赋值
End Sub

Private Sub Command5_Click()
If Data1.Recordset.RecordCount < 1 Then
   MsgBox "数据库中没有数据", vbOKOnly + vbCritical, "系统消息"
   Exit Sub
End If
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
   Data1.Recordset.MoveLast
End If
disp '赋值
End Sub

Private Sub Command6_Click()
If Data1.Recordset.RecordCount < 1 Then
   MsgBox "数据库中没有数据", vbOKOnly + vbCritical, "系统消息"
   Exit Sub
End If
Data1.Recordset.MoveLast
disp '赋值
End Sub

Private Sub Command7_Click()
Data1.Recordset.addnew
clear '清空文本框
lockfalsh '解除锁定
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Command10.Enabled = True
Text1.SetFocus
End Sub

Private Sub Command8_Click()
If Data1.Recordset.RecordCount < 1 Then
   MsgBox "当前没有记录，无法修改", vbQuestion + vbCritical, "系统消息"
   Exit Sub
End If
a = Data1.Recordset.Fields("X线照片") '保存原来图片地址
lockfalsh '解除锁定
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Command10.Enabled = True
Data1.Recordset.Edit
End Sub

Private Sub Command9_Click()
On Error GoTo err
If Data1.Recordset.RecordCount < 1 Then
   MsgBox "数据库中没有数据", vbOKOnly + vbCritical, "系统消息"
   Exit Sub
End If
Data1.Recordset.Delete
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
   Data1.Recordset.MoveLast
End If
disp '赋值
err:
If err.Number = 3021 Then
   clear '清空文本框
   MsgBox "无当前记录", vbOKOnly + vbCritical, "系统信息"
   Exit Sub
End If
End Sub

Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\message.mdb"
Data1.RecordSource = "case"
Data1.Refresh
Data2.DatabaseName = App.Path & "\message.mdb"
disp '赋值
locked '锁定
Command10.Enabled = False
Me.Height = 7380
Me.Width = 9765
End Sub
Sub disp() '赋值
On Error Resume Next
  With Data1.Recordset
       Text1.Text = .Fields("ID号")
       Text3.Text = .Fields("主诉")
       Text4.Text = .Fields("现病史")
       Text5.Text = .Fields("诊断")
       Text6.Text = .Fields("体格检查")
       Text7.Text = .Fields("用药情况")
       Text8.Text = .Fields("即往史")
       Text9.Text = .Fields("就诊时间")
       
       Text10.Text = .Fields("RF")
       Text11.Text = .Fields("CCP")
       Text12.Text = .Fields("AKA")
       Text13.Text = .Fields("ESR")
       Text14.Text = .Fields("ANA")
       Text15.Text = .Fields("Ds-DNA")
       Text16.Text = .Fields("ENA")
       Text17.Text = .Fields("血常规")
       Text18.Text = .Fields("肝功")
       Text19.Text = .Fields("ASO")
       Text20.Text = .Fields("ANCA")
       Text21.Text = .Fields("C3")
       Text22.Text = .Fields("C4")
       Text23.Text = .Fields("IgG")
       Text24.Text = .Fields("IgM")
       Text25.Text = .Fields("IgA")
       Text26.Text = .Fields("尿常规")
       Text27.Text = .Fields("肾功")
       Text28.Text = .Fields("X片报告")
       '显示图片
       If .Fields("X线照片") <> "" Then
          Image1.Picture = LoadPicture(.Fields("X线照片"))
          Else
          Image1.Picture = LoadPicture(none)
       End If

  End With
End Sub
Sub addnew() '添加新记录
  With Data1.Recordset
        .Fields("ID号") = CStr(Text1.Text)
        .Fields("主诉") = CStr(Text3.Text)
        .Fields("现病史") = CStr(Text4.Text)
        .Fields("诊断") = CStr(Text5.Text)
        .Fields("体格检查") = CStr(Text6.Text)
        .Fields("用药情况") = CStr(Text7.Text)
        .Fields("即往史") = CStr(Text8.Text)
        If Text9.Text <> "" Then
           .Fields("就诊时间") = CDate(Text9.Text)
           Else
           .Fields("就诊时间") = Date
        End If
        
        
        .Fields("RF") = CStr(Text10.Text)
        .Fields("CCP") = CStr(Text11.Text)
        .Fields("AKA") = CStr(Text12.Text)
        .Fields("ESR") = CStr(Text13.Text)
        .Fields("ANA") = CStr(Text14.Text)
        .Fields("Ds-DNA") = CStr(Text15.Text)
        .Fields("ENA") = CStr(Text16.Text)
        .Fields("血常规") = CStr(Text17.Text)
        .Fields("肝功") = CStr(Text18.Text)
        .Fields("ASO") = CStr(Text19.Text)
        .Fields("ANCA") = CStr(Text20.Text)
        .Fields("C3") = CStr(Text21.Text)
        .Fields("C4") = CStr(Text22.Text)
        .Fields("IgG") = CStr(Text23.Text)
        .Fields("IgM") = CStr(Text24.Text)
        .Fields("IgA") = CStr(Text25.Text)
        .Fields("尿常规") = CStr(Text26.Text)
        .Fields("肾功") = CStr(Text27.Text)
        .Fields("X片报告") = CStr(Text28.Text)
        .Fields("X线照片") = a
  End With
End Sub
Sub locked() '锁定
    Text3.locked = True
    Text4.locked = True
    Text5.locked = True
    Text6.locked = True
    Text7.locked = True
    Text8.locked = True
    Text9.locked = True
    Text10.locked = True
    Text11.locked = True
    Text12.locked = True
    Text13.locked = True
    Text14.locked = True
    Text15.locked = True
    Text16.locked = True
    Text17.locked = True
    Text18.locked = True
    Text19.locked = True
    Text20.locked = True
    Text21.locked = True
    Text22.locked = True
    Text23.locked = True
    Text24.locked = True
    Text25.locked = True
    Text26.locked = True
    Text27.locked = True
    Text28.locked = True
    Command1.Enabled = False
    Command2.Enabled = False
    Command12.Enabled = False
End Sub
Sub lockfalsh() '解除锁定
    Text3.locked = False
    Text4.locked = False
    Text5.locked = False
    Text6.locked = False
    Text7.locked = False
    Text8.locked = False
    Text9.locked = False
    Text10.locked = False
    Text11.locked = False
    Text12.locked = False
    Text13.locked = False
    Text14.locked = False
    Text15.locked = False
    Text16.locked = False
    Text17.locked = False
    Text18.locked = False
    Text19.locked = False
    Text20.locked = False
    Text21.locked = False
    Text22.locked = False
    Text23.locked = False
    Text24.locked = False
    Text25.locked = False
    Text26.locked = False
    Text27.locked = False
    Text28.locked = False
    Command1.Enabled = True
    Command2.Enabled = True
    Command12.Enabled = True
End Sub
Sub clear() '清空文本框
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    Text7.Text = ""
    Text8.Text = ""
    Text9.Text = ""
    Text10.Text = ""
    Text11.Text = ""
    Text12.Text = ""
    Text13.Text = ""
    Text14.Text = ""
    Text15.Text = ""
    Text16.Text = ""
    Text17.Text = ""
    Text18.Text = ""
    Text19.Text = ""
    Text20.Text = ""
    Text21.Text = ""
    Text22.Text = ""
    Text23.Text = ""
    Text24.Text = ""
    Text25.Text = ""
    Text26.Text = ""
    Text27.Text = ""
    Text28.Text = ""
    Image1.Picture = LoadPicture(none)
End Sub

Private Sub Form_Unload(Cancel As Integer)
FrmMdi.mnuadd2.Checked = False
End Sub

Private Sub Text1_Change()
Data2.RecordSource = "select * from basic where ID号='" & Text1.Text & "'"
Data2.Refresh
If Data2.Recordset.BOF And Data2.Recordset.EOF Then
   Text2.Text = ""
   Else
   Text2.Text = Data2.Recordset.Fields("姓名")
End If

End Sub