frmmedicmanage.frm

VB医药保险品查询系统

         Left            =   5520
         TabIndex        =   19
         Top             =   2880
         Width           =   720
      End
      Begin VB.Label Label13 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "药品细类："
         Height          =   180
         Left            =   2520
         TabIndex        =   18
         Top             =   2880
         Width           =   900
      End
      Begin VB.Label Label12 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "剂型："
         Height          =   180
         Left            =   5640
         TabIndex        =   16
         Top             =   2280
         Width           =   540
      End
      Begin VB.Label Label11 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "商品名："
         Height          =   180
         Left            =   2640
         TabIndex        =   14
         Top             =   2280
         Width           =   720
      End
      Begin VB.Label Label10 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "药品名："
         Height          =   180
         Left            =   2640
         TabIndex        =   11
         Top             =   1680
         Width           =   720
      End
      Begin VB.Label Label9 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "医保类型："
         Height          =   180
         Left            =   5400
         TabIndex        =   9
         Top             =   1080
         Width           =   900
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "类型："
         Height          =   180
         Left            =   2760
         TabIndex        =   8
         Top             =   1200
         Width           =   540
      End
      Begin VB.Label Label7 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   6480
         MouseIcon       =   "frmmedicmanage.frx":9B65
         MousePointer    =   99  'Custom
         TabIndex        =   7
         Top             =   6240
         Width           =   1215
      End
      Begin VB.Label Label6 
         BackStyle       =   0  'Transparent
         Height          =   495
         Left            =   4200
         MouseIcon       =   "frmmedicmanage.frx":9CB7
         MousePointer    =   99  'Custom
         TabIndex        =   6
         Top             =   6120
         Width           =   1215
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   1800
         MouseIcon       =   "frmmedicmanage.frx":9E09
         MousePointer    =   99  'Custom
         TabIndex        =   5
         Top             =   6240
         Width           =   1215
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   8520
         MouseIcon       =   "frmmedicmanage.frx":9F5B
         MousePointer    =   99  'Custom
         TabIndex        =   4
         Top             =   5520
         Width           =   1095
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   6600
         MouseIcon       =   "frmmedicmanage.frx":A0AD
         MousePointer    =   99  'Custom
         TabIndex        =   3
         Top             =   5520
         Width           =   1095
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   4200
         MouseIcon       =   "frmmedicmanage.frx":A1FF
         MousePointer    =   99  'Custom
         TabIndex        =   2
         Top             =   5520
         Width           =   1215
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Height          =   375
         Left            =   1800
         MouseIcon       =   "frmmedicmanage.frx":A351
         MousePointer    =   99  'Custom
         TabIndex        =   1
         Top             =   5520
         Width           =   1215
      End
   End
End
Attribute VB_Name = "frmmedicmanage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Download by http://www.codefans.net
Option Explicit
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
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.Picture4
  Me.Width = Me.Picture4.Width
  Me.Height = Me.Picture4.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 Label1_Click()
Combo1.AddItem "西药"
Combo1.AddItem "中成药"
Combo2.AddItem "甲类"
Combo2.AddItem "乙类"
Combo3.AddItem "片剂"
Combo3.AddItem "胶囊剂"
Combo3.AddItem "注射剂"
Combo3.AddItem "栓剂"
Combo3.AddItem "缓释片"
Combo3.AddItem "颗粒剂"
Combo3.AddItem "粉剂"
Combo3.AddItem "膜剂"
Combo3.AddItem "口服液"
Combo3.AddItem "气雾剂"
Combo3.AddItem "控释剂"
Combo3.AddItem "溶液剂"
Combo3.AddItem "喷雾剂"
Combo3.AddItem "混悬剂"
Combo3.AddItem "吸入剂"
Combo3.AddItem "浸膏剂"
Combo3.AddItem "酊剂"
Combo3.AddItem "乳剂"
Combo3.AddItem "滴剂"
Combo3.AddItem "糖浆剂"
Combo3.AddItem "胶浆剂"
Combo3.AddItem "缓释胶囊"
Combo3.AddItem "咀嚼片"
Combo3.AddItem "乳膏(霜)剂"
Combo3.AddItem "软膏剂"
Combo3.AddItem "滴眼剂"
Combo3.AddItem "阴道片"
Combo3.AddItem "干混悬剂"
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()
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