📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 0 'None
Caption = "z"
ClientHeight = 3795
ClientLeft = 4425
ClientTop = 3525
ClientWidth = 6240
LinkTopic = "Form1"
Picture = "Form1.frx":0000
ScaleHeight = 3795
ScaleWidth = 6240
ShowInTaskbar = 0 'False
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 255
Index = 2
Left = 1320
TabIndex = 11
Top = 1920
Width = 975
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 255
Index = 1
Left = 1320
TabIndex = 10
Top = 1560
Width = 975
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 705
Index = 11
Left = 3520
MultiLine = -1 'True
TabIndex = 9
Top = 1920
Width = 2355
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 230
Index = 10
Left = 1830
TabIndex = 8
Top = 3120
Width = 712
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 230
Index = 9
Left = 1830
TabIndex = 7
Top = 2790
Width = 712
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 230
Index = 8
Left = 981
TabIndex = 6
Top = 3120
Width = 715
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 230
Index = 7
Left = 981
TabIndex = 5
Top = 2790
Width = 715
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 255
Index = 6
Left = 5320
TabIndex = 4
Top = 1560
Width = 550
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 255
Index = 5
Left = 5320
TabIndex = 3
Top = 1200
Width = 550
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 255
Index = 3
Left = 3520
TabIndex = 2
Top = 1200
Width = 1000
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 255
Index = 4
Left = 3520
TabIndex = 1
Top = 1560
Width = 1000
End
Begin VB.TextBox Text1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 255
Index = 0
Left = 1320
MultiLine = -1 'True
TabIndex = 0
Top = 1200
Width = 975
End
Begin VB.Image Image1
Height = 390
Left = 4740
Picture = "Form1.frx":AEDB
Top = 2910
Width = 885
End
Begin VB.Image Image2
Height = 270
Left = 4380
Picture = "Form1.frx":10F78
Top = 40
Width = 465
End
Begin VB.Image Image3
Height = 270
Left = 5300
Picture = "Form1.frx":111FC
Top = 40
Width = 435
End
Begin VB.Image Image4
Height = 390
Left = 3525
Picture = "Form1.frx":16AC6
Top = 2910
Width = 885
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'经过我不懈的努力，总算做的比较完美了
'谢谢大家的使用和学习
'1,窗体的效果
'2,按钮的效果
'3,文本框的效果
'
'
'
'
'
' 作者：怪人
'我们先来了解一下这几个函数
'函数CreateRoundRectRgn用于创建一个圆角矩形，该矩形由X1，Y1-X2，Y2确定，
'并由X3，Y3确定的椭圆描述圆角弧度
'CreateRoundRectRgn参数 类型及说明
'X1,Y1 Long，矩形左上角的X，Y坐标
'X2,Y2 Long，矩形右下角的X，Y坐标
'X3 Long，圆角椭圆的宽。其范围从0（没有圆角）到矩形宽（全圆）
'Y3 Long，圆角椭圆的高。其范围从0（没有圆角）到矩形高（全圆）
'SetWindowRgn用于将CreateRoundRectRgn创建的圆角区域赋给窗体
'DeleteObject用于将CreateRoundRectRgn创建的区域删除，这是必要的，否则不必要的占用电脑内存
'接下来声明一个全局变量,用来获得区域句柄，如下：
'窗体变形的API声明：
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'ReleaseCapture说明
'为当前的应用程序释放鼠标捕获
'返回值
'Long，TRUE（非零）表示成功，零表示失败
'注解
'我的理解：与SetCapture函数一起使用，用于判断鼠标离开（mouseleave）事件
'SendMessage说明
'调用一个窗口的窗口函数，将一条消息发给那个窗口。除非消息处理完毕，否则该函数不会返回。
'SendMessageBynum， SendMessageByString是该函数的“类型安全”声明形式
'返回值
'Long，由具体的消息决定
'参数表
'参数 类型及说明
'hwnd Long，要接收消息的那个窗口的句柄
'wMsg Long，消息的标识符
'wParam Long，具体取决于消息
'lParam Any，具体取决于消息
'鼠标可以拖动窗体的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 WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
'******************************
Dim outrgn As Long
Dim g As Integer
'然后分别在窗体Activate()事件和Unload事件中输入以下代码
Private Sub Form_Activate()
Call rgnform(Me, 60, 60)
End Sub
Private Sub Form_Load()
g = 11
For g = 0 To g
Text1(g).BackColor = RGB(133, 203, 236)
Next g
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject outrgn '将圆角区域使用的所有系统资源释放
End Sub
'接下来我们开始编写子过程
Private Sub rgnform(ByVal frmbox As Form, ByVal fw As Long, ByVal fh As Long)
Dim w As Long, h As Long
w = frmbox.ScaleX(frmbox.Width, vbTwips, vbPixels)
h = frmbox.ScaleY(frmbox.Height, vbTwips, vbPixels)
outrgn = CreateRoundRectRgn(0, 0, w, h, fw, fh)
Call SetWindowRgn(frmbox.hwnd, outrgn, True)
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '移动窗体
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Right(App.Path, 1) = "\" Then
Image4.Picture = LoadPicture(App.Path & "ok.jpg")
Image3.Picture = LoadPicture(App.Path & "close.jpg")
Image2.Picture = LoadPicture(App.Path & "min.jpg")
Image1.Picture = LoadPicture(App.Path & "cle.jpg")
Else
Image4.Picture = LoadPicture(App.Path & "\" & "ok.jpg")
Image3.Picture = LoadPicture(App.Path & "\" & "close.jpg")
Image2.Picture = LoadPicture(App.Path & "\" & "min.jpg")
Image1.Picture = LoadPicture(App.Path & "\" & "cle.jpg")
End If
g = 11
For g = 0 To g
Text1(g).BorderStyle = 0
Next g
End Sub
Private Sub Image4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Right(App.Path, 1) = "\" Then
Image4.Picture = LoadPicture(App.Path & "oko.jpg")
Else
Image4.Picture = LoadPicture(App.Path & "\" & "oko.jpg")
End If
End Sub
Private Sub Image3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Right(App.Path, 1) = "\" Then
Image3.Picture = LoadPicture(App.Path & "closeo.jpg")
Else
Image3.Picture = LoadPicture(App.Path & "\" & "closeo.jpg")
End If
End Sub
Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Right(App.Path, 1) = "\" Then
Image2.Picture = LoadPicture(App.Path & "mino.jpg")
Else
Image2.Picture = LoadPicture(App.Path & "\" & "mino.jpg")
End If
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Right(App.Path, 1) = "\" Then
Image1.Picture = LoadPicture(App.Path & "cleo.jpg")
Else
Image1.Picture = LoadPicture(App.Path & "\" & "cleo.jpg")
End If
End Sub
Private Sub Image4_Click()
MsgBox "请输入数据哦！"
End Sub
Private Sub Image3_Click()
If Right(App.Path, 1) = "\" Then
Image3.Picture = LoadPicture(App.Path & "closed.jpg")
Else
Image3.Picture = LoadPicture(App.Path & "\" & "closed.jpg")
End If
Unload Me
End Sub
Private Sub Image2_Click()
If Right(App.Path, 1) = "\" Then
Image2.Picture = LoadPicture(App.Path & "mind.jpg")
Else
Image2.Picture = LoadPicture(App.Path & "\" & "mind.jpg")
End If
Form1.WindowState = 1
End Sub
Private Sub Image1_Click()
If Right(App.Path, 1) = "\" Then
Image2.Picture = LoadPicture(App.Path & "cled.jpg")
Else
Image2.Picture = LoadPicture(App.Path & "\" & "cled.jpg")
End If
Unload Me
End Sub
Private Sub Text1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case Is = 0
Text1(0).BorderStyle = 1
Case Is = 1
Text1(1).BorderStyle = 1
Case Is = 2
Text1(2).BorderStyle = 1
Case Is = 3
Text1(3).BorderStyle = 1
Case Is = 4
Text1(4).BorderStyle = 1
Case Is = 5
Text1(5).BorderStyle = 1
Case Is = 6
Text1(6).BorderStyle = 1
Case Is = 7
Text1(7).BorderStyle = 1
Case Is = 8
Text1(8).BorderStyle = 1
Case Is = 9
Text1(9).BorderStyle = 1
Case Is = 10
Text1(10).BorderStyle = 1
Case Is = 11
Text1(11).BorderStyle = 1
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -