📄 test改进.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form TestOCX_new
BackColor = &H00D8E9EC&
BorderStyle = 0 'None
Caption = "VB换肤控件"
ClientHeight = 6450
ClientLeft = 0
ClientTop = 0
ClientWidth = 10395
ForeColor = &H00000000&
Icon = "test改进.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6450
ScaleWidth = 10395
StartUpPosition = 2 '屏幕中心
Begin Project1.JSBORDER JSBORDER2
Align = 4 'Align Right
Height = 5940
Left = 10290
TabIndex = 4
Top = 405
Width = 105
_ExtentX = 185
_ExtentY = 25400
BORDERTYPE = 2
End
Begin Project1.JSBORDER JSBORDER3
Align = 2 'Align Bottom
Height = 105
Left = 0
TabIndex = 5
Top = 6345
Width = 10395
_ExtentX = 33867
_ExtentY = 185
BORDERTYPE = 3
End
Begin Project1.JSCAPTION JSCAPTION1
Align = 1 'Align Top
Height = 405
Left = 0
TabIndex = 3
Top = 0
Width = 10395
_ExtentX = 18336
_ExtentY = 714
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = 14450266
End
Begin Project1.JSBORDER JSBORDER1
Align = 3 'Align Left
Height = 5940
Left = 0
TabIndex = 2
Top = 405
Width = 105
_ExtentX = 185
_ExtentY = 25400
BORDERTYPE = 1
End
Begin VB.CommandButton Command4
Caption = "自选皮肤"
Height = 435
Left = 750
TabIndex = 1
Top = 1740
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "Luna XP 皮肤"
Height = 435
Left = 750
TabIndex = 0
Top = 1200
Width = 1335
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 2160
Top = 1740
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Line Line1
BorderColor = &H00FF0000&
X1 = 270
X2 = 3180
Y1 = 780
Y2 = 780
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "阿英工作室 http://www.aying7.com"
ForeColor = &H00FF0000&
Height = 180
Left = 300
TabIndex = 6
Top = 540
Width = 2880
End
End
Attribute VB_Name = "TestOCX_new"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'此源码是我以前在一家德文网站下载的，我汉化了窗体编辑器，并改动源码支付窗体圆角，最大化窗体不会覆盖任务栏，并自做了22个窗体皮肤。
'此源码改动的很乱，是我刚学VB做的，如看不太懂，请见谅。
'我的网站：阿英工作室 http://www.aying7.com
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOW = 5
'以上为超链接API函数
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode 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 Sub Command1_Click()
Me.JSCAPTION1.Path = App.Path & "\2.jss"
Me.JSBORDER1.Path = App.Path & "\2.jss"
Me.JSBORDER2.Path = App.Path & "\2.jss"
Me.JSBORDER3.Path = App.Path & "\2.jss"
Me.JSCAPTION1.REDRAW
End Sub
Private Sub Command4_Click()
'Dim varTemp As Variant
' Dim byteArr() As Byte
'On Error Resume Next
' Set pb = New PropertyBag
CommonDialog1.Filter = "皮肤 (*.jss)|*.jss"
CommonDialog1.ShowOpen
' Open CommonDialog1.FileName For Binary As #1
' Get #1, , varTemp
' Close #1
' Me.Caption = Me.Caption + " " & CommonDialog1.FileName
'byteArr = varTemp
' pb.Contents = byteArr
Me.JSCAPTION1.Path = CommonDialog1.FileName
Me.JSBORDER1.Path = CommonDialog1.FileName
Me.JSBORDER2.Path = CommonDialog1.FileName
Me.JSBORDER3.Path = CommonDialog1.FileName
Me.JSCAPTION1.REDRAW
End Sub
Private Sub Form_Load()
Me.JSCAPTION1.Path = App.Path & "\18.jss"
Me.JSBORDER1.Path = App.Path & "\18.jss"
Me.JSBORDER2.Path = App.Path & "\18.jss"
Me.JSBORDER3.Path = App.Path & "\18.jss"
End Sub
Private Sub Form_Resize()
If JSCAPTION1.Style2 = dig1 Then '最大化时边线不要
JSBORDER1.Visible = False
JSBORDER2.Visible = False
JSBORDER3.Visible = False
Else
JSBORDER1.Visible = True
JSBORDER2.Visible = True
JSBORDER3.Visible = True
End If '最大化时边线不要
Call CornerEdit '圆角处理
If JSCAPTION1.Style2 = dig2 Then '最小大化时不要，控制尺寸
If Me.Width <= 4444 Then Me.Width = 4444
If Me.Height <= 2222 Then Me.Height = 2222
End If
End Sub
Private Sub CornerEdit()
Dim XY(6) As POINTAPI
Dim hRgn As Long
With Me
XY(0).x = 0
XY(0).y = .Height / 15
XY(1).x = 0
XY(1).y = 3 '60 / 15
XY(2).x = 45 / 15
XY(2).y = 0
XY(3).x = (.Width - 45) / 15
XY(3).y = 0
XY(4).x = .Width / 15
XY(4).y = 60 / 15
XY(5).x = .Width / 15
XY(5).y = .Height / 15
XY(6).x = 0
XY(6).y = .Height / 15
End With
hRgn = CreatePolygonRgn(XY(0), 7, 2)
If JSCAPTION1.Style2 = dig2 Then
Call SetWindowRgn(Me.hwnd, hRgn, True) '圆角处理
Else
Call SetWindowRgn(Me.hwnd, 0, True) '最大化不处理
End If
End Sub
Private Sub Label1_Click()
Call ShellExecute(Me.hwnd, "open", "http://www.aying7.com", "", "", SW_SHOW)
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, WCAPTION, 0&
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -