📄 form14.frm
字号:
ForeColor = &H000000FF&
Height = 285
Left = 465
TabIndex = 12
Top = 1695
Width = 1920
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "姓 名："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 435
TabIndex = 11
Top = 2190
Width = 1935
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "场次与座次："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 435
TabIndex = 10
Top = 2715
Width = 1890
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "考场总人数："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 435
TabIndex = 9
Top = 1140
Width = 1890
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择学校："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 435
TabIndex = 8
Top = 690
Width = 1890
End
Begin VB.Image IMBar
Height = 255
Left = 45
Top = 45
Width = 3015
End
Begin VB.Image ImMin1
Height = 240
Left = 2400
Picture = "Form14.frx":13E69
Top = 4560
Visible = 0 'False
Width = 255
End
Begin VB.Image ImMin2
Height = 240
Left = 2760
Picture = "Form14.frx":141EB
Top = 4560
Visible = 0 'False
Width = 255
End
Begin VB.Image ImClose2
Height = 240
Left = 2610
Picture = "Form14.frx":1456D
Top = 5040
Visible = 0 'False
Width = 255
End
Begin VB.Image ImClose1
Height = 240
Left = 2250
Picture = "Form14.frx":148EF
Top = 5040
Visible = 0 'False
Width = 255
End
Begin VB.Image Immax1
Height = 240
Left = 2400
Picture = "Form14.frx":14C71
Top = 4800
Visible = 0 'False
Width = 255
End
Begin VB.Image Immax2
Height = 240
Left = 2760
Picture = "Form14.frx":14FF3
Top = 4800
Visible = 0 'False
Width = 255
End
Begin VB.Image Immin
Height = 240
Left = 6930
ToolTipText = "最小化"
Top = 15
Visible = 0 'False
Width = 255
End
Begin VB.Image Immax
Height = 240
Left = 7290
ToolTipText = "最大化"
Top = 15
Visible = 0 'False
Width = 255
End
Begin VB.Image Imclose
Height = 240
Left = 7650
ToolTipText = "关闭"
Top = 15
Width = 255
End
Begin VB.Image Pbottom
Height = 195
Left = 90
MousePointer = 7 'Size N S
Stretch = -1 'True
Top = 4455
Width = 1785
End
Begin VB.Image Pright
Height = 5535
Left = 8145
MousePointer = 9 'Size W E
Top = -225
Width = 135
End
Begin VB.Image IMus0
Height = 240
Left = 3120
Picture = "Form14.frx":15375
Top = 4560
Visible = 0 'False
Width = 255
End
Begin VB.Image IMus1
Height = 240
Left = 3120
Picture = "Form14.frx":156F7
Top = 4800
Visible = 0 'False
Width = 255
End
Begin VB.Image IMus2
Height = 240
Left = 2970
Picture = "Form14.frx":15A79
Top = 5040
Visible = 0 'False
Width = 255
End
Begin VB.Image Imico
Height = 240
Left = 5370
Picture = "Form14.frx":15DFB
Top = 5880
Visible = 0 'False
Width = 240
End
Begin VB.Image Pjiao
Height = 255
Left = 6570
MousePointer = 8 'Size NW SE
Top = 5640
Width = 255
End
End
Attribute VB_Name = "Form14"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'设置不规则窗体的API
Private Declare Function SetWindowRgn Lib "USER32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Const RGN_OR = 2
'拖动窗体的API
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 Any) As Long
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
'获得鼠标位置，用来改变窗体大小的
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
'
Dim i, j, m, n, s, d, sum As Integer
Dim stre As Boolean
'该函数用来做圆角窗体
Public Sub RMe()
Dim Regn As Long '定义设置区域的句柄
Dim CER As Long '定义临时句柄变量
'把Twip计量单位转换成象素
X1 = Me.Width / 15
Y1 = Me.Height / 15
'画矩形
Regn = CreateRectRgn(0, 26, X1, Y1 - 26) '把句柄设为第一个矩形区域
CER = CreateRectRgn(23, 0, X1 - 23, Y1) '创建第二个矩形区域
CombineRgn Regn, Regn, CER, RGN_OR '把临时句柄变量或运算到句柄变量中
'由于第四个圆角较小，这里要用矩形补足
CER = CreateRectRgn(23, 52, X1, Y1 - 6)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateRectRgn(52, 52, X1 - 6, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
'画四个圆
CER = CreateEllipticRgn(0, 0, 52, 52)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(X1 - 50, 0, X1 + 1, 52)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(0, Y1 - 52, 52, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
CER = CreateEllipticRgn(X1 - 9, Y1 - 9, X1, Y1)
CombineRgn Regn, Regn, CER, RGN_OR
Call SetWindowRgn(Me.hwnd, Regn, True) '创建窗体
End Sub
Private Sub ROButton6_Click()
Data1.Recordset.MoveFirst
Timer3.Interval = 1
ROButton1.Enabled = True
ROButton2.Enabled = True
ROButton6.Enabled = False
ROButton7.Enabled = True
End Sub
Private Sub ROButton7_Click()
Data1.Recordset.MoveFirst
Timer1.Interval = 1
ROButton1.Enabled = True
ROButton2.Enabled = True
ROButton6.Enabled = True
ROButton7.Enabled = False
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Imclose.Tag <> "" Then
Imclose.Picture = LoadPicture()
Imclose.Tag = ""
End If
If Immin.Tag <> "" Then
Immin.Picture = LoadPicture()
Immin.Tag = ""
End If
If Immax.Tag <> "" Then
Immax.Picture = LoadPicture()
Immax.Tag = ""
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
'改变一些控件位置
IMBar.Width = Me.Width - 1100
Immax.TOp = 120
Immax.Left = Me.Width - 780
Immin.TOp = 120
Immin.Left = Me.Width - 1095
Imclose.TOp = 120
Imclose.Left = Me.Width - 465
Pbottom.TOp = Me.Height - Pbottom.Height
Pbottom.Width = Me.Width - 240
Pright.Left = Me.Width - Pright.Width
Pright.Height = Me.Height - 240
Pjiao.Left = Me.Width - Pjiao.Width
Pjiao.TOp = Me.Height - Pjiao.Height
'用于把主窗体图片打印成适合窗体大小
Me.Line (0, 0)-(Me.Width, Me.Height), Me.BackColor, BF
Me.PaintPicture Pmain.Picture, 420, 0, Me.Width, 600, 420, 0, 120, 600
Me.PaintPicture Pmain.Picture, 420, Me.Height - 600, Me.Width, 600, 420, Pmain.Height - 600, 120, 600
Me.PaintPicture Pmain.Picture, 0, 0, 200, Me.Height, 0, 880, 200, 40
Me.PaintPicture Pmain.Picture, Me.Width - 200, 0, 200, Me.Height, Pmain.Width - 200, 880, 200, 40
Me.PaintPicture Pmain.Picture, 0, 0, 450, 600, 0, 0, 450, 600
Me.PaintPicture Pmain.Picture, 0, Me.Height - 600, 450, 600, 0, Pmain.Height - 600, 450, 600
Me.PaintPicture Pmain.Picture, Me.Width - 1665, 0, 1665, 435, Pmain.Width - 1665, 0, 1665, 435
Me.PaintPicture Pmain.Picture, Me.Width - 1665, Me.Height - 525, 1665, 525, Pmain.Width - 1665, Pmain.Height - 525, 1665, 525
Me.PaintPicture Imico, 240, 100, 240, 240, 0, 0, 240, 240 '打印标题图标
Me.ForeColor = 12691863
Me.CurrentX = 530
Me.CurrentY = 110
Me.Print Me.caption '打印标题，有阴影的
Me.ForeColor = 11100191
Me.CurrentX = 540
Me.CurrentY = 120
Me.Print Me.caption
RMe
End Sub
Private Sub IMBar_DblClick()
Immax_Click '双击标题栏时最大化和还原
End Sub
Private Sub IMBar_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'不用多说，拖动窗体
If Button = 1 Then
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
Private Sub ImClose_Click()
Unload Me
Form2.Show
End Sub
Private Sub Immax_Click()
'由于最大化和还原按钮是同一个Image，所以这里麻烦一点
If Me.WindowState = 2 Then
Me.WindowState = 0
Pbottom.Visible = True
Pright.Visible = True
Immax.ToolTipText = "最大化"
Else
Me.WindowState = 2
Pbottom.Visible = False
Pright.Visible = False
Me.Line (Immax.Left, Immax.TOp)-(Immax.Left + 240, Immax.TOp + 240), 16448250, BF
Me.PaintPicture IMus0.Picture, Immax.Left, Immax.TOp, 240, 240, 0, 0, 240, 240
Immax.ToolTipText = "还原"
End If
End Sub
Private Sub ImMin_Click()
Me.WindowState = 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -