home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / arrays / pixel.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-19  |  5.0 KB  |  124 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00000000&
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   3195
  6.    ClientLeft      =   4110
  7.    ClientTop       =   7260
  8.    ClientWidth     =   4680
  9.    ForeColor       =   &H00FFFFFF&
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   213
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   312
  14.    Begin VB.Timer Timer2 
  15.       Interval        =   10
  16.       Left            =   3480
  17.       Top             =   1920
  18.    End
  19.    Begin VB.Timer Timer1 
  20.       Enabled         =   0   'False
  21.       Interval        =   1
  22.       Left            =   720
  23.       Top             =   2160
  24.    End
  25.    Begin VB.Label Label1 
  26.       BackStyle       =   0  'Transparent
  27.       Caption         =   "Planet Source"
  28.       BeginProperty Font 
  29.          Name            =   "Arial Narrow"
  30.          Size            =   14.25
  31.          Charset         =   0
  32.          Weight          =   700
  33.          Underline       =   0   'False
  34.          Italic          =   -1  'True
  35.          Strikethrough   =   0   'False
  36.       EndProperty
  37.       ForeColor       =   &H000080FF&
  38.       Height          =   270
  39.       Left            =   1080
  40.       TabIndex        =   0
  41.       Top             =   1560
  42.       Width           =   1695
  43.    End
  44. Attribute VB_Name = "Form1"
  45. Attribute VB_GlobalNameSpace = False
  46. Attribute VB_Creatable = False
  47. Attribute VB_PredeclaredId = True
  48. Attribute VB_Exposed = False
  49. Private Sub Form_Load()
  50.    maxx = Label1.Width                          'get label width
  51.    maxy = Label1.Height + (Label1.Height / 2)   'get label height add extra height for flame
  52.    ReDim new_flame(maxx, maxy)                  'resize array to label
  53.    ReDim old_flame(maxx, maxy)
  54. End Sub
  55. Private Sub Timer1_Timer()
  56.   'This is the main timer,  Displays and updates the flame
  57.   Dim X, Y As Integer                           'store current x and y pos.
  58.   Dim red, green, blue As Long                  'store colours
  59.   'This part generates the flame :)
  60.   For X = 1 To maxx - 1
  61.      For Y = 1 To maxy - 1
  62.         red = new_flame(X + 1, Y).r             'Add up the surrounding red colours
  63.         red = red + new_flame(X - 1, Y).r
  64.         red = red + new_flame(X, Y + 1).r
  65.         red = red + new_flame(X, Y - 1).r
  66.         
  67.         green = new_flame(X + 1, Y).g           'Add up the surrounding green colours
  68.         green = green + new_flame(X - 1, Y).g
  69.         green = green + new_flame(X, Y + 1).g
  70.         green = green + new_flame(X, Y - 1).g
  71. '        blue = blue + new_flame(X + 1, Y).b    'Add up the surrounding blue colours
  72. '        blue = blue + new_flame(X - 1, Y).b
  73. '        blue = blue + new_flame(X, Y + 1).b
  74. '        blue = blue + new_flame(X, Y - 1).b
  75.         
  76.         'uses the row above (y-1) to give the effect of moving up!
  77.         If old_flame(X, Y - 1).c = False Then   'if pixel is part of flame update
  78.           tmp = (Rnd * Flame_Height)                      'pick a number from the air!
  79.           old_flame(X, Y - 1).r = red / 4 - (tmp) ' Average the red and decrease the colour
  80.           old_flame(X, Y - 1).g = (green / 4) - (tmp + 8) ' Average the green and decrease the colour
  81. '         old_flame(X, Y - 1).b = blue / 4 ' Average the blue
  82.           If old_flame(X, Y - 1).r < 0 Then old_flame(X, Y - 1).r = 0  'Check colours haven`t gone below 0
  83.           If old_flame(X, Y - 1).g < 0 Then old_flame(X, Y - 1).g = 0
  84. '          If old_flame(X, Y - 1).b < 0 Then old_flame(X, Y - 1).b = 0
  85.         End If
  86.      Next Y
  87.   Next X
  88.   'This loop Displays and updates the array
  89.   For X = 1 To maxx
  90.      For Y = 1 To maxy
  91.         new_flame(X, Y).r = old_flame(X, Y).r     ' update array
  92.         new_flame(X, Y).g = old_flame(X, Y).g
  93. '        new_flame(X, Y).b = old_flame(X, Y).b
  94.         'put the pixel!
  95.         Me.PSet (Label1.Left + X, Label1.Top + Y - Label1.Height / 2), RGB(new_flame(X - 1, Y).r, new_flame(X - 1, Y).g, new_flame(X - 1, Y).b)
  96.      Next Y
  97.   Next X
  98. End Sub
  99. Private Sub Timer2_Timer()
  100.     'This timer only initializes the array colours
  101.     For X = 1 To maxx
  102.      For Y = 1 To maxy
  103.           If Point(Label1.Left + X, Label1.Top + Label1.Height - Y) <> 0 Then ' is there any colour at this point
  104.            new_flame(X, maxy - Y).r = 255   ' Set colour to Yellow
  105.            new_flame(X, maxy - Y).g = 255
  106.            new_flame(X, maxy - Y).b = 0
  107.            new_flame(X, maxy - Y).c = True  ' Is a permenant colour
  108.           Else
  109.            new_flame(X, maxy - Y).r = 0
  110.            new_flame(X, maxy - Y).g = 0
  111.            new_flame(X, maxy - Y).b = 0
  112.            new_flame(X, maxy - Y).c = False ' Can be any colour
  113.           End If
  114.           
  115.           old_flame(X, maxy - Y).r = new_flame(X, maxy - Y).r  'old_flame=new_flame
  116.           old_flame(X, maxy - Y).g = new_flame(X, maxy - Y).g
  117.           old_flame(X, maxy - Y).b = new_flame(X, maxy - Y).b
  118.           old_flame(X, maxy - Y).c = new_flame(X, maxy - Y).c
  119.      Next Y
  120.   Next X
  121.   Timer1.Enabled = True   ' Call the Fire brigade :)
  122.   Timer2.Enabled = False  ' Turn off the taps!
  123. End Sub
  124.