Option Explicit
'工程名:VB实现漂亮的用户登录界面,
'作者:QQ:659354953 来水美树
'本人自学VB将近1年之久,小学学历,就因为学历太低,而且 又是一个人自学,所以进步不是很快,
'想通这些代码到网上一些VB爱好者一起学习,讨论,
'想和我一起学习的就加我QQ吧! ,小弟我还有好多不懂的要向各位大哥大学习呢?
'
'以下代码不是很完善,两个按扭没写完,但是,还是可以操作的
'代码提供给VB新手朋友作为参考,
'新建工程 直接复制代码到窗体模块下即可,无需手动添加任何控件
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Top As Long
Left As Long
Right As Long
Bottom As Long
End Type
Private Enum DrawColorStyle
[Top to bottom] = 0
[left to Right] = 1
End Enum
Dim C As Boolean
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode 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 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 L
ong
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Dim WithEvents Picture1 As PictureBox ‘声明窗体
Dim WithEvents Picture2 As PictureBox ‘关闭按扭
Dim WithEvents Picture3 As PictureBox ‘最小化
Dim WithEvents Loading As PictureBox ‘登录按扭
Dim WithEvents Cancel As PictureBox ‘取消按扭
Dim WithEvents UP As PictureBox ‘文本框边
Dim WithEvents PP As PictureBox ‘文本框边
Dim UserLaBel As Label ‘标签
Dim PasswordLaBel As Label ‘标签
Dim WithEvents uText As TextBox ‘帐号文本
Dim WithEvents PText As TextBox ‘密码文本
Dim Styl As Boolean
Private Sub LoadWindow()
Dim i As Long
Dim color As Long
Dim W, h As Long
For i = 1 To 405
color = color + 1
Picture1.Line (0, i)-(Picture1.ScaleWidth, i), RGB(0, 255, color) ‘画出窗体标题栏
Next i
Picture1.ForeColor = vbBlue
Picture1.FontSize = 10
Picture1.CurrentX = 200
Picture1.CurrentY = 100
Picture1.Print Me.Caption
For i = 1 To 25
color = color + 1
Picture1.Line (i, 0)-(i, Picture1.ScaleHeight), RGB(0, 255, color)
Next i
For i = Picture1.ScaleWidth - 55 To Picture1.ScaleWidth
color = color + 1
Picture1.Line (i, 0)-(i, Picture1.ScaleHeight), RGB(0, 255, color)
Next i
For i = Picture1.ScaleHeight - 55 To Picture1.ScaleHeight
color = color + 1
Picture1.Line (0, i)-(ScaleWidth, i), RGB(0, 255, color)
Next i
Dim Rgn As Long
Dim Brush As Long
W = Picture1.ScaleWidth
h = Picture1.ScaleHeight
Rgn = CreateRoundRectRgn(0, 0, Picture1.ScaleX(Picture1.Width, vbTwips, vbPixels), Picture1.ScaleY(Picture1.Height + 200, vbTwips, vbPixels), 12, 12)
SetWindowRgn Picture1.hwnd, Rgn, True ‘删除窗体上面两个角
DeleteObject Rgn
Brush = CreateSolidBrush(0)
Rgn = CreateRoundRectRgn(0, 0, Picture1.ScaleX(Picture1.Width, vbTwips, vbPixels), Picture1.ScaleY(Picture1.Height + 200, vbTwips, vbPixels), 12, 12)
FrameRgn Picture1.hdc, Rgn, Brush, 1, 1
Picture1.Line (0, Picture1.ScaleHeight - 10)-(Picture1.ScaleWidth, Picture1.ScaleHeight - 10), 0
DeleteObject Rgn
DeleteObject Brush
Brush = CreateSolidBrush(0)
Rgn = CreateRectRgn(3, 27, Picture1.ScaleWidth / 15 - 4, Picture1.ScaleHeight / 15 - 3)
FrameRgn Picture1.hdc, Rgn, Brush, 1, 1
DeleteObject Rgn
DeleteObject Brush
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Form_Load()
Me.Width = 6680
Me.Height = 5580
Me.BackColor = &H808080
Me.Caption = "VB画漂亮窗体"
Styl = False
Set Picture1 = Me.Controls.Add("vb.picturebox", "picture1", Me)
With Picture1
.Width = 4575
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论