查询封面.frm

医院管理系统之磁卡查询管理系统

VERSION 5.00
Object = "{82351433-9094-11D1-A24B-00A0C932C7DF}#1.5#0"; "ANIGIF.OCX"
Begin VB.Form FormFm 
   Caption         =   "Form1"
   ClientHeight    =   6330
   ClientLeft      =   1155
   ClientTop       =   1455
   ClientWidth     =   9585
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   Picture         =   "查询封面.frx":0000
   ScaleHeight     =   6330
   ScaleWidth      =   9585
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   180
      Left            =   3105
      TabIndex        =   3
      Top             =   1260
      Width           =   2385
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   1  'ODBCCursor
      DefaultType     =   1  'UseODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   7590
      Options         =   0
      ReadOnly        =   -1  'True
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   6360
      Visible         =   0   'False
      Width           =   2085
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H00C0C000&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   300
      Left            =   105
      Locked          =   -1  'True
      TabIndex        =   2
      Text            =   "                            请按上下箭头 选定您想查询哪一次住院信息"
      Top             =   75
      Width           =   9420
   End
   Begin AniGIFCtrl.AniGIF Arrow 
      Height          =   480
      Left            =   1140
      TabIndex        =   1
      Top             =   1440
      Visible         =   0   'False
      Width           =   480
      BackColor       =   12632256
      PLaying         =   -1  'True
      Transparent     =   -1  'True
      Speed           =   1
      Stretch         =   0
      AutoSize        =   -1  'True
      SequenceString  =   ""
      Sequence        =   0
      HTTPProxy       =   ""
      HTTPUserName    =   ""
      HTTPPassword    =   ""
      MousePointer    =   0
      GIF             =   "查询封面.frx":4B442
      ExtendWidth     =   847
      ExtendHeight    =   847
      Loop            =   0
      AutoRewind      =   0   'False
      Synchronized    =   -1  'True
   End
   Begin VB.Label lblHz 
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   360
      Index           =   1
      Left            =   1845
      TabIndex        =   0
      Top             =   1440
      Width           =   6915
   End
End
Attribute VB_Name = "FormFm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ArrowPos As Integer
Dim MaxPos As Integer
Dim RecString As String




Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
 
 If KeyCode = 38 And ArrowPos > 1 Then '向上
     
     HzZyh = Left(lblHz(ArrowPos).Caption, 8)
     lblHz(ArrowPos).ForeColor = vbWhite
     Arrow.Top = Arrow.Top - 400
     ArrowPos = ArrowPos - 1
     lblHz(ArrowPos).ForeColor = vbYellow
     
 End If
 
 If KeyCode = 40 And ArrowPos < MaxPos Then '向下
   
     HzZyh = Left(lblHz(ArrowPos).Caption, 8)
     lblHz(ArrowPos).ForeColor = vbWhite
     Arrow.Top = Arrow.Top + 400
     ArrowPos = ArrowPos + 1
     lblHz(ArrowPos).ForeColor = vbYellow
     
 End If
 
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  Dim s As String
  Dim i As Integer
  
  Dim STRlen As Integer
  Dim Hyid As String
  
    
  If KeyAscii = 13 Then
  
      If Right(RecString, 4) = "QUIT" Then
         
         Unload Me
         
      End If
      RecString = ""
     
  End If
  
  If KeyAscii = 59 Then '; 的KeyAscii为59
  
      RecString = ""
      STRlen = 0
      
  End If
  
  RecString = RecString & Chr(KeyAscii)
  
  If KeyAscii = 63 Then '63---?
      Debug.Print RecString
      Hyid = ""
      i = 2
      
      While i < 30
        
         s = Mid(RecString, i, 1)
         If s = "?" Then
             
             GoTo zyhOK
         
         End If
         i = i + 1
         Hyid = Hyid + s
        
      Wend
  End If
  
  Exit Sub
zyhOK:
  Data1.RecordSource = "zy_hycx '" + Hyid + "'"
  Data1.Refresh
  Data1.Recordset.MoveFirst
  If Data1.Recordset.EOF Then
   Exit Sub
  End If
  lblHz(1).Caption = Data1.Recordset!zy_zyid + "  " + Data1.Recordset!zy_name + "  " + Left(CStr(Data1.Recordset!zy_ryrq), 10)
  
  Data1.Recordset.MoveNext
  MaxPos = 1
  While Not Data1.Recordset.EOF
      
      MaxPos = MaxPos + 1
      Load lblHz(MaxPos)
      lblHz(MaxPos).Caption = Data1.Recordset!zy_zyid + "  " + Data1.Recordset!zy_name + "  " + Left(CStr(Data1.Recordset!zy_ryrq), 10)
      lblHz(MaxPos).Top = lblHz(MaxPos - 1).Top + 400
      lblHz(MaxPos).Visible = True
      Data1.Recordset.MoveNext
        
  Wend
  Arrow.Visible = True
  ArrowPos = 1
  lblHz(1).ForeColor = vbYellow
End Sub

Private Sub Form_Load()
  
  MyConnect = "odbc;uid=zwj;pwd=qqq;database=net207"
  MyDatabase = "207his"
  
  Data1.Connect = MyConnect
  Data1.DatabaseName = MyDatabase
  
End Sub

Private Sub Timer1_Timer()
 If Image1.Visible = True Then
  Image1.Visible = False
 Else
  Image1.Visible = True
 End If
End Sub