frmmedicfind.frm

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

         Top             =   1680
         Width           =   2535
      End
      Begin VB.Label Labhelp 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   10200
         MouseIcon       =   "frmmedicfind.frx":7894
         MousePointer    =   99  'Custom
         TabIndex        =   10
         ToolTipText     =   "帮助"
         Top             =   0
         Width           =   375
      End
      Begin VB.Label Label6 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   9480
         MouseIcon       =   "frmmedicfind.frx":7B9E
         MousePointer    =   99  'Custom
         TabIndex        =   9
         Top             =   1440
         Width           =   975
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Height          =   255
         Left            =   10800
         MouseIcon       =   "frmmedicfind.frx":7CF0
         MousePointer    =   99  'Custom
         TabIndex        =   7
         ToolTipText     =   "关闭"
         Top             =   120
         Width           =   255
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   9480
         MouseIcon       =   "frmmedicfind.frx":7E42
         MousePointer    =   99  'Custom
         TabIndex        =   6
         Top             =   2040
         Width           =   975
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Height          =   495
         Left            =   9480
         MouseIcon       =   "frmmedicfind.frx":7F94
         MousePointer    =   99  'Custom
         TabIndex        =   5
         Top             =   840
         Width           =   975
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "等于（包含）"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   4200
         TabIndex        =   4
         Top             =   1800
         Width           =   1260
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "选 择 查 询 方 式："
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   1440
         TabIndex        =   2
         Top             =   1440
         Width           =   1995
      End
   End
End
Attribute VB_Name = "frmmedicfind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/18
'描    述：社区医疗点数据管理系统 Ver 1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Dim KeyAscii
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const RGN_XOR = 3
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Type RECT
  left As Long
  top As Long
  right As Long
  bottom As Long
End Type
Dim Xs As Long



Private Sub Form_Load()
SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
  Me.CreatePictureform
Combo1.AddItem "按姓名"
Combo1.AddItem "按初诊时间"
Combo1.AddItem "按地址"
Combo1.AddItem "按电话"
End Sub

Function CreatePictureform()
  On Error Resume Next
  Dim hRgn As Long, hRect As RECT, hTempRgn As Long, tColour As Long, OldScaleMode As Integer, AbsoluteX As Long, AbsoluteY As Long
  Dim Color As Long, Hrect1 As RECT
  Dim xx As Long, yy As Long
  Dim rtn As Long
  Me.Picture = Me.Picture1
  Me.Width = Me.Picture1.Width
  Me.Height = Me.Picture1.Height
  OldScaleMode = Me.ScaleMode
  Me.AutoRedraw = True
  Me.ScaleMode = 3
  Color = vbWhite
  rtn = GetWindowRect(Me.hWnd, hRect)
  hRgn = CreateRectRgn(0, 0, hRect.right, hRect.bottom)
  For AbsoluteX = 0 To Me.ScaleWidth
    For AbsoluteY = 0 To Me.ScaleHeight
      tColour = GetPixel(Me.hdc, AbsoluteX, AbsoluteY)
      If tColour = Color Then
        hTempRgn = CreateRectRgn(AbsoluteX, AbsoluteY, AbsoluteX + 1, AbsoluteY + 1)
        rtn = CombineRgn(hRgn, hRgn, hTempRgn, RGN_XOR)
        rtn = DeleteObject(hTempRgn)
      End If
    Next AbsoluteY
  Next AbsoluteX
  rtn = SetWindowRgn(Me.hWnd, hRgn, True)
  DeleteObject hRgn
  Me.ScaleMode = OldScaleMode
  If Err Then
    MsgBox Error, 16, Err
  End If
End Function

Private Sub LblExit_Click()
End
End Sub

Private Sub Lblzhuche_Click()
frmadduser.Show
Unload Me
End Sub

Private Sub Label3_Click()
If Combo1.Text = "按姓名" Then
   Adodc1.CommandType = adCmdText
   Adodc1.RecordSource = "Select * from medicdate where name like '%" & Text1.Text & "%'"
   Adodc1.Refresh
   Set DataGrid1.DataSource = Adodc1
ElseIf Combo1.Text = "按初诊时间" Then
   Adodc1.CommandType = adCmdText
   Adodc1.RecordSource = "Select * from medicdate where date like '%" & Text1.Text & "%'"
   Adodc1.Refresh
   Set DataGrid1.DataSource = Adodc1
ElseIf Combo1.Text = "按地址" Then
   Adodc1.CommandType = adCmdText
   Adodc1.RecordSource = "Select * from medicdate where add like '%" & Text1.Text & "%'"
   Adodc1.Refresh
   Set DataGrid1.DataSource = Adodc1
ElseIf Combo1.Text = "按电话" Then
  Adodc1.CommandType = adCmdText
  Adodc1.RecordSource = "Select * from medicdate where tel like '%" & Text1.Text & "%'"
   Adodc1.Refresh
   Set DataGrid1.DataSource = Adodc1
End If
End Sub

Private Sub Label4_Click()
   Unload Me
   Main.Show
End Sub

Private Sub Label5_Click()
   Unload Me
   Main.Show
End Sub

Private Sub Label6_Click()
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "Select * from medicdate"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub


Private Sub Picture1_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

Private Sub Text1_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
    Label3_Click

End If
End Sub