home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Water_2D__2163099212009.psc / mainf.frm < prev    next >
Text File  |  2009-09-22  |  12KB  |  432 lines
  1. VERSION 5.00
  2. Begin VB.Form mainf 
  3.    BackColor       =   &H00000000&
  4.    Caption         =   "2D WATER"
  5.    ClientHeight    =   8325
  6.    ClientLeft      =   60
  7.    ClientTop       =   450
  8.    ClientWidth     =   7680
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   555
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   512
  13.    StartUpPosition =   1  'CenterOwner
  14.    Begin VB.CheckBox cSMOOTH 
  15.       BackColor       =   &H00000000&
  16.       Caption         =   "Smoother"
  17.       BeginProperty Font 
  18.          Name            =   "Courier New"
  19.          Size            =   9.75
  20.          Charset         =   0
  21.          Weight          =   400
  22.          Underline       =   0   'False
  23.          Italic          =   0   'False
  24.          Strikethrough   =   0   'False
  25.       EndProperty
  26.       ForeColor       =   &H00C0FFC0&
  27.       Height          =   255
  28.       Left            =   3480
  29.       TabIndex        =   7
  30.       Top             =   960
  31.       Width           =   2175
  32.    End
  33.    Begin VB.TextBox Text1 
  34.       Appearance      =   0  'Flat
  35.       BackColor       =   &H00000000&
  36.       BeginProperty Font 
  37.          Name            =   "Arial"
  38.          Size            =   9
  39.          Charset         =   0
  40.          Weight          =   700
  41.          Underline       =   0   'False
  42.          Italic          =   0   'False
  43.          Strikethrough   =   0   'False
  44.       EndProperty
  45.       ForeColor       =   &H00C0FFC0&
  46.       Height          =   975
  47.       Left            =   3480
  48.       MultiLine       =   -1  'True
  49.       TabIndex        =   6
  50.       Top             =   0
  51.       Width           =   4095
  52.    End
  53.    Begin VB.HScrollBar wDENS 
  54.       Height          =   255
  55.       Left            =   120
  56.       Max             =   1000
  57.       Min             =   950
  58.       TabIndex        =   4
  59.       Top             =   960
  60.       Value           =   982
  61.       Width           =   1935
  62.    End
  63.    Begin VB.HScrollBar rFREQ 
  64.       Height          =   255
  65.       Left            =   120
  66.       Max             =   100
  67.       Min             =   1
  68.       TabIndex        =   3
  69.       Top             =   360
  70.       Value           =   25
  71.       Width           =   1935
  72.    End
  73.    Begin VB.CheckBox chRAIN 
  74.       BackColor       =   &H00000000&
  75.       Caption         =   "Rain     freq"
  76.       BeginProperty Font 
  77.          Name            =   "Courier New"
  78.          Size            =   9.75
  79.          Charset         =   0
  80.          Weight          =   400
  81.          Underline       =   0   'False
  82.          Italic          =   0   'False
  83.          Strikethrough   =   0   'False
  84.       EndProperty
  85.       ForeColor       =   &H00C0FFC0&
  86.       Height          =   255
  87.       Left            =   120
  88.       TabIndex        =   2
  89.       Top             =   120
  90.       Width           =   1935
  91.    End
  92.    Begin VB.CommandButton Command1 
  93.       Caption         =   "START"
  94.       Height          =   855
  95.       Left            =   2520
  96.       TabIndex        =   1
  97.       Top             =   360
  98.       Width           =   855
  99.    End
  100.    Begin VB.PictureBox PIC 
  101.       Appearance      =   0  'Flat
  102.       BackColor       =   &H80000005&
  103.       BorderStyle     =   0  'None
  104.       FillStyle       =   0  'Solid
  105.       ForeColor       =   &H80000008&
  106.       Height          =   6015
  107.       Left            =   120
  108.       ScaleHeight     =   401
  109.       ScaleMode       =   3  'Pixel
  110.       ScaleWidth      =   497
  111.       TabIndex        =   0
  112.       Top             =   1320
  113.       Width           =   7455
  114.    End
  115.    Begin VB.Label Label1 
  116.       BackColor       =   &H00000000&
  117.       Caption         =   "Density"
  118.       BeginProperty Font 
  119.          Name            =   "Courier New"
  120.          Size            =   8.25
  121.          Charset         =   0
  122.          Weight          =   400
  123.          Underline       =   0   'False
  124.          Italic          =   0   'False
  125.          Strikethrough   =   0   'False
  126.       EndProperty
  127.       ForeColor       =   &H00C0FFC0&
  128.       Height          =   255
  129.       Left            =   120
  130.       TabIndex        =   5
  131.       Top             =   720
  132.       Width           =   2295
  133.    End
  134. End
  135. Attribute VB_Name = "mainf"
  136. Attribute VB_GlobalNameSpace = False
  137. Attribute VB_Creatable = False
  138. Attribute VB_PredeclaredId = True
  139. Attribute VB_Exposed = False
  140. 'Author : Roberto Mior
  141. '     reexre@ gmail.com
  142. '
  143. 'If you use source code or part of it please cite the author
  144. '
  145. '
  146. Option Explicit
  147.  
  148. Private P() As Single
  149. Private Pcopia() As Single
  150. Private Enable() As Boolean
  151.  
  152. Private W As Long
  153. Private H As Long
  154. Private x As Long
  155. Private y As Long
  156. Private V As Single
  157. Private C As Long ' zlong
  158.  
  159. Private Buff1 As Long
  160. Private Buff2 As Long
  161.  
  162. Private rX As Long
  163. Private rY As Long
  164. Private rrX As Long
  165. Private rrY As Long
  166.  
  167. Private rON As Boolean
  168.  
  169. Private Krange As Single
  170.  
  171.  
  172. Private Sub Command1_Click()
  173.  
  174. Dim R As Integer
  175. Dim L As Integer
  176.  
  177. Buff1 = 1
  178. Do
  179.     
  180.     Buff1 = 1 - Buff1
  181.     Buff2 = 1 - Buff1
  182.     
  183.     'less smooth
  184.     If cSMOOTH.Value = Unchecked Then
  185.         
  186.         For x = 1 To W - 1
  187.             For y = 1 To H - 1
  188.                 
  189.                 If Enable(x, y) Then
  190.                     
  191.                     P(x, y, Buff1) = (P(x - 1, y, Buff2) + _
  192.                             P(x + 1, y, Buff2) + _
  193.                             P(x, y - 1, Buff2) + _
  194.                             P(x, y + 1, Buff2)) / 2 - P(x, y, Buff1)
  195.                     
  196.                     P(x, y, Buff1) = P(x, y, Buff1) * wDENS / 1000 '0.985
  197.                     
  198.                     V = P(x, y, Buff1)
  199.                     
  200.                     If V < minWH Then V = minWH '- V
  201.                     If V > maxWH Then V = maxWH '- V
  202.                     
  203.                     '                If V <> 128 Then MySetPixel PIC.hdc, x, y, V
  204.                     MySetPixel PIC.hdc, x, y, V
  205.                 Else
  206.                     
  207.                     MySetPixel PIC.hdc, x, y, maxWH
  208.                     
  209.                 End If
  210.                 
  211.                 
  212.             Next y
  213.             
  214.         Next x
  215.     Else ' MORE smooth
  216.         
  217.         For x = 1 To W - 1
  218.             For y = 1 To H - 1
  219.                 
  220.                 If Enable(x, y) Then
  221.                     
  222.                     'more smooth
  223.                     P(x, y, Buff1) = (P(x - 1, y, Buff2) + _
  224.                             P(x + 1, y, Buff2) + _
  225.                             P(x, y - 1, Buff2) + _
  226.                             P(x, y + 1, Buff2) + _
  227.                             P(x - 1, y - 1, Buff2) + _
  228.                             P(x + 1, y - 1, Buff2) + _
  229.                             P(x - 1, y + 1, Buff2) + _
  230.                             P(x + 1, y + 1, Buff2)) / 4 - P(x, y, Buff1)
  231.                     
  232.                     P(x, y, Buff1) = P(x, y, Buff1) * wDENS / 1000 '0.985
  233.                     
  234.                     V = P(x, y, Buff1)
  235.                     
  236.                     If V < minWH Then V = minWH '- V
  237.                     If V > maxWH Then V = maxWH '- V
  238.                     
  239.                     '                If V <> 128 Then MySetPixel PIC.hdc, x, y, V
  240.                     MySetPixel PIC.hdc, x, y, V
  241.                 Else
  242.                     
  243.                     MySetPixel PIC.hdc, x, y, maxWH
  244.                     
  245.                 End If
  246.                 
  247.                 
  248.             Next y
  249.             
  250.         Next x
  251.     End If
  252.     
  253.     DoEvents
  254.     
  255.     '''''''''Rain
  256.     If chRAIN.Value = Checked Then
  257.         If Rnd < rFREQ.Value / 100 Then
  258.             x = Int(Rnd * W)
  259.             y = Int(Rnd * H)
  260.             
  261.             If Enable(x, y) Then P(x, y, Buff2) = P(x, y, Buff2) - maxWH * 0.5 - Rnd * maxWH * 0.5
  262.             If Enable(x + 1, y) Then P(x + 1, y, Buff2) = P(x + 1, y, Buff2) - maxWH * 0.5 - Rnd * maxWH * 0.5
  263.             If Enable(x + 1, y + 1) Then P(x + 1, y + 1, Buff2) = P(x + 1, y + 1, Buff2) - maxWH * 0.5 - Rnd * maxWH * 0.5
  264.             If Enable(x, y + 1) Then P(x, y + 1, Buff2) = P(x, y + 1, Buff2) - maxWH * 0.5 - Rnd * maxWH * 0.5
  265.             
  266.         End If
  267.         
  268.     End If
  269.     ''''''''''''''''''''''''
  270.     
  271.     ''''''
  272.     'rubinetto 'faucet
  273.     If rON Then
  274.         
  275.         R = Rnd * 20
  276.         L = Rnd * 5
  277.         rrX = rX + Int(Cos(R) * L)
  278.         rrY = rY + Int(Sin(R) * L)
  279.         If rrX > 0 And rrX < W - 1 And rrY > 0 And rrY < H - 1 Then
  280.             
  281.             If Enable(rrX, rrY) Then P(rrX, rrY, Buff2) = P(rrX, rrY, Buff2) - maxWH * Rnd * 0.5
  282.             '2*2
  283.             If Enable(rrX + 1, rrY) Then P(rrX + 1, rrY, Buff2) = P(rrX + 1, rrY, Buff2) - maxWH * Rnd * 0.5
  284.             If Enable(rrX, rrY + 1) Then P(rrX, rrY + 1, Buff2) = P(rrX, rrY + 1, Buff2) - maxWH * Rnd * 0.5
  285.             If Enable(rrX + 1, rrY + 1) Then P(rrX + 1, rrY + 1, Buff2) = P(rrX + 1, rrY + 1, Buff2) - maxWH * Rnd * 0.5
  286.             
  287.         End If
  288.         
  289.     End If
  290.     
  291.     
  292. Loop While True
  293.  
  294. End Sub
  295.  
  296. Private Sub Form_Load()
  297. Randomize Timer
  298.  
  299. Dim S As String
  300. S = "Left Mouse Down = jet" & vbCrLf
  301. S = S & "Right Mouse Down inside Pic = Faucet ON" & vbCrLf
  302. S = S & "Right Mouse Down outside Pic = Faucet OFF" & vbCrLf
  303. Text1 = S
  304.  
  305. 'InitBrush 0, 5, 5, 160, 250, 255, minWH, maxWH
  306. InitBrush 2, 2, 160, 170, 250, 255, minWH, maxWH
  307.  
  308. Krange = 255 / (maxWH - minWH)
  309.  
  310. W = (PIC.ScaleWidth - 1) / DIV
  311. H = (PIC.ScaleHeight - 1) / DIV
  312.  
  313. ReDim P(0 To W, 0 To H, 0 To 1)
  314. ReDim Pcopia(0 To W, 0 To H)
  315. ReDim Enable(0 To W, 0 To H)
  316.  
  317. For x = 0 To W
  318.     For y = 0 To H
  319.         
  320.         P(x, y, 1) = 0
  321.         P(x, y, 0) = 0
  322.         
  323.         Enable(x, y) = True
  324.         
  325.         ''BLOCCO quadro
  326.         If Abs(x - (W / 2) + 9) < 33 Then
  327.             If Abs(y - (H / 2) - 5) < 6 Then
  328.                 Enable(x, y) = False
  329.             End If
  330.         End If
  331.         
  332.         'Blocco Tondo
  333.         If Sqr((x - 50) ^ 2 + (y - 25) ^ 2) < 15 Then
  334.             Enable(x, y) = False
  335.         End If
  336.     Next
  337. Next
  338.  
  339. For x = 0 To W
  340.     Enable(x, 0) = False
  341.     Enable(x, H) = False
  342.     If Rnd < 0.5 Then Enable(x, H - 1) = False: If Rnd < 0.5 Then Enable(x, H - 2) = False
  343.     
  344.     P(x, 0, 0) = 0
  345.     P(x, 0, 1) = 0
  346.     P(x, 1, 0) = 0
  347.     P(x, 1, 1) = 0
  348.     P(x, 2, 0) = 0
  349.     P(x, 2, 1) = 0
  350.     
  351. Next
  352. For y = 0 To H
  353.     Enable(0, y) = False
  354.     Enable(W, y) = False
  355. Next
  356.  
  357.  
  358. Enable(75, 75) = False
  359. Enable(75, 77) = False
  360. Enable(75, 79) = False
  361.  
  362. Enable(35, 75) = False
  363. Enable(35, 76) = False
  364. Enable(35, 77) = False
  365. Enable(35, 78) = False
  366. Enable(35, 79) = False
  367. Enable(35, 80) = False
  368. End Sub
  369.  
  370. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  371. If Button = 2 Then rON = False
  372.  
  373. End Sub
  374.  
  375. Private Sub Form_Terminate()
  376. End
  377. End Sub
  378.  
  379. Private Sub Form_Unload(Cancel As Integer)
  380. End
  381. End Sub
  382.  
  383.  
  384.  
  385.  
  386.  
  387. Private Sub PIC_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  388. If Button = 2 Then rX = x / DIV: rY = y / DIV: rON = True
  389.  
  390. If Button = 1 Then
  391.     x = x / DIV - 0.5
  392.     y = y / DIV - 0.5
  393.     
  394.     If Enable(x, y) Then P(x, y, Buff1) = P(x, y, Buff1) - maxWH * 0.5
  395.     '2*2
  396.     If Enable(x + 1, y) Then P(x + 1, y, Buff1) = P(x + 1, y, Buff1) - maxWH * 0.5
  397.     If Enable(x, y + 1) Then P(x, y + 1, Buff1) = P(x, y + 1, Buff1) - maxWH * 0.5
  398.     If Enable(x + 1, y + 1) Then P(x + 1, y + 1, Buff1) = P(x + 1, y + 1, Buff1) - maxWH * 0.5
  399.     
  400.     
  401. End If
  402.  
  403.  
  404. End Sub
  405.  
  406. Private Sub PIC_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  407. If x < 0 Then Exit Sub
  408. If y < 0 Then Exit Sub
  409. If x > W * DIV Then Exit Sub
  410. If y > H * DIV Then Exit Sub
  411.  
  412. If Button = 1 Then
  413.     x = x / DIV - 0.5
  414.     y = y / DIV - 0.5
  415.     
  416.     If Enable(x, y) Then P(x, y, Buff2) = P(x, y, Buff2) - maxWH * 0.5
  417.     '2*2
  418.     If Enable(x + 1, y) Then P(x + 1, y, Buff2) = P(x + 1, y, Buff2) - maxWH * 0.5
  419.     If Enable(x, y + 1) Then P(x, y + 1, Buff2) = P(x, y + 1, Buff2) - maxWH * 0.5
  420.     If Enable(x + 1, y + 1) Then P(x + 1, y + 1, Buff2) = P(x + 1, y + 1, Buff2) - maxWH * 0.5
  421.     
  422. End If
  423.  
  424. End Sub
  425.  
  426.  
  427. Private Sub wDENS_Change()
  428. Label1.Caption = "Water Densty : " & 1 - wDENS.Value / 1000
  429.  
  430. End Sub
  431.  
  432.