📄 form17.frm
字号:
Caption = "所录入的学生信息："
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 315
Left = 5280
TabIndex = 6
Top = 600
Width = 3105
End
Begin VB.Line Line1
BorderColor = &H00800000&
BorderStyle = 6 'Inside Solid
BorderWidth = 3
DrawMode = 14 'Copy Pen
X1 = 4920
X2 = 4920
Y1 = 600
Y2 = 6480
End
Begin VB.Image Pjiao
Height = 255
Left = 7680
MousePointer = 8 'Size NW SE
Top = 6360
Width = 255
End
Begin VB.Image Imico
Height = 240
Left = 4200
Picture = "Form17.frx":13163
Top = 3600
Visible = 0 'False
Width = 240
End
Begin VB.Image IMus2
Height = 240
Left = 4560
Picture = "Form17.frx":134ED
Top = 7080
Visible = 0 'False
Width = 255
End
Begin VB.Image IMus1
Height = 240
Left = 4560
Picture = "Form17.frx":1386F
Top = 6840
Visible = 0 'False
Width = 255
End
Begin VB.Image IMus0
Height = 240
Left = 4560
Picture = "Form17.frx":13BF1
Top = 6600
Visible = 0 'False
Width = 255
End
Begin VB.Image Pright
Height = 6495
Left = 8640
MousePointer = 9 'Size W E
Top = 0
Width = 135
End
Begin VB.Image Pbottom
Height = 195
Left = 0
MousePointer = 7 'Size N S
Stretch = -1 'True
Top = 6600
Width = 1785
End
Begin VB.Image Imclose
Height = 240
Left = 7440
ToolTipText = "关闭"
Top = 840
Width = 255
End
Begin VB.Image Immax
Height = 240
Left = 7080
ToolTipText = "最大化"
Top = 840
Width = 255
End
Begin VB.Image Immin
Height = 240
Left = 6720
ToolTipText = "最小化"
Top = 840
Width = 255
End
Begin VB.Image Immax2
Height = 240
Left = 4200
Picture = "Form17.frx":13F73
Top = 6840
Visible = 0 'False
Width = 255
End
Begin VB.Image Immax1
Height = 240
Left = 3840
Picture = "Form17.frx":142F5
Top = 6840
Visible = 0 'False
Width = 255
End
Begin VB.Image ImClose1
Height = 240
Left = 3840
Picture = "Form17.frx":14677
Top = 7080
Visible = 0 'False
Width = 255
End
Begin VB.Image ImClose2
Height = 240
Left = 4200
Picture = "Form17.frx":149F9
Top = 7080
Visible = 0 'False
Width = 255
End
Begin VB.Image ImMin2
Height = 240
Left = 4200
Picture = "Form17.frx":14D7B
Top = 6600
Visible = 0 'False
Width = 255
End
Begin VB.Image ImMin1
Height = 240
Left = 3840
Picture = "Form17.frx":150FD
Top = 6600
Visible = 0 'False
Width = 255
End
Begin VB.Image IMBar
Height = 255
Left = 0
Top = 0
Width = 8535
End
End
Attribute VB_Name = "Form17"
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 stre As Boolean
Dim last, Source As String
Dim mark As Variant
'该函数用来做圆角窗体
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 ROButton5_Click()
Form20.Show
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
End Sub
Private Sub ImMin_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Immin.Picture = ImMin2.Picture
End Sub
Private Sub ImMin_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Immin.Tag = "" Then
Immin.Picture = ImMin1.Picture
Immin.Tag = "1"
End If
End Sub
Private Sub ImMin_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Immin.Picture = LoadPicture()
Immin.Tag = ""
End Sub
Private Sub Imclose_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Imclose.Picture = ImClose2.Picture
End Sub
Private Sub Imclose_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Imclose.Tag = "" Then
Imclose.Picture = ImClose1.Picture
Imclose.Tag = "1"
End If
End Sub
Private Sub Imclose_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Imclose.Picture = LoadPicture()
Imclose.Tag = ""
End Sub
Private Sub Immax_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Me.WindowState = 0 Then Immax.Picture = Immax2.Picture
If Me.WindowState = 2 Then Immax.Picture = IMus2.Picture
End Sub
Private Sub Immax_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Immax.Tag = "" Then
If Me.WindowState = 0 Then Immax.Picture = Immax1.Picture
If Me.WindowState = 2 Then Immax.Picture = IMus1.Picture
Immax.Tag = "1"
End If
End Sub
Private Sub Immax_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Immax.Picture = LoadPicture()
Immax.Tag = ""
End Sub
Private Sub pbottom_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Pbottom.Tag = ""
End Sub
Private Sub pbottom_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Pbottom.Tag = "1"
End Sub
Private Sub pbottom_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Pbottom.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.y * 15 - Me.TOp
If gg > 1500 Then Me.Height = gg '获得鼠标位置，用来改变窗体大小，这可是一个好办法哟
End If
End Sub
Private Sub Pright_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Pright.Tag = ""
End Sub
Private Sub Pright_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Pright.Tag = "1"
End Sub
Private Sub Pright_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Pright.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.x * 15 - Me.Left
If gg > 2500 Then Me.Width = gg
End If
End Sub
Private Sub Pjiao_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Pjiao.Tag = ""
End Sub
Private Sub Pjiao_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Pjiao.Tag = "1"
End Sub
Private Sub Pjiao_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
If Pjiao.Tag <> "" Then
Dim pos As POINTAPI
GetCursorPos pos
gg = pos.x * 15 - Me.Left
gg2 = pos.y * 15 - Me.TOp
If gg > 2500 Then Me.Width = gg
If gg2 > 1500 Then Me.Height = gg2
End If
End Sub
Private Sub ROButton2_Click()
Data1.RecordSource = "SELECT * FROM 学生情况表 "
'Data1.Refresh
Form19.Show
Me.Hide
End Sub
Private Sub FaSheng(aaa)
Select Case aaa
Case vbKey0
sndPlaySound App.Path & "\声音\0.wav", &H1
Case vbKey1
sndPlaySound App.Path + "\声音\1.wav", &H1
Case vbKey2
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -