home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / RunTime Sk200605252001.psc / ModPaint3.bas < prev    next >
Encoding:
BASIC Source File  |  2001-05-08  |  2.7 KB  |  102 lines

  1. Attribute VB_Name = "modpaint3"
  2. Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  3. Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
  4. Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal Nwidth As Long, ByVal Nheight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  5. Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  6.  
  7. Type POINTAPI
  8.    x As Double
  9.    y As Double
  10. End Type
  11.  
  12. Public Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
  13. Public Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  14. Public Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
  15. Public Const SRCAND = &H8800C6  ' (DWORD) dest = source AND dest
  16. Dim X1, Y1
  17.  
  18. Public Function loadfrmnoise()
  19. frmNoise.Show
  20. Call picblt
  21. End Function
  22.  
  23. Public Function picblt()
  24. BitBlt frmNoise.Picture1.hdc, 0, 0, frmNoise.Picture1.Width, frmNoise.Picture1.Height, frmpaint.picBoard.hdc, X1, Y1, SRCAND
  25. End Function
  26.  
  27. Public Function noise()
  28.  
  29.  
  30. frmNoise.Picture1.Cls
  31. Call picblt
  32. frmNoise.Label2.Caption = frmNoise.Slider1.Value
  33. Randomize
  34. For i = 1 To frmNoise.Slider1.Value
  35. d = Int(Rnd * 2) + 1
  36. If d = 1 Then
  37. c = vbBlack
  38. Else
  39. c = vbWhite
  40. End If
  41. c1 = Int(Rnd * 255) + 1
  42. c2 = Int(Rnd * 255) + 1
  43. c3 = Int(Rnd * 255) + 1
  44. x = Int(Rnd * frmNoise.Picture1.ScaleWidth) + 1
  45. y = Int(Rnd * frmNoise.Picture1.ScaleHeight) + 1
  46. If frmNoise.Option1.Value = True Then
  47. SetPixel frmNoise.Picture1.hdc, x, y, c
  48. Else
  49. SetPixel frmNoise.Picture1.hdc, x, y, RGB(c1, c2, c3)
  50. End If
  51.  
  52. Next
  53.  
  54. End Function
  55.  
  56. Public Function noiseOk()
  57. Randomize
  58. For i = 1 To frmNoise.Slider1.Value
  59. d = Int(Rnd * 2) + 1
  60. If d = 1 Then
  61. c = vbBlack
  62. Else
  63. c = vbWhite
  64. End If
  65. c1 = Int(Rnd * 255) + 1
  66. c2 = Int(Rnd * 255) + 1
  67. c3 = Int(Rnd * 255) + 1
  68. x = Int(Rnd * frmpaint.picBoard.Width) + 1
  69. y = Int(Rnd * frmpaint.picBoard.Height) + 1
  70. If frmNoise.Option1.Value = True Then
  71. SetPixel frmpaint.picBoard.hdc, x, y, c
  72. Else
  73. SetPixel frmpaint.picBoard.hdc, x, y, RGB(c1, c2, c3)
  74. End If
  75.  
  76. Next
  77. End Function
  78.  
  79. Public Function mousemove(x As Single, y As Single)
  80. X1 = x
  81. Y1 = y
  82. If x < 0 Then
  83. x = 0
  84. ElseIf y < 0 Then
  85. y = 0
  86. ElseIf x > frmNoise.Picture1.Width Then
  87. x = frmNoise.Picture1.Width
  88. ElseIf y > frmNoise.Picture1.Height Then
  89. y = frmNoise.Picture1.Height
  90. End If
  91.  
  92. frmNoise.Picture1.Cls
  93.  BitBlt frmNoise.Picture1.hdc, 0, 0, frmNoise.Picture1.Width, frmNoise.Picture1.Height, frmpaint.picBoard.hdc, x, y, SRCAND
  94.  
  95. Exit Function
  96. End Function
  97.  
  98.  
  99.  
  100.  
  101.  
  102.