2000-05-17 18:10

' DirectX Star Field for Rapid-Q by William Yu

     $APPTYPE GUI
     $TYPECHECK ON
     $INCLUDE "RAPIDQ.INC"

     DECLARE SUB DXTimerExpired
     DECLARE SUB InitStars
     DECLARE SUB KeyDown (Key AS BYTE, Shift AS BYTE)

     CONST MaxStars = 500        '' Depending on your system, adjust as needed.

     TYPE StarType
      X(MaxStars) AS INTEGER
      Y(MaxStars) AS INTEGER
      Z(MaxStars) AS INTEGER
     END TYPE

     DIM DXTimer AS QDXTIMER
     DXTimer.Enabled = True
     DXTimer.Interval = 0
     DXTimer.OnTimer = DXTimerExpired
     DIM Stars AS StarType

     InitStars

     SUB WndProc
     END SUB

     CREATE Form AS QFORM
      Center
      CAPTION = "DirectX Star Field"
      ClientWidth = 640
      ClientHeight = 480
  'BorderStyle = bsNone           '' Setup fullscreen
      CREATE DXScreen AS QDXSCREEN
       Init(640, 480)
       BitCount = 16
       Align = alClient
    'FullScreen = True            '' Fullscreen mode
      END CREATE
      OnKeyDown = KeyDown
      WndProc = WndProc
      SHOWMODAL
     END CREATE


     SUB KeyDown (Key AS BYTE, Shift AS BYTE)
      IF Key = 27 THEN
       Form.CLOSE
      END IF
     END SUB


     SUB InitStars
      DIM I AS INTEGER

      RANDOMIZE TIMER

      FOR I = 1 TO MaxStars
       Stars.X(I) = RND(640)
       Stars.Y(I) = RND(480)
       Stars.Z(I) = RND(3)
      NEXT I
     END SUB

     SUB DXTimerExpired
      DIM I AS INTEGER

      DXScreen.Fill(0)
      FOR I = 1 TO MaxStars
       SELECT CASE Stars.Z(I)
       CASE 0
        'DXScreen.Circle(Stars.X(I),Stars.Y(I),Stars.X(I)+2,Stars.Y(I)+2,clWhite,clWhite)
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = clWhite
        'DXScreen.Pset(Stars.X(I),Stars.Y(I), clWhite)
        Stars.Y(I) = Stars.Y(I) + 3
       CASE 1
        'DXScreen.Circle(Stars.X(I),Stars.Y(I),Stars.X(I)+2,Stars.Y(I)+2,&HAAAAAA,&HAAAAAA)
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = &HAAAAAA
        'DXScreen.Pset(Stars.X(I),Stars.Y(I),&HAAAAAA)
        Stars.Y(I) = Stars.Y(I) + 2
       CASE ELSE
        'DXScreen.Circle(Stars.X(I),Stars.Y(I),Stars.X(I)+2,Stars.Y(I)+2,&H777777,&H777777)
        DXScreen.Pixel(Stars.X(I),Stars.Y(I)) = &H777777
        'DXScreen.Pset(Stars.X(I),Stars.Y(I), &H777777)
        Stars.Y(I) = Stars.Y(I) + 1
       END SELECT
       IF Stars.Y(I) > 480 THEN
        Stars.Y(I) = -1
        Stars.X(I) = RND(640)
       END IF
      NEXT
      DXScreen.TextOut(10,10,"FPS: "+STR$(DXTimer.FrameRate), clWhite, -1)
      DXScreen.Flip
     END SUB

2000-05-17 18:10