-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathForm10.frm
158 lines (154 loc) · 5.43 KB
/
Form10.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
VERSION 5.00
Begin VB.Form Form10
BorderStyle = 0 'None
Caption = "Form10"
ClientHeight = 3750
ClientLeft = 0
ClientTop = 0
ClientWidth = 6015
LinkTopic = "Form10"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3750
ScaleWidth = 6015
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer1
Interval = 10
Left = 5160
Top = 1920
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "Label3"
BeginProperty Font
Name = "微软雅黑"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000014&
Height = 255
Left = 4320
TabIndex = 2
Top = 915
Width = 1335
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "1"
BeginProperty Font
Name = "微软雅黑"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000014&
Height = 255
Left = 4200
TabIndex = 1
Top = 2640
Width = 615
End
Begin VB.Line Line4
X1 = 240
X2 = 4080
Y1 = 2640
Y2 = 2640
End
Begin VB.Line Line3
X1 = 240
X2 = 4080
Y1 = 2880
Y2 = 2880
End
Begin VB.Line Line2
X1 = 240
X2 = 240
Y1 = 2640
Y2 = 2880
End
Begin VB.Line Line1
X1 = 4080
X2 = 4080
Y1 = 2640
Y2 = 2880
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H80000018&
BeginProperty Font
Name = "微软雅黑"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 0
Top = 2640
Width = 3855
End
Begin VB.Image Image1
Height = 3960
Left = 0
Picture = "Form10.frx":0000
Stretch = -1 'True
Top = 0
Width = 6015
End
End
Attribute VB_Name = "Form10"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'用于将CreateRoundRectRgn创建的圆角区域赋给窗体
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
'用于创建一个圆角矩形，该矩形由X1，Y1-X2，Y2确定，并由X3，Y3确定的椭圆描述圆角弧度。
'参数 类型及说明：
'X1,Y1 Long，矩形左上角的X，Y坐标
'X2,Y2 Long，矩形右下角的X，Y坐标
'X3 Long，圆角椭圆的宽。其范围从0（没有圆角）到矩形宽（全圆）
'Y3 Long，圆角椭圆的高。其范围从0（没有圆角）到矩形高（全圆）
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 Const HWND_TOPMOST& = -1
' 将窗口置于列表顶部，并位于任何最顶部窗口的前面
Const HWND_NOTOPMOST = -2 '取消最上层设定
Private Const SWP_NOSIZE& = &H1
' 保持窗口大小
Private Const SWP_NOMOVE& = &H2
' 保持窗口位置
'将CreateRoundRectRgn创建的区域删除，这是必要的，否则不必要的占用电脑内存
'接下来声明一个全局变量,用来获得区域句柄
Private Sub Form_Activate() '窗体Activate()事件
Call rgnform(Me, 70, 70) '调用子过程
End Sub
Private Sub rgnform(ByVal frmbox As Form, ByVal fw As Long, ByVal fh As Long) '子过程，改变参数fw和fh的值可实现圆角
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_Load()
Label3.Caption = "v" & App.Major & "." & App.Minor & "." & App.Revision
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体Unload事件
DeleteObject outrgn '将圆角区域使用的所有系统资源释放
End Sub
Private Sub Timer1_Timer()
Label2.Caption = Format(Label1.Width / Tw, "0%")
End Sub