home *** CD-ROM | disk | FTP | other *** search
/ PC Users 1998 June / Cd Pc Users 9.iso / prog / inst / fade / fade.bas next >
Encoding:
BASIC Source File  |  1996-11-20  |  4.6 KB  |  127 lines
  1. Attribute VB_Name = "mod_Fade"
  2. Public Const FADE_T_TO_B = 0
  3. Public Const FADE_B_TO_T = 1
  4. Public Const FADE_L_TO_R = 2
  5. Public Const FADE_R_TO_L = 3
  6. Public Const FADE_RANDOM = 4
  7. Public Const FADE_OUTWARD = 5
  8.  
  9. Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  10. Sub Fade(Pic As PictureBox, Style As Integer, Blocks As Integer)
  11.     
  12.     Dim width_section_size As Integer
  13.     Dim height_section_size As Integer
  14.     Dim i As Integer, j As Integer
  15.     Dim save_color As Long
  16.     
  17.     'Saves the picbox's current forecolor
  18.     save_color = Pic.ForeColor
  19.  
  20.     'Set Pics forecolor to its backcolor
  21.     Pic.ForeColor = Pic.BackColor
  22.  
  23.     'Corrects the Blocks if needed
  24.     If Blocks < 5 Then Blocks = 5
  25.     If Blocks > 100 Then Blocks = 100
  26.  
  27.     'Sets the size of each width section
  28.     width_section_size = Pic.ScaleWidth / Blocks
  29.  
  30.     'Sets the size of each height section
  31.     height_section_size = Pic.ScaleHeight / Blocks
  32.  
  33.  
  34.     Select Case Style
  35.        '-------------------------------------------------------------------------------------
  36.        Case 0  'Fading top to bottom
  37.           
  38.           For i = 0 To Blocks
  39.              For j = 0 To Blocks
  40.                 Pic.Line ((j * width_section_size), (i * height_section_size))-((j + 1) * width_section_size, (i + 1) * height_section_size), , BF
  41.                 DoEvents
  42.              Next
  43.              DoEvents
  44.           Next
  45.        '-------------------------------------------------------------------------------------
  46.        Case 1  'Fading bottom to top
  47.           
  48.           For i = Blocks To 0 Step -1
  49.              For j = 0 To Blocks
  50.                 Pic.Line (((j - 1) * width_section_size), ((i - 1) * height_section_size))-(j * width_section_size, i * height_section_size), , BF
  51.                 DoEvents
  52.              Next
  53.              DoEvents
  54.           Next
  55.        '-------------------------------------------------------------------------------------
  56.        Case 2  'Fading left to right
  57.           
  58.           For i = 0 To Blocks
  59.              For j = 0 To Blocks
  60.                 Pic.Line ((i * width_section_size), (j * height_section_size))-((i + 1) * width_section_size, (j + 1) * height_section_size), , BF
  61.                 DoEvents
  62.              Next
  63.              DoEvents
  64.           Next
  65.        '-------------------------------------------------------------------------------------
  66.        Case 3  'Fading right to left
  67.           
  68.           For i = Blocks To 0 Step -1
  69.              For j = 0 To Blocks
  70.                 Pic.Line (((i - 1) * width_section_size), (j * height_section_size))-(i * width_section_size, (j + 1) * height_section_size), , BF
  71.                 DoEvents
  72.              Next
  73.              DoEvents
  74.           Next
  75.        '-------------------------------------------------------------------------------------
  76.        Case 4  'Fading Random
  77.        
  78.           Dim bit_array() As Byte
  79.           ReDim bit_array(Blocks, Blocks)
  80.               
  81.           Dim counter As Integer
  82.        
  83.           Do
  84.              Do
  85.                 width_next_block = Int(Blocks * Rnd) 'Generate the random numbers
  86.                 height_next_block = Int(Blocks * Rnd) 'Generate the random numbers
  87.                 'MsgBox bit_array(width_next_block, height_next_block)
  88.                 If bit_array(width_next_block, height_next_block) = 0 Then
  89.                   Exit Do
  90.                 End If
  91.                 counter = counter + 1
  92.                 If counter = Blocks * 10 Then Exit Do
  93.              Loop
  94.              
  95.              If counter = Blocks * 10 Then Exit Do
  96.              counter = 0
  97.           
  98.              'Update the bit_array
  99.              bit_array(width_next_block, height_next_block) = 1
  100.           
  101.     
  102.               
  103.              Pic.Line ((width_next_block * width_section_size), (height_next_block * height_section_size))-((width_next_block + 1) * width_section_size, (height_next_block + 1) * height_section_size), , BF
  104.           
  105.              DoEvents
  106.           Loop
  107.           
  108.           Pic.Line (0, 0)-(Pic.ScaleWidth, Pic.ScaleHeight), , BF
  109.   
  110.        '-------------------------------------------------------------------------------------
  111.        Case 5 'Fading Outward
  112.        
  113.           For i = (Blocks / 2) To 0 Step -1
  114.              Sleep (20)
  115.              Pic.Line (i * width_section_size, i * height_section_size)-(((Blocks - i) + 1) * width_section_size, ((Blocks - i) + 1) * height_section_size), , BF
  116.           Next
  117.           
  118.        '-------------------------------------------------------------------------------------
  119.     End Select
  120.  
  121.     'Restores the picbox's original forecolor        
  122.     Pic.ForeColor = save_color
  123.         
  124. End Sub
  125.  
  126.  
  127.