frmxtzc.frm

来自「本系统可用于医院和专业体检中心的健康体检管理」· FRM 代码 · 共 557 行 · 第 1/2 页

      Height          =   255
      Left            =   330
      TabIndex        =   10
      Top             =   2925
      Width           =   1005
   End
   Begin VB.Label Label28 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "邮政编码："
      Height          =   255
      Left            =   330
      TabIndex        =   9
      Top             =   3330
      Width           =   1005
   End
   Begin VB.Label Label19 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "单位名称："
      Height          =   255
      Left            =   330
      TabIndex        =   8
      Top             =   1320
      Width           =   1005
   End
End
Attribute VB_Name = "FrmXTZC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mblnEnd As Boolean

'被调函数
Public Function ShowRegister() As Boolean
    mblnEnd = False
    Me.Show vbModal
    ShowRegister = mblnEnd
End Function

Private Sub cmdExit_Click()
    mblnEnd = True
    Unload FrmXTZC
    Set FrmXTZC = Nothing
End Sub

Private Sub cmdPrint_Click()
    Dim intLeftPos, intTopPos As Integer  '左边距 上边距
    Dim intTitleTop As Integer
    Dim intCharHeight As Integer     '字符高度
    
    intTitleTop = 35
    intLeftPos = 55
    intTopPos = 50
    intCharHeight = 8
      
    If DetectPrinter() = False Then
        MsgBox "您的系统中未安装打机，请先安装！", vbInformation, "提示"
        Exit Sub
    End If
    
    Printer.ScaleMode = 6
    Printer.FontName = "宋体"
    '打印标题
    Printer.FontSize = 17
    Printer.FontBold = True
    Printer.CurrentX = (Printer.ScaleWidth - Printer.TextWidth("注册信息")) / 2 - 10
    Printer.CurrentY = intTitleTop
    Printer.Print "注册信息"
    
    '打印注册信息
    Printer.FontSize = 11
    Printer.FontBold = False
    
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos
    Printer.Print "单位名称： " & txtDWMC.Text
      
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + intCharHeight
    Printer.Print "联系人： " & txtLXR.Text
    
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + 2 * intCharHeight
    Printer.Print "联系地址： " & txtAddress.Text
    
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + 3 * intCharHeight
    Printer.Print "联系电话： " & txtLXDH.Text
  
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + 4 * intCharHeight
    Printer.Print "移动电话： " & txtYDDH.Text
  
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + 5 * intCharHeight
    Printer.Print "邮政编码： " & txtYZBM.Text
  
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + 6 * intCharHeight
    Printer.Print "电子邮件： " & txtEMail.Text
  
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + 7 * intCharHeight
    Printer.Print lblXLH.Caption
    
    Printer.CurrentX = intLeftPos
    Printer.CurrentY = intTopPos + 8 * intCharHeight
    Printer.Print "主机码： " & txtZJM.Text
    
    Printer.EndDoc
End Sub

Private Sub cmdReg_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim strTemp As String
    Dim rstemp As ADODB.Recordset
    Dim clsDisk As New CDiskInfo
    Dim intRet As Integer
    Dim i As Integer
    
    Me.MousePointer = vbHourglass
    
    If txtDWMC.Text = "" Then
        MsgBox "请输入单位名称！该名称将出现在报表上！,请仔细填写", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    If txtZCM.Text = "" Then
        MsgBox "请输入注册码！" & vbCrLf & "您可以通过如下途径获得注册码:" & vbCrLf _
               & "将单位信息填写完毕，传真至北京" & g_strDevelopCompany & "软件科技有限公司！", vbInformation, "提示"
        txtZCM.SetFocus
        GoTo ExitLab
    End If
    
    For i = 0 To 3
        clsDisk.GetDiskInfo i
        intRet = Asc(Mid(clsDisk.pSerialNumber, 1, 1))
        If ((intRet >= 48) And (intRet <= 57)) Or ((intRet >= 97) And (intRet <= 122)) Or ((intRet >= 65) And (intRet <= 90)) Then
            Exit For
        End If
    Next
    If Trim(txtZCM.Text) = Trim(clsDisk.GetFixedSerialNumber("", 25)) Then
        MsgBox "注册成功！", vbInformation, "谢谢使用"
        gblnRegister = True
        clsDisk.KillRegFile
        SaveSetting App.EXEName, "Number", "Number", CharToHex(txtZCM.Text)
        
        strSQL = "select Count(*) from SET_HOSPITAL"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rstemp(0) < 1 Then
            '原来没有记录
            strSQL = "Insert into SET_HOSPITAL(DWMC) values(" _
                    & "'" & txtDWMC.Text & "')"
            GCon.Execute strSQL
        End If
        
        
        '把其它信息写入数据库
        strSQL = "update SET_HOSPITAL set" _
                & " DWMC='" & txtDWMC.Text & "'" _
                & ",Address='" & txtAddress.Text & "'" _
                & ",LXR='" & txtLXR.Text & "'" _
                & ",LXDH='" & txtLXDH.Text & "'" _
                & ",YDDH='" & txtYDDH.Text & "'" _
                & ",YZBM='" & txtYZBM.Text & "'" _
                & ",EMail='" & txtEMail.Text & "'"
        GCon.Execute strSQL
        
        Me.MousePointer = vbDefault
        Set clsDisk = Nothing
        Unload Me
    Else
'        strTemp = "注册码：" & vbCrLf & "***" & Trim(clsDisk.GetFixedSerialNumber("", 25)) & "***" & vbCrLf
        strTemp = ""
        MsgBox strTemp & "注册码不正确！请确认您输入的注册码是否由北京" & g_strDevelopCompany & "软件科技有限公司提供！", vbInformation, "提示"
        txtZCM.SetFocus
        GoTo ExitLab
    End If
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Set clsDisk = Nothing
    Me.MousePointer = vbDefault
End Sub

Private Sub cmdTry_Click()
    Unload Me
End Sub

Private Sub Form_Load()
On Error Resume Next
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim clsDisk As New CDiskInfo
    Dim i As Integer
    Dim intRet As Integer
    
    Screen.MousePointer = vbArrowHourglass
    
    strSQL = "select * from SET_HOSPITAL"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If Not rstemp.EOF Then
        txtDWMC.Text = rstemp("DWMC")
        txtLXR.Text = rstemp("LXR")
        txtLXDH.Text = rstemp("LXDH")
        txtYDDH.Text = rstemp("YDDH")
        txtYZBM.Text = rstemp("YZBM")
        txtEMail.Text = rstemp("EMail")
        
        lblXLH.Caption = lblXLH.Caption & "  " & rstemp("CPXLH")
        rstemp.Close
    End If
    
    For i = 0 To 3
        clsDisk.GetDiskInfo i
        intRet = Asc(Mid(clsDisk.pSerialNumber, 1, 1))
        If ((intRet >= 48) And (intRet <= 57)) Or ((intRet >= 97) And (intRet <= 122)) Or ((intRet >= 65) And (intRet <= 90)) Then
            Exit For
        End If
    Next
    txtZJM.Text = clsDisk.pSerialNumber
'    txtZJM.Text = Trim(GetLocalMac())
    Set clsDisk = Nothing
    
    Screen.MousePointer = vbDefault
End Sub

Private Sub txtDWMC_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtDWMC_LostFocus()
    txtDWMC.Text = Trim(txtDWMC.Text)
End Sub

Private Sub txtEMail_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtLXDH_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtLXR_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtYDDH_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtYZBM_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtZCM_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtZCM_LostFocus()
    txtZCM.Text = Trim(txtZCM.Text)
End Sub

Private Sub txtZJM_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub