vb简单代码画漂亮窗体.docx
- 文档编号:5575261
- 上传时间:2023-05-08
- 格式:DOCX
- 页数:29
- 大小:39.15KB
vb简单代码画漂亮窗体.docx
《vb简单代码画漂亮窗体.docx》由会员分享,可在线阅读,更多相关《vb简单代码画漂亮窗体.docx(29页珍藏版)》请在冰点文库上搜索。
vb简单代码画漂亮窗体
OptionExplicit
'工程名:
VB实现漂亮的用户登录界面,
'作者:
QQ:
659354953来水美树
'本人自学VB将近1年之久,小学学历,就因为学历太低,而且又是一个人自学,所以进步不是很快,
'想通这些代码到网上找一些VB爱好者一起学习,讨论,
'想和我一起学习的就加我QQ吧!
小弟我还有好多不懂的要向各位大哥大姐学习呢?
'
'以下代码不是很完善,两个按扭没写完,但是,还是可以操作的
'代码提供给VB新手朋友作为参考,
'新建工程直接复制代码到窗体模块下即可,无需手动添加任何控件
PrivateTypePOINTAPI
XAsLong
YAsLong
EndType
PrivateTypeRECT
TopAsLong
LeftAsLong
RightAsLong
BottomAsLong
EndType
PrivateEnumDrawColorStyle
[Toptobottom]=0
[lefttoRight]=1
EndEnum
DimCAsBoolean
PrivateDeclareFunctionSendMessage&Lib"user32"Alias"SendMessageA"(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)
PrivateDeclareFunctionCreatePolygonRgnLib"gdi32"(lpPointAsPOINTAPI,ByValnCountAsLong,ByValnPolyFillModeAsLong)AsLong
PrivateDeclareFunctionCreateRectRgnLib"gdi32"(ByValx1AsLong,ByValy1AsLong,ByValx2AsLong,ByValy2AsLong)AsLong
PrivateDeclareFunctionCreateRoundRectRgnLib"gdi32"(ByValx1AsLong,ByValy1AsLong,ByValx2AsLong,ByValy2AsLong,ByValX3AsLong,ByValy3AsLong)AsLong
PrivateDeclareFunctionDeleteObjectLib"gdi32"(ByValhObjectAsLong)AsLong
PrivateDeclareFunctionCreateSolidBrushLib"gdi32"(ByValcrColorAsLong)AsLong
PrivateDeclareFunctionFrameRgnLib"gdi32"(ByValhdcAsLong,ByValhRgnAsLong,ByValhBrushAsLong,ByValnWidthAsLong,ByValnHeightAsLong)AsLong
PrivateDeclareFunctionReleaseCaptureLib"user32"()AsLong
PrivateDeclareFunctionSetCaptureLib"user32"(ByValhwndAsLong)AsLong
PrivateDeclareFunctionSetWindowRgnLib"user32"(ByValhwndAsLong,ByValhRgnAsLong,ByValbRedrawAsBoolean)AsLong
DimWithEventsPicture1AsPictureBox‘声明窗体
DimWithEventsPicture2AsPictureBox‘关闭按扭
DimWithEventsPicture3AsPictureBox‘最小化
DimWithEventsLoadingAsPictureBox‘登录按扭
DimWithEventsCancelAsPictureBox‘取消按扭
DimWithEventsUPAsPictureBox‘文本框边
DimWithEventsPPAsPictureBox‘文本框边
DimUserLaBelAsLabel‘标签
DimPasswordLaBelAsLabel‘标签
DimWithEventsuTextAsTextBox‘帐号文本
DimWithEventsPTextAsTextBox‘密码文本
DimStylAsBoolean
PrivateSubLoadWindow()
DimiAsLong
DimcolorAsLong
DimW,hAsLong
Fori=1To405
color=color+1
Picture1.Line(0,i)-(Picture1.ScaleWidth,i),RGB(0,255,color)‘画出窗体标题栏
Nexti
Picture1.ForeColor=vbBlue
Picture1.FontSize=10
Picture1.CurrentX=200
Picture1.CurrentY=100
Picture1.PrintMe.Caption
Fori=1To25
color=color+1
Picture1.Line(i,0)-(i,Picture1.ScaleHeight),RGB(0,255,color)
Nexti
Fori=Picture1.ScaleWidth-55ToPicture1.ScaleWidth
color=color+1
Picture1.Line(i,0)-(i,Picture1.ScaleHeight),RGB(0,255,color)
Nexti
Fori=Picture1.ScaleHeight-55ToPicture1.ScaleHeight
color=color+1
Picture1.Line(0,i)-(ScaleWidth,i),RGB(0,255,color)
Nexti
DimRgnAsLong
DimBrushAsLong
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)
SetWindowRgnPicture1.hwnd,Rgn,True‘删除窗体上面两个角
DeleteObjectRgn
Brush=CreateSolidBrush(0)
Rgn=CreateRoundRectRgn(0,0,Picture1.ScaleX(Picture1.Width,vbTwips,vbPixels),Picture1.ScaleY(Picture1.Height+200,vbTwips,vbPixels),12,12)
FrameRgnPicture1.hdc,Rgn,Brush,1,1
Picture1.Line(0,Picture1.ScaleHeight-10)-(Picture1.ScaleWidth,Picture1.ScaleHeight-10),0
DeleteObjectRgn
DeleteObjectBrush
Brush=CreateSolidBrush(0)
Rgn=CreateRectRgn(3,27,Picture1.ScaleWidth/15-4,Picture1.ScaleHeight/15-3)
FrameRgnPicture1.hdc,Rgn,Brush,1,1
DeleteObjectRgn
DeleteObjectBrush
EndSub
PrivateSubCommand1_Click()
EndSub
PrivateSubForm_Load()
Me.Width=6680
Me.Height=5580
Me.BackColor=&H808080
Me.Caption="VB画漂亮窗体"
Styl=False
SetPicture1=Me.Controls.Add("vb.picturebox","picture1",Me)
WithPicture1
.Width=4575
.Height=3615
.Left=800
.Top=800
.BorderStyle=0
.Visible=True
EndWith
SetPicture2=Me.Controls.Add("vb.picturebox","picture2",Picture1)
WithPicture2
.Width=300
.Left=Picture1.Width-400
.Height=300
.Top=80
.BorderStyle=0
.Visible=True
EndWith
SetPicture3=Me.Controls.Add("vb.picturebox","picture3",Picture1)
Picture3.Top=80
Picture3.Left=Picture2.Left-320
Picture3.Width=300
Picture3.Height=300
Picture3.BorderStyle=0
Picture3.Visible=True
SetUserLaBel=Me.Controls.Add("vb.Label","uL",Picture1)
WithUserLaBel
.Top=1000
.Left=800
.Caption="用户名(&U):
"
.ForeColor=vbBlue
.Width=1000
.BorderStyle=0
.BackStyle=0
.Visible=True
EndWith
SetPasswordLaBel=Me.Controls.Add("vb.Label","PL",Picture1)
WithPasswordLaBel
.Top=1600
.Left=800
.Caption="密码(&P):
"
.ForeColor=vbBlue
.Width=1000
.BorderStyle=0
.BackStyle=0
.Visible=True
EndWith
SetUP=Me.Controls.Add("vb.picturebox","UP",Picture1)
WithUP
.Visible=True
.Top=930
.Left=1800
.Width=1900
.Height=330
.BorderStyle=0
.BackColor=vbWhite
EndWith
SetuText=Me.Controls.Add("VB.textbox","ut",UP)
WithuText
.Visible=True
.Top=30
.Left=200
.Width=1500
.Height=250
.BorderStyle=0
EndWith
SetPP=Me.Controls.Add("vb.picturebox","PP",Picture1)
WithPP
.Visible=True
.Top=1500
.Left=1800
.Width=1900
.Height=330
.BorderStyle=0
.BackColor=vbWhite
EndWith
SetPText=Me.Controls.Add("VB.textbox","Pt",PP)
WithPText
.Visible=True
.Top=30
.Left=200
.Width=1500
.Height=250
.BorderStyle=0
.PasswordChar="*"
EndWith
SetLoading=Me.Controls.Add("vb.picturebox","Loading1",Picture1)
WithLoading
.Visible=True
.Top=2500
.Left=800
.Width=800
.Height=350
.BorderStyle=0
.Appearance=0
.BackColor=vbWhite
EndWith
SetCancel=Me.Controls.Add("vb.picturebox","Cancel",Picture1)
WithCancel
.Visible=True
.Top=2500
.Left=3000
.Width=800
.Height=350
.BorderStyle=0
.Appearance=0
.BackColor=vbWhite
EndWith
EndSub
PrivateSubForm_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
Styl=False
PP_Paint
EndSub
PrivateSubPicture1_Paint()
LoadWindow
EndSub
PrivateSubDrawcolor(ByValobjectAsObject,ByValcrColor1AsLong,crColor2AsLong,ByValFAsBoolean)
DimW,hAsLong
DimuHAsSingle,uWAsSingle
DimrInfoAsSingle,gInfoAsSingle,bInfoAsSingle
DimrStaAsLong,gStaAsLong,bStaAsLong
DimrEndAsLong,gEndAsLong,bEndAsLong
DimRAsLong,GAsLong,BAsLong,iAsLong
uH=object.ScaleHeight:
uW=object.ScaleWidth
rSta=crColor1Mod256
gSta=crColor1\256Mod256
bSta=crColor1\256\256
rEnd=crColor2Mod256
gEnd=crColor2\256Mod256
bEnd=crColor2\256\256
IfF=TrueThen
rSta=rSta*1.2:
gSta=gSta*1.2:
bSta=bSta*1.2
rEnd=rEnd*1.2:
gEnd=gEnd*1.2:
bEnd=bEnd*1.2
rInfo=(rEnd-rSta)/uH
gInfo=(gEnd-gSta)/uH
bInfo=(bEnd-bSta)/uH
Fori=0TouH-1
R=rSta+i*rInfo
G=gSta+i*gInfo
B=bSta+i*bInfo
object.Line(0,i)-(uW-1,i),RGB(R,G,B)
Nexti
Else
rInfo=(rEnd-rSta)/uH
gInfo=(gEnd-gSta)/uH
bInfo=(bEnd-bSta)/uH
Fori=0TouH-1
R=rSta+i*rInfo
G=gSta+i*gInfo
B=bSta+i*bInfo
object.Line(0,i)-(uW-1,i),RGB(R,G,B)
Nexti
EndIf
EndSub
PrivateSubPicture1_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
ReleaseCapture
SendMessagePicture1.hwnd,&HA1,2,0&‘移动里面的窗体
EndSub
PrivateSubPicture2_Click()
Picture1.Visible=False
EndSub
PrivateSubPicture2_Paint()
DimW,hAsLong
DimRgnAsLong
DimBrushAsLong
DrawcolorPicture2,255,vbWhite,True
W=Picture2.ScaleWidth/Screen.TwipsPerPixelX
h=Picture2.ScaleHeight/Screen.TwipsPerPixelY
Rgn=CreateRoundRectRgn(0,0,W,h,3,3)
SetWindowRgnPicture2.hwnd,Rgn,True
DeleteObjectRgn
Rgn=CreateRoundRectRgn(0,0,W,h,3,3)
Brush=CreateSolidBrush(123)
FrameRgnPicture2.hdc,Rgn,Brush,1,1
DeleteObjectRgn
DeleteObjectBrush
Picture2.DrawWidth=2
Picture2.Line(70,70)-(230,230),&H808080
Picture2.Line(230,70)-(70,230),&H808080
EndSub
PrivateSubPicture3_Paint()
DimW,hAsLong
DimRgnAsLong
DimBrushAsLong
DrawcolorPicture3,&HFF8080,vbWhite,True
W=Picture3.ScaleWidth/Screen.TwipsPerPixelX
h=Picture3.ScaleHeight/Screen.TwipsPerPixelY
Rgn=CreateRoundRectRgn(0,0,W,h,3,3)
SetWindowRgnPicture3.hwnd,Rgn,True
DeleteObjectRgn
Rgn=CreateRoundRectRgn(0,0,W,h,3,3)
Brush=CreateSolidBrush(123)
FrameRgnPicture3.hdc,Rgn,Brush,1,1
DeleteObjectRgn
DeleteObjectBrush
Picture3.DrawWidth=2
Picture3.Line(70,170)-(230,170),&H808080
EndSub
PrivateSubPText_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
DimW,hAsLong
DimRgnAsLong
DimBrushAsLong
W=PP.ScaleWidth/Screen.TwipsPerPixelX
h=PP.ScaleHeight/Screen.TwipsPerPixelY
IfX>=0AndX<=PText.WidthAndY>=0AndY<=PText.HeightThen
Rgn=CreateRoundRectRgn(0,0,W,h,20,20)
Brush=CreateSolidBrush(vbGreen)
FrameRgnPP.hdc,Rgn,Brush,1,1
DeleteObjectRgn
DeleteObjectBrush
SetCapturePText.hwnd
Else
Rgn=CreateRoundRectRgn(0,0,W,h,20,20)
Brush=CreateSolidBrush(&H80FF80)
FrameRgnPP.hdc,Rgn,Brush,1,1
DeleteObjectRgn
DeleteObjectBrush
ReleaseCapture
EndIf
EndSub
PrivateSubUText_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
DimW,hAsLong
DimRgnAsLong
DimBrushAsLong
W=UP.
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- vb 简单 代码 漂亮 窗体