📄 3dstarfield_mainform.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00000000&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 7200
ClientLeft = 0
ClientTop = 0
ClientWidth = 9600
DrawWidth = 5
FillColor = &H00FFFFFF&
FillStyle = 0 'Solid
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 480
ScaleMode = 3 'Pixel
ScaleWidth = 640
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
WindowState = 2 'Maximized
Begin VB.Timer Timer1
Interval = 1
Left = 3165
Top = 465
End
Begin VB.CommandButton Command1
Caption = "3D Starfield Demo"
Height = 855
Left = 3240
TabIndex = 0
Top = 2790
Width = 1800
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Accelarate with Space F1 for some guidelines"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 161
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1305
Left = 2025
TabIndex = 1
Top = 3990
Width = 4290
WordWrap = -1 'True
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private W As Integer
Private H As Integer
Private Sub Command1_Click()
Label1.Visible = False
MoveTo = move_forward
Command1.Visible = False
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_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
End
End If
If KeyCode = vbKeySpace Then Accelarate = True
If KeyCode = vbKeyF1 Then
ChDir App.Path
Shell "NOTEPAD.EXE 3Dstarfield.txt", vbMaximizedFocus
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeySpace Then Accelarate = False
End Sub
Private Sub Form_Load()
Move Screen.Width / 2 - Width / 2, Screen.Height / 2 - Height / 2
Command1.Move ScaleWidth / 2 - Command1.Width / 2, ScaleHeight / 4 - Command1.Height / 2
Label1.Move ScaleWidth / 2 - Label1.Width / 2, ScaleHeight / 2 - Label1.Height / 2
End Sub
Private Sub Timer1_Timer()
If Command1.Visible = True Then Exit Sub
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -