frmmedicmanage.frm

社区医疗管理系统 用vb开发的简单社区卫生组织用的管理系统

On Error GoTo adderr
   Combo1.SetFocus
   Adodc1.Recordset.AddNew
   Exit Sub
adderr:
   MsgBox Err.Description
End Sub

Private Sub Label15_Click()
Unload Me
End Sub

Private Sub Label2_Click()
On Error GoTo deleteerr
 If Adodc1.Recordset.BOF = True Then
    MsgBox "没有记录，无法删除！"
    Exit Sub
 End If
   With Adodc1.Recordset
        If Not .EOF And Not .BOF Then
            If MsgBox("删除当前记录吗？", vbYesNo + vbQuestion) = vbYes Then
                .Delete
                .MoveNext
                If .EOF Then .MoveLast
            End If
        End If
  End With
  Exit Sub
deleteerr:
   MsgBox Err.Description
End Sub

Private Sub Label3_Click()
If Adodc1.Recordset.BOF = True Then
    MsgBox "没有记录，无法显示！"
    Exit Sub
End If
Adodc1.Recordset.MovePrevious
   If Adodc1.Recordset.BOF Then
      MsgBox "这是第一条记录", vbOKCancel + vbQuestion
      Adodc1.Recordset.MoveFirst
   End If
End Sub

Private Sub Label4_Click()
If Adodc1.Recordset.BOF = True Then
    MsgBox "没有记录，无法显示！"
    Exit Sub
End If
Adodc1.Recordset.MoveNext
 If Adodc1.Recordset.EOF Then
      MsgBox "这是最后一条记录", vbOKCancel + vbQuestion
      Adodc1.Recordset.MoveLast
  End If
End Sub

Private Sub Label5_Click()
If Adodc1.Recordset.BOF = True Then
    MsgBox "没有记录，无法显示！"
    Exit Sub
End If
If Adodc1.Recordset.EOF Then
     MsgBox "纪录空", vbOKCancel + vbQuestion
     End
  Else
     Adodc1.Recordset.MoveFirst
  End If
  Exit Sub
End Sub

Private Sub Label6_Click()
If Adodc1.Recordset.BOF = True Then
    MsgBox "没有记录，无法显示！"
    Exit Sub
End If
If Adodc1.Recordset.RecordCount = 0 Then
       MsgBox "空纪录", vbOKCancel + vbQuestion
       End
  Else
     Adodc1.Recordset.MoveLast
  End If
End Sub
Private Sub Label7_Click() '退出
  Labexit_Click
End Sub

Private Sub Labexit_Click() '关闭
Unload Me
Main.Show
End Sub
Private Sub Picture4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
    Dim ReturnVal As Long
    Xs = ReleaseCapture()
    ReturnVal = SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
  End If
End Sub
'****************************************不用日期控件的智能日期输入法（vb代码版）
Private Sub Text2_Change()
Dim a, b, c As String
'---------------------------------------------------------------------------
'年份输入的控制
'---------------------------------------------------------------------------
'限制第一位必须为"1"或"2" ，也就说年份必须在1000-2999之间，够用吧！

If Len(Text2.Text) = 1 Then

If left((Text2.Text), 1) <> "1" And left((Text2.Text), 1) <> "2" Then

Text2.Text = ""

End If

End If
'限制第二、三、四位必须为“1、2、3、4、5、6、7、8、9、0”

If Len(Text2.Text) = 2 Or Len(Text2.Text) = 3 Or Len(Text2.Text) = 4 Then

If right((Text2.Text), 1) <> "0" And right((Text2.Text), 1) <> "1" And right((Text2.Text), 1) <> "2" And right((Text2.Text), 1) <> "3" And right((Text2.Text), 1) <> "4" And right((Text2.Text), 1) <> "5" And right((Text2.Text), 1) <> "6" And right((Text2.Text), 1) <> "7" And right((Text2.Text), 1) <> "8" And right((Text2.Text), 1) <> "9" Then

Text2.Text = left((Text2.Text), Len(Text2.Text) - 1)

Text2.SelStart = Len(Text2.Text)

End If

End If

If Len(Text2.Text) = 4 Then

Text2.Text = Text2.Text + "-"

Text2.SelStart = Len(Text2.Text)

End If '当年份正确输入后就自动加上的“-”分隔符
'---------------------------------------------------------------------------
'月份输入的控制
'---------------------------------------------------------------------------

If Len(Text2.Text) = 6 Then

If right((Text2.Text), 1) <> "0" And right((Text2.Text), 1) <> "1" Then

If right((Text2.Text), 1) = "2" Or right((Text2.Text), 1) = "3" Or right((Text2.Text), 1) = "4" Or right((Text2.Text), 1) = "5" Or right((Text2.Text), 1) = "6" Or right((Text2.Text), 1) = "7" Or right((Text2.Text), 1) = "8" Or right((Text2.Text), 1) = "9" Then

a = right((Text2.Text), 1)

Text2.Text = left((Text2.Text), 5) + "0" + a + "-"

'如果这样，那下面一段if len(Text2.text)=7的判断自然就自动跳过去了。

Text2.SelStart = Len(Text2.Text)

Else ' 限制只能输入“0-9”

Text2.Text = left((Text2.Text), Len(Text2.Text) - 1)

Text2.SelStart = Len(Text2.Text)

End If

End If

End If

If Len(Text2.Text) = 7 Then

If left(right(Text2.Text, 2), 1) = "0" Then '如果月份第一位为“0”

If right((Text2.Text), 1) <> "1" And right((Text2.Text), 1) <> "2" And right((Text2.Text), 1) <> "3" And right((Text2.Text), 1) <> "4" And right((Text2.Text), 1) <> "5" And right((Text2.Text), 1) <> "6" And right((Text2.Text), 1) <> "7" And right((Text2.Text), 1) <> "8" And right((Text2.Text), 1) <> "9" Then

Text2.Text = left((Text2.Text), Len(Text2.Text) - 1)

Text2.SelStart = Len(Text2.Text)

Else

Text2.Text = Text2.Text + "-" '当月份输入正确后自动加一个“-”分隔符
Text2.SelStart = Len(Text2.Text)
Exit Sub '少不了！如果少，那当月份为“01”时，紧接的If...End IF就

'成立，这样会在这里出现死循环，而出现溢出堆栈空间的错误！
'注：本程序好几个地方都可以用上Exit Sub，要加你自己补上吧！

End If

End If

If left(right((Text2.Text), 2), 1) = "1" Then '如果月份第一位为“1”

If right((Text2.Text), 1) <> "0" And right((Text2.Text), 1) <> "1" And right((Text2.Text), 1) <> "2" Then

Text2.Text = left((Text2.Text), Len(Text2.Text) - 1)

Text2.SelStart = Len(Text2.Text)

Else

Text2.Text = Text2.Text + "-" '当月份输入正确后自动加一个“-”分隔符

Text2.SelStart = Len(Text2.Text)

End If

End If

End If
'---------------------------------------------------------------------------
'日期输入的控制?
'---------------------------------------------------------------------------

If Len(Text2.Text) = 9 Then

If right((Text2.Text), 1) <> "0" And right((Text2.Text), 1) <> "1" And right((Text2.Text), 1) <> "2" And right((Text2.Text), 1) <> "3" Then
If right((Text2.Text), 1) = "4" Or right((Text2.Text), 1) = "5" Or _
right((Text2.Text), 1) = "6" Or right((Text2.Text), 1) = "7" Or _
right((Text2.Text), 1) = "8" Or right((Text2.Text), 1) = "9" Then
a = right((Text2.Text), 1)
Text2.Text = left((Text2.Text), 8) + "0" + a
Text2.SelStart = Len(Text2.Text)
Exit Sub
'日期小于10时下面字符长度为10的判断当然是正确的。让它执行又如何？
Else
Text2.Text = left((Text2.Text), Len(Text2.Text) - 1)
Text2.SelStart = Len(Text2.Text)
End If
End If
End If
'当要修改日期的最后一位时的控制?
If Len(Text2.Text) = 10 Then
b = left(right(Text2.Text, 5), 2) '取月份值，用于下面的日期正确性判断！
c = left(Text2.Text, 4) '取年份值，用于下面的日期正确性判断！
If right((Text2.Text), 1) <> "0" And right((Text2.Text), 1) <> "1" And _
right((Text2.Text), 1) <> "2" And right((Text2.Text), 1) <> "3" And _
right((Text2.Text), 1) <> "4" And right((Text2.Text), 1) <> "5" And _
right((Text2.Text), 1) <> "6" And right((Text2.Text), 1) <> "7" And _
right((Text2.Text), 1) <> "8" And right((Text2.Text), 1) <> "9" Then
Text2.Text = left((Text2.Text), Len(Text2.Text) - 1)
Text2.SelStart = Len(Text2.Text)
End If '限制非法字符的输入。
If right(Text2.Text, 2) = "00" Then
Text2.Text = left((Text2.Text), Len(Text2.Text) - 2)
Text2.SelStart = Len(Text2.Text)
End If ' 限制日期不能为0
If (b = "01" And Val(right(Text2.Text, 2)) > 31) Or _
(b = "03" And Val(right(Text2.Text, 2)) > 31) Or _
(b = "05" And Val(right(Text2.Text, 2)) > 31) Or _
(b = "07" And Val(right(Text2.Text, 2)) > 31) Or _
(b = "08" And Val(right(Text2.Text, 2)) > 31) Or _
(b = "10" And Val(right(Text2.Text, 2)) > 31) Or _
(b = "12" And Val(right(Text2.Text, 2)) > 31) Then
Text2.Text = left((Text2.Text), Len(Text2.Text) - 2)
Text2.SelStart = Len(Text2.Text)
End If '当月份为大月份时日期不能大于31。
If (b = "04" And Val(right(Text2.Text, 2)) > 30) Or _
(b = "06" And Val(right(Text2.Text, 2)) > 30) Or _
(b = "09" And Val(right(Text2.Text, 2)) > 30) Or _
(b = "11" And Val(right(Text2.Text, 2)) > 30) Then
Text2.Text = left((Text2.Text), Len(Text2.Text) - 2)
Text2.SelStart = Len(Text2.Text)
End If ' 当月份为小月份时日期不能大于30。
If b = "02" Then
If Val(c) Mod 4 <> 0 And Val(right(Text2.Text, 2)) > 28 Then
Text2.Text = left((Text2.Text), Len(Text2.Text) - 2)
Text2.SelStart = Len(Text2.Text)
End If ' 非闰年日期不得超过28。
If Val(c) Mod 4 = 0 And Val(right(Text2.Text, 2)) > 29 Then
Text2.Text = left((Text2.Text), Len(Text2.Text) - 2)
Text2.SelStart = Len(Text2.Text)
End If ' 闰年日期不得超过29。
End If '当月份为2时的日期正确性判断！
End If
'---------------------------------------------------------------------------
'当年月日输入后就不再接受其它字符了?方法如下:
'---------------------------------------------------------------------------
'第一种方法:
'在Text2的属性窗口中设Maxlength = 10
'第二种方法:
'Text4.SetFocus '即在适当的地方设一个跳转语句使下一个对象得到焦点?
'第三种方法:
If Len(Text2.Text) = 11 Then
Text2.Text = left((Text2.Text), Len(Text2.Text) - 1)
Text2.SelStart = Len(Text2.Text)
End If
End Sub
'--------------------------------------------------------------------------------