📄 frmmedicmanage.frm
字号:
EndProperty
BeginProperty Column02
ColumnWidth = 915.024
EndProperty
BeginProperty Column03
ColumnWidth = 2085.166
EndProperty
BeginProperty Column04
ColumnWidth = 2085.166
EndProperty
BeginProperty Column05
ColumnWidth = 2085.166
EndProperty
BeginProperty Column06
ColumnWidth = 1814.74
EndProperty
BeginProperty Column07
ColumnWidth = 2085.166
EndProperty
EndProperty
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "病症："
Height = 180
Left = 4080
TabIndex = 24
Top = 1920
Width = 540
End
Begin VB.Label Labhelp
BackStyle = 0 'Transparent
Height = 255
Left = 10320
MouseIcon = "frmmedicmanage.frx":98DF
MousePointer = 99 'Custom
TabIndex = 23
ToolTipText = "帮助"
Top = 120
Width = 255
End
Begin VB.Label Lab
BackColor = &H00E0E0E0&
Caption = "名 单 录 入"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 255
Left = 4560
TabIndex = 22
Top = 98
Width = 1935
End
Begin VB.Label Label16
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "地址："
Height = 180
Left = 7560
TabIndex = 19
Top = 1320
Width = 540
End
Begin VB.Label Labexit
BackStyle = 0 'Transparent
Height = 375
Left = 10800
MouseIcon = "frmmedicmanage.frx":9BE9
MousePointer = 99 'Custom
TabIndex = 17
ToolTipText = "关闭"
Top = 120
Width = 375
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备注："
Height = 180
Left = 7560
TabIndex = 15
Top = 1920
Width = 540
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "电话："
Height = 180
Left = 1080
TabIndex = 13
Top = 2640
Width = 540
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "初诊时间："
Height = 180
Left = 840
TabIndex = 11
Top = 2040
Width = 900
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "性别："
Height = 180
Left = 4080
TabIndex = 9
Top = 1320
Width = 540
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "姓名："
Height = 180
Left = 1080
TabIndex = 8
Top = 1320
Width = 540
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Height = 375
Left = 6480
MouseIcon = "frmmedicmanage.frx":9D3B
MousePointer = 99 'Custom
TabIndex = 7
Top = 6240
Width = 1215
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Height = 495
Left = 4200
MouseIcon = "frmmedicmanage.frx":9E8D
MousePointer = 99 'Custom
TabIndex = 6
Top = 6120
Width = 1215
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Height = 375
Left = 1800
MouseIcon = "frmmedicmanage.frx":9FDF
MousePointer = 99 'Custom
TabIndex = 5
Top = 6240
Width = 1215
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Height = 375
Left = 8520
MouseIcon = "frmmedicmanage.frx":A131
MousePointer = 99 'Custom
TabIndex = 4
Top = 5520
Width = 1095
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Height = 375
Left = 6600
MouseIcon = "frmmedicmanage.frx":A283
MousePointer = 99 'Custom
TabIndex = 3
Top = 5520
Width = 1095
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Height = 375
Left = 4200
MouseIcon = "frmmedicmanage.frx":A3D5
MousePointer = 99 'Custom
TabIndex = 2
Top = 5520
Width = 1215
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Height = 375
Left = 1800
MouseIcon = "frmmedicmanage.frx":A527
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
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/18
'描 述：社区医疗点数据管理系统 Ver 1.0
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
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()
Text1.SetFocus
Combo1.AddItem "男"
Combo1.AddItem "女"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -