用VB实现一个小星星屏保

用VB实现一个小星星屏保

直接上代码

Private W As Integer
Private H As Integer
Private Type Stars
 X As Double
 Y As Integer
 AddX As Integer
 AddY As Integer
End Type

Private Star(1000) As Stars
Private Accelarate As Boolean

Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private WithEvents Timer1 As Timer

Private Sub Form_Activate()
MoveTo = move_forward
Accelarate = False
WindowState = 2
W = ScaleWidth
H = ScaleHeight
 
 For i = 1 To 150
  
  
  Star(i).X = W / 2
  Star(i).Y = H / 2
RandomX:
  Randomize
  Star(i).AddX = Int(Rnd * 29) - Int(Rnd * 29)
  If Star(i).AddX = 0 Then GoTo RandomX
RandomY:
  Star(i).AddY = Int(Rnd * 19) - Int(Rnd * 19)
  If Star(i).AddY = 0 Then GoTo RandomY
 
 Next
End Sub

Private Sub Form_Load()
Me.BorderStyle = 0
Me.Caption = ""
Me.DrawWidth = 5
Me.BackColor = &H0&
Me.FillColor = &HFFFFFF
Me.ScaleMode = 3
Set Timer1 = Me.Controls.Add("VB.timer", "timer1")
Timer1.Enabled = True
Timer1.Interval = 10
Move Screen.Width / 2 - Width / 2, Screen.Height / 2 - Height / 2
End Sub

Private Sub Timer1_Timer()

For i = 1 To 150
 
 SetPixel hdc, W / 2, H / 2, &H404040
 
 Select Case Abs(W / 2 - (Star(i).X))
  Case Is < 20
   col = &H0&
   Size = 1
  Case Is < 80
   col = &H404040
   Size = 1
  Case Is < 150
   col = &H808080
   Size = 2
  Case Is < 200
   col = &HC0C0C0
   Size = 3
  Case Is < 250
   col = &HFFFFFF
   Size = 4
  Case Else
   col = &HFFFFFF
   Size = 5

 End Select


 Select Case Abs(H / 2 - (Star(i).Y))

  Case Is < 20
   If Size = 0 Then
    Size = 1
    col = back5
   End If
  Case Is < 80
   If Size = 0 Then
    col = &H404040
    Size = 1
   End If
  Case Is < 150
   If Size < 2 Then
    Size = 2
    col = &H808080
   End If
  Case Is < 200
   If Size < 3 Then
    Size = 3
    col = &HC0C0C0
   End If
  Case Is < 250
   If Size < 4 Then
    Size = 4
    col = &HFFFFFF
   End If
  Case Else
   If Size < 5 Then
    Size = 5
    col = &HFFFFFF
   End If
 
 End Select


SetPixel hdc, W / 2, H / 2, col

Select Case Size
 Case 1
  SetPixel Me.hdc, Star(i).X, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y + Star(i).AddY, col
 Case 2
  SetPixel Me.hdc, Star(i).X, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X - 1, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y + Star(i).AddY, col
 Case 3
  SetPixel Me.hdc, Star(i).X, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X - 1, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X - 1, Star(i).Y - 1, &H0&
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y - 1 + Star(i).AddY, col
 Case 4
  SetPixel Me.hdc, Star(i).X, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X - 1, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X - 1, Star(i).Y - 1, &H0&

  SetPixel Me.hdc, Star(i).X, Star(i).Y - 1, &H0&
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y - 1 + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y - 1 + Star(i).AddY, col
 Case 5
  SetPixel Me.hdc, Star(i).X + a, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X - 1 + a, Star(i).Y, &H0&
  SetPixel Me.hdc, Star(i).X - 1 + a, Star(i).Y - 1, &H0&
  SetPixel Me.hdc, Star(i).X + a, Star(i).Y - 1, &H0&
  SetPixel Me.hdc, Star(i).X + a, Star(i).Y - 2, &H0&
  SetPixel Me.hdc, Star(i).X - 1 + a, Star(i).Y - 2, &H0&
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y - 1 + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y - 1 + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X + Star(i).AddX, Star(i).Y - 2 + Star(i).AddY, col
  SetPixel Me.hdc, Star(i).X - 1 + Star(i).AddX, Star(i).Y - 2 + Star(i).AddY, col
End Select


Star(i).X = Star(i).X + Star(i).AddX
Star(i).Y = Star(i).Y + Star(i).AddY
Star(i).AddX = Star(i).AddX + Sgn(Star(i).AddX) * (Size / 5)
Star(i).AddY = Star(i).AddY + Sgn(Star(i).AddY) * (Size / 5)
If Accelarate Then
 Star(i).AddX = Star(i).AddX + Sgn(Star(i).AddX) * Size
 Star(i).AddY = Star(i).AddY + Sgn(Star(i).AddY) * Size
End If

If Star(i).X < 0 Or Star(i).X > ScaleWidth Or Star(i).Y < 0 Or Star(i).Y > ScaleHeight Then
  Star(i).X = W / 2
  Star(i).Y = H / 2
RandomX:
  Randomize
  Star(i).AddX = Int(Rnd * 29) - Int(Rnd * 29)
  If Star(i).AddX = 0 Then GoTo RandomX
RandomY:
  Star(i).AddY = Int(Rnd * 19) - Int(Rnd * 19)
  If Star(i).AddY = 0 Then GoTo RandomY
End If

Next

End Sub

原创文章,作者:Rosmontics,如若转载,请注明出处:https://rosmontis.com/archives/53

(0)
RosmonticsRosmontics网站管理员
上一篇 2021年7月25日 下午7:46
下一篇 2021年7月25日 下午9:21

相关推荐

  • 如何让VB程序自动默认以管理员权限运行

    虽然说VB已经渐渐退出我们的日常生活中,逐渐成为过去产物,但是对于编程初学者来说,还是一种非常通俗易懂,便捷的语言,特别是在界面UI设计上不需要编写大量代码,直接可视化操作,非常爽。在此记录一些曾经写过的一些VB代码,希望对自己以及看到这篇文章的人能够有启发

    2021年10月25日
  • VB中实现文字滚动(Lable水平移动)

    虽然说VB已经渐渐退出我们的日常生活中,逐渐成为过去产物,但是对于编程初学者来说,还是一种非常通俗易懂,便捷的语言,特别是在界面UI设计上不需要编写大量代码,直接可视化操作,非常爽。在此记录一些曾经写过的一些VB代码,希望对自己以及看到这篇文章的人能够有启发

    Visual Basic 2021年10月25日
  • 用VB实现迅雷地址解密

    用VB实现迅雷地址解密

    Visual Basic 2021年7月23日
  • VB中实现字体自动循环变色

    虽然说VB已经渐渐退出我们的日常生活中,逐渐成为过去产物,但是对于编程初学者来说,还是一种非常通俗易懂,便捷的语言,特别是在界面UI设计上不需要编写大量代码,直接可视化操作,非常爽。在此记录一些曾经写过的一些VB代码,希望对自己以及看到这篇文章的人能够有启发

    2021年10月25日
  • ocx stock 最实用的54个OCX(ActiveX)控件!

    ocx stock,最实用的54个ocx(activex)控件!

    2021年6月11日
  • VB实现强制关闭360安全卫士

    虽然说VB已经渐渐退出我们的日常生活中,逐渐成为过去产物,但是对于编程初学者来说,还是一种非常通俗易懂,便捷的语言,特别是在界面UI设计上不需要编写大量代码,直接可视化操作,非常爽。在此记录一些曾经写过的一些VB代码,希望对自己以及看到这篇文章的人能够有启发

    Visual Basic 2021年10月25日
  • VB修改全盘程序图标(病毒制作)

    虽然说VB已经渐渐退出我们的日常生活中,逐渐成为过去产物,但是对于编程初学者来说,还是一种非常通俗易懂,便捷的语言,特别是在界面UI设计上不需要编写大量代码,直接可视化操作,非常爽。在此记录一些曾经写过的一些VB代码,希望对自己以及看到这篇文章的人能够有启发

    Visual Basic 2021年10月25日

发表回复

您的邮箱地址不会被公开。 必填项已用 * 标注

评论审核已启用。您的评论可能需要一段时间后才能被显示。