发一个下雪代码.docx
- 文档编号:24209983
- 上传时间:2023-05-25
- 格式:DOCX
- 页数:6
- 大小:15.09KB
发一个下雪代码.docx
《发一个下雪代码.docx》由会员分享,可在线阅读,更多相关《发一个下雪代码.docx(6页珍藏版)》请在冰豆网上搜索。
发一个下雪代码
发一个下雪代码
OptionExplicit
'inform1 addtimer
PrivateDeclareFunctionSetPixelLib"gdi32"(ByValhdcAsLong,ByValxAsLong,ByValyAsLong,ByValcrColorAsLong)AsLong
PrivateDeclareFunctionGetWindowDCLib"user32"(ByValhWndAsLong)AsLong
PrivateDeclareSubSleepLib"kernel32"(ByValdwMillisecondsAsLong)
PrivateDeclareFunctionGetPixelLib"gdi32"(ByValhdcAsLong,ByValxAsLong,ByValyAsLong)AsLong
PrivateDeclareFunctionSetPixelVLib"gdi32"(ByValhdcAsLong,ByValxAsLong,ByValyAsLong,ByValcrColorAsLong)AsLong
PrivateDeclareFunctionRedrawWindowLib"user32"(ByValhWndAsLong,lprcUpdateAsAny,ByValhrgnUpdateAsLong,ByValfuRedrawAsLong)AsLong
PrivateDeclareFunctionCreateEllipticRgnLib"gdi32"(ByValX1AsLong,ByValY1AsLong,ByValX2AsLong,ByValY2AsLong)AsLong
PrivateDeclareFunctionSetWindowRgnLib"user32"(ByValhWndAsLong,ByValhRgnAsLong,ByValbRedrawAsBoolean)AsLong
PrivateConstSNOW_MAX&=100
PrivateConstFALL_SPEED&=3
PrivateConstCOLOR_DIFF=100
DimScreenDC&,ScreenW&,ScreenH&
DimSnow&(SNOW_MAX,1),Last&(SNOW_MAX)
DimmlFrmWidthAsLong
DimmlFrmHeightAsLong
DimlbExitAsBoolean
PrivateSubForm_Click()
lbExit=True
EndSub
PrivateSubForm_Load()
' DimCERAsLong
' CER=CreateEllipticRgn(35,10,300,200)
' CallSetWindowRgn(Me.hWnd,CER,True)
mlFrmWidth=Width
mlFrmHeight=Height
lbExit=False
Timer1.Interval=100
Timer1.Enabled=True
EndSub
PrivateSubNewSnow(i&)
Snow(i,0)=Rnd*ScreenW
Snow(i,1)=0
Last(i)=GetPixel(ScreenDC,Snow(i,0),0)
EndSub
PrivateFunctionColorDec(Color1&,Color2&)AsLong
DimR1%,G1%,B1%
DimR2%,G2%,B2%
GetRGBColor1,R1,G1,B1
GetRGBColor2,R2,G2,B2
ColorDec=Abs(R1-R2)+Abs(G1-G2)+Abs(B1-B2)
EndFunction
PrivateSubGetRGB(ByValColor&,ByRefr%,ByRefg%,ByRefb%)
r=(ColorMod256)
b=(Int(Color\65536))
g=((Color-(b*65536)-r)\256)
EndSub
PrivateSubForm_Resize()
IfWindowState<>1Then
Width=mlFrmWidth
Height=mlFrmHeight
EndIf
EndSub
PrivateSubForm_Unload(CancelAsInteger)
lbExit=True
EraseSnow
EraseLast
RedrawWindowScreenDC,ByVal0,ByVal0,&H1
SetForm1=Nothing
EndSub
PrivateSubTimer1_Timer()
DimllCountAsLong
Timer1.Enabled=False
Dimi AsLong,kAsLong
DimlPicAsLong
DimllColorAsLong
ScreenDC=GetWindowDC(0)
ScreenW=Screen.Width/Screen.TwipsPerPixelX
ScreenH=Screen.Height/Screen.TwipsPerPixelY
Randomize
Fori=0ToSNOW_MAX
NewSnowi
Next
OnErrorResumeNext
Do
' IfllCountMod20=0Then
' llColor=RGB(Rnd*255,Rnd*255,Rnd*255)
' Label1.ForeColor=llColor
' Label2.ForeColor=llColor
' Label3.ForeColor=llColor
' EndIf
' llCount=llCount+1
ForlPic=0To7
Fori=0ToSNOW_MAX
SetPixelScreenDC,Snow(i,0)+1,Snow(i,1)+1,Last(i)
SetPixelScreenDC,Snow(i,0)+1,Snow(i,1),Last(i)
SetPixelScreenDC,Snow(i,0),Snow(i,1)+1,Last(i)
SetPixelScreenDC,Snow(i,0)-1,Snow(i,1)+1,Last(i)
SetPixelScreenDC,Snow(i,0)+1,Snow(i,1)+1,Last(i)
SetPixelScreenDC,Snow(i,0),Snow(i,1),Last(i)
SetPixelScreenDC,Snow(i,0)-1,Snow(i,1)-1,Last(i)
SetPixelScreenDC,Snow(i,0)-1,Snow(i,1),Last(i)
SetPixelScreenDC,Snow(i,0),Snow(i,1)-1,Last(i)
Snow(i,0)=Snow(i,0)+Rnd*FALL_SPEED-FALL_SPEED/2'左右随机偏转
Snow(i,1)=Snow(i,1)+Rnd*FALL_SPEED'下落
IfSnow(i,0)<0OrSnow(i,0)>ScreenWOrSnow(i,1)>ScreenHThen
NewSnowi
Else
k=Last(i)
Last(i)=GetPixel(ScreenDC,Snow(i,0),Snow(i,1))
SetPixelScreenDC,Snow(i,0)+1,Snow(i,1)+1,vbWhite
SetPixelScreenDC,Snow(i,0)+1,Snow(i,1),vbWhite
SetPixelScreenDC,Snow(i,0),Snow(i,1)+1,vbWhite
SetPixelScreenDC,Snow(i,0)-1,Snow(i,1)+1,vbWhite
SetPixelScreenDC,Snow(i,0)+1,Snow(i,1)+1,vbWhite
SetPixelScreenDC,Snow(i,0),Snow(i,1),vbWhite
SetPixelScreenDC,Snow(i,0)-1,Snow(i,1)-1,vbWhite
SetPixelScreenDC,Snow(i,0)-1,Snow(i,1),vbWhite
IfRnd*3<1AndColorDec(k,Last(i))>COLOR_DIFFThenNewSnowi
EndIf
Next
IflbExit=TrueThenExitDo
Sleep20
DoEvents
Picture=Picture1(lPic).Picture
Next
Loop
UnloadMe
EndSub
金融资讯,投资理财,布谷
hhhttyymmm800666
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 一个 下雪 代码