home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dosver1r / form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-08-13  |  4.5 KB  |  153 lines
  1. VERSION 5.00
  2. Begin VB.Form StarfieldExamples 
  3.    BackColor       =   &H80000008&
  4.    ClientHeight    =   7785
  5.    ClientLeft      =   165
  6.    ClientTop       =   735
  7.    ClientWidth     =   10590
  8.    KeyPreview      =   -1  'True
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   519
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   706
  13.    StartUpPosition =   3  'Windows Default
  14.    WindowState     =   2  'Maximized
  15.    Begin VB.PictureBox Background 
  16.       AutoRedraw      =   -1  'True
  17.       AutoSize        =   -1  'True
  18.       BackColor       =   &H00000000&
  19.       BorderStyle     =   0  'None
  20.       Height          =   7815
  21.       Left            =   0
  22.       ScaleHeight     =   521
  23.       ScaleMode       =   3  'Pixel
  24.       ScaleWidth      =   705
  25.       TabIndex        =   0
  26.       Top             =   0
  27.       Width           =   10575
  28.    End
  29.    Begin VB.Menu mnuOptions 
  30.       Caption         =   "Options"
  31.       Begin VB.Menu mnuBlackhole 
  32.          Caption         =   "Black hole"
  33.       End
  34.       Begin VB.Menu mnuSnow 
  35.          Caption         =   "Snow"
  36.          Checked         =   -1  'True
  37.       End
  38.       Begin VB.Menu mnuStars 
  39.          Caption         =   "Stars"
  40.       End
  41.       Begin VB.Menu mnuline1 
  42.          Caption         =   "-"
  43.       End
  44.       Begin VB.Menu mnuRun 
  45.          Caption         =   "Run"
  46.       End
  47.       Begin VB.Menu mnuline2 
  48.          Caption         =   "-"
  49.       End
  50.       Begin VB.Menu mnuQuit 
  51.          Caption         =   "Quit"
  52.       End
  53.    End
  54. Attribute VB_Name = "StarfieldExamples"
  55. Attribute VB_GlobalNameSpace = False
  56. Attribute VB_Creatable = False
  57. Attribute VB_PredeclaredId = True
  58. Attribute VB_Exposed = False
  59. 'turn off control box on the form settings for full screen
  60. Dim Quit As Byte
  61. Dim i As Integer
  62. Dim ActionMode As String
  63. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  64. Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
  65. Private Sub Background_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  66.     SpecialEffectX = x 'tempInt
  67.     SpecialEffectY = Y 'tempInt
  68. End Sub
  69. Private Sub Form_Activate()
  70.   'ShowCursor False
  71.   Dim MyValue As Byte, x
  72.   Randomize
  73.   MyValue = Int((3 * Rnd) + 1)
  74.   Select Case MyValue
  75.     Case 1
  76.     mnuSnow_Click
  77.     Case 2
  78.     mnuStars_Click
  79.     Case 3
  80.     mnuBlackhole_Click
  81.   End Select
  82.   mnuRun_Click
  83.   Do While ActionMode = "OK" Or ActionMode = "Running"
  84.     Do While ActionMode = "Running"
  85.       Background = LoadPicture ' clear the background
  86.       For i = 0 To StarCount
  87.         NextStarPosition i, Background.Height, Background.Width
  88.         SetPixel Background.hdc, Star(i).StarX, Star(i).StarY + Star(i).SpeedY, QBColor(Star(i).StarColor)
  89.       Next i
  90.       Background.Refresh
  91.       DoEvents
  92.     Loop
  93.     DoEvents
  94.   Loop
  95. ShowCursor True
  96.   Unload Me
  97. End Sub
  98. Private Sub Form_KeyPress(KeyAscii As Integer)
  99.   ActionMode = "Out of here"
  100. End Sub
  101. Private Sub Form_Load()
  102.   SpecialEffectX = StarfieldExamples.ScaleWidth / 2
  103.   SpecialEffectY = StarfieldExamples.ScaleHeight / 2
  104. End Sub
  105. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  106.   ActionMode = "Out of here"
  107. End Sub
  108. Private Sub Form_Resize()
  109. Background.Height = StarfieldExamples.ScaleHeight
  110. Background.Width = StarfieldExamples.ScaleWidth
  111. StarSetup Background.Height, Background.Width
  112. End Sub
  113. Private Sub mnuBlackhole_Click()
  114.   Status = "Black Hole"
  115.   StarSetup Background.Height, Background.Width
  116.   CaptionStatus
  117.   mnuBlackhole.Checked = True
  118. End Sub
  119. Private Sub mnuQuit_Click()
  120.   ActionMode = "Out of here"
  121. End Sub
  122. Private Sub mnuRun_Click()
  123.   If mnuRun.Caption = "Run" Then
  124.     StarCount = 0
  125.     ReDimStars 250
  126.     StarSetup Background.Height, Background.Width
  127.     mnuRun.Caption = "Stop"
  128.     ActionMode = "Running"
  129.     mnuQuit.Enabled = False
  130.   Else
  131.     ActionMode = "OK"
  132.     mnuRun.Caption = "Run"
  133.     mnuQuit.Enabled = True
  134.   End If
  135. End Sub
  136. Private Sub mnuSnow_Click()
  137.   Status = "Snow"
  138.   StarSetup Background.Height, Background.Width
  139.   CaptionStatus
  140.   mnuSnow.Checked = True
  141. End Sub
  142. Private Sub mnuStars_Click()
  143.   Status = "Stars"
  144.   StarSetup Background.Height, Background.Width
  145.   CaptionStatus
  146.   mnuStars.Checked = True
  147. End Sub
  148. Sub CaptionStatus()
  149.   mnuSnow.Checked = False
  150.   mnuStars.Checked = False
  151.   mnuBlackhole.Checked = False
  152. End Sub
  153.