Código:

'Copyright (C) 2010 fLaSh - Carlos.DF

Imports System
Imports System.Collections
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Public Class WaterFX
    Inherits System.Windows.Forms.Panel

    Private effectTimer As System.Windows.Forms.Timer
    Private tmrBalance As System.Windows.Forms.Timer
    Private components As System.ComponentModel.IContainer

    Private _bmp As Bitmap
    Private _waves As Short(,,)
    Private _waveWidth As Integer
    Private _waveHeight As Integer
    Private _activeBuffer As Integer = 0
    Private _weHaveWaves As Boolean
    Private _bmpHeight As Integer, _bmpWidth As Integer
    Private _bmpBytes As Byte()
    Private _bmpBitmapData As BitmapData
    Private _scale As Integer

    Private __IsBusy As Boolean

    Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container()
        Me.effectTimer = New System.Windows.Forms.Timer(Me.components)
        Me.tmrBalance = New System.Windows.Forms.Timer(Me.components)

        AddHandler Me.effectTimer.Tick, AddressOf Me.effectTimer_Tick
        AddHandler Me.tmrBalance.Tick, AddressOf Me.tmrBalance_Tick

        AddHandler Me.Paint, AddressOf Me.WaterEffectControl_Paint
        AddHandler Me.MouseMove, AddressOf Me.WaterEffectControl_MouseMove

    End Sub

    Public Sub New()
        InitializeComponent()
        effectTimer.Enabled = True
        effectTimer.Interval = 100
        tmrBalance.Interval = 1000
        SetStyle(ControlStyles.UserPaint, True)
        SetStyle(ControlStyles.AllPaintingInWmPaint, True)
        SetStyle(ControlStyles.DoubleBuffer, True)
        Me.BackColor = Color.Transparent
        _weHaveWaves = False
        _scale = 1
    End Sub

    Public Sub New(ByVal bmp As Bitmap)
        Me.New()
        Me.ImageBitmap = bmp
    End Sub

    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If components IsNot Nothing Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    Private Sub effectTimer_Tick(ByVal sender As Object, ByVal e As System.EventArgs)
        If _weHaveWaves Then
            Invalidate()
            ProcessWaves()
        End If
    End Sub
    Private Sub tmrBalance_Tick(ByVal sender As Object, ByVal e As System.EventArgs)
        __IsBusy = Not __IsBusy
    End Sub

    Public Sub WaterEffectControl_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs)

        If IsNothing(_bmp) Then Return
        Dim tmp As Bitmap = Nothing

        On Error Resume Next

        tmp = DirectCast(_bmp.Clone(), Bitmap)
        Dim xOffset As Integer, yOffset As Integer
        Dim alpha As Byte

        If _weHaveWaves Then
            Dim tmpData As BitmapData = tmp.LockBits(New Rectangle(0, 0, _bmpWidth, _bmpHeight), ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)

            Dim tmpBytes As Byte() = New Byte(_bmpWidth * _bmpHeight * 4 - 1) {}

            Marshal.Copy(tmpData.Scan0, tmpBytes, 0, _bmpWidth * _bmpHeight * 4)

            For x As Integer = 1 To _bmpWidth - 2
                For y As Integer = 1 To _bmpHeight - 2
                    Dim waveX As Integer = CInt(x) >> _scale
                    Dim waveY As Integer = CInt(y) >> _scale

                    If waveX <= 0 Then
                        waveX = 1
                    End If
                    If waveY <= 0 Then
                        waveY = 1
                    End If
                    If waveX >= _waveWidth - 1 Then
                        waveX = _waveWidth - 2
                    End If
                    If waveY >= _waveHeight - 1 Then
                        waveY = _waveHeight - 2
                    End If

                    xOffset = (_waves(waveX - 1, waveY, _activeBuffer) - _waves(waveX + 1, waveY, _activeBuffer)) >> 3
                    yOffset = (_waves(waveX, waveY - 1, _activeBuffer) - _waves(waveX, waveY + 1, _activeBuffer)) >> 3

                    If (xOffset <> 0) OrElse (yOffset <> 0) Then
                        If x + xOffset >= _bmpWidth - 1 Then
                            xOffset = _bmpWidth - x - 1
                        End If
                        If y + yOffset >= _bmpHeight - 1 Then
                            yOffset = _bmpHeight - y - 1
                        End If
                        If x + xOffset < 0 Then
                            xOffset = -x
                        End If
                        If y + yOffset < 0 Then
                            yOffset = -y
                        End If
                        If xOffset <= 0 Then xOffset = 0

                        alpha = CByte(200 - xOffset)
                        If alpha < 0 Then
                            alpha = 0
                        End If
                        If alpha > 255 Then
                            alpha = 254
                        End If

                        tmpBytes(4 * (x + y * _bmpWidth)) = _bmpBytes(4 * (x + xOffset + (y + yOffset) * _bmpWidth))
                        tmpBytes(4 * (x + y * _bmpWidth) + 1) = _bmpBytes(4 * (x + xOffset + (y + yOffset) * _bmpWidth) + 1)
                        tmpBytes(4 * (x + y * _bmpWidth) + 2) = _bmpBytes(4 * (x + xOffset + (y + yOffset) * _bmpWidth) + 2)
                        tmpBytes(4 * (x + y * _bmpWidth) + 3) = alpha
 
                    End If

                Next
                If Not Err.Number = 0 Then Exit For

            Next

            Marshal.Copy(tmpBytes, 0, tmpData.Scan0, _bmpWidth * _bmpHeight * 4)
            tmp.UnlockBits(tmpData)

        End If

        e.Graphics.DrawImage(tmp, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height)

        If Not Err.Number = 0 Then Debug.WriteLine("WaterEffectControl_Paint: " & Err.Description)

        If Not IsNothing(tmp) Then tmp.Dispose()

    End Sub

    Private Sub ProcessWaves()

        Dim newBuffer As Integer = If((_activeBuffer = 0), 1, 0)
        Dim wavesFound As Boolean = False
        If newBuffer < 0 Then newBuffer = 1

        On Error Resume Next
        For x As Integer = 1 To _waveWidth - 2
            For y As Integer = 1 To _waveHeight - 2
                _waves(x, y, newBuffer) = CShort((((_waves(x - 1, y - 1, _activeBuffer) + _waves(x, y - 1, _activeBuffer) + _waves(x + 1, y - 1, _activeBuffer) + _waves(x - 1, y, _activeBuffer) + _waves(x + 1, y, _activeBuffer) + _waves(x - 1, y + 1, _activeBuffer) + _waves(x, y + 1, _activeBuffer) + _waves(x + 1, y + 1, _activeBuffer)) >> 2) - _waves(x, y, newBuffer)))
                'damping
                If _waves(x, y, newBuffer) <> 0 Then
                    _waves(x, y, newBuffer) -= CShort((_waves(x, y, newBuffer) >> 4))
                    wavesFound = True
                End If
                If Not Err.Number = 0 Then Exit For
            Next
            If Not Err.Number = 0 Then Exit For
        Next

        _weHaveWaves = wavesFound
        _activeBuffer = newBuffer

    End Sub

    Private Sub PutDrop(ByVal x As Integer, ByVal y As Integer, ByVal height As Short)
        _weHaveWaves = True
        Dim radius As Integer = 20
        Dim dist As Double
        On Error Resume Next
        For i As Integer = -radius To radius
            For j As Integer = -radius To radius
                If ((x + i >= 0) AndAlso (x + i < _waveWidth - 1)) AndAlso ((y + j >= 0) AndAlso (y + j < _waveHeight - 1)) Then
                    dist = Math.Sqrt(i * i + j * j)
                    If dist < radius Then
                        _waves(x + i, y + j, _activeBuffer) = CShort((Math.Cos(dist * Math.PI / radius) * height))
                    End If
                End If
                If Not Err.Number = 0 Then Return
            Next
            If Not Err.Number = 0 Then Return
        Next
    End Sub

    Private Sub WaterEffectControl_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        On Error Resume Next
        If Not __IsBusy Then
            Dim realX As Integer = CInt(((e.X / CDbl(Me.ClientRectangle.Width)) * _waveWidth))
            Dim realY As Integer = CInt(((e.Y / CDbl(Me.ClientRectangle.Height)) * _waveHeight))
            If Not Err.Number = 0 Then Return
            PutDrop(realX, realY, 200)
        End If
        If Not tmrBalance.Enabled Then tmrBalance.Start()
    End Sub

#Region "Properties"
    Public Property ImageBitmap() As Bitmap
        Get
            Return _bmp
        End Get
        Set(ByVal value As Bitmap)
            _bmp = value
            If IsNothing(_bmp) Then
                effectTimer.Stop()
                tmrBalance.Stop()
                Return
            Else
                effectTimer.Start()
                __IsBusy = False
            End If
            _bmpHeight = _bmp.Height
            _bmpWidth = _bmp.Width

            _waveWidth = _bmpWidth >> _scale
            _waveHeight = _bmpHeight >> _scale
            _waves = New Int16(_waveWidth - 1, _waveHeight - 1, 1) {}

            _bmpBytes = New Byte(_bmpWidth * _bmpHeight * 4 - 1) {}
            _bmpBitmapData = _bmp.LockBits(New Rectangle(0, 0, _bmpWidth, _bmpHeight), ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
            Marshal.Copy(_bmpBitmapData.Scan0, _bmpBytes, 0, _bmpWidth * _bmpHeight * 4)
        End Set
    End Property
    Public Shadows Property Scale() As Integer
        Get
            Return _scale
        End Get
        Set(ByVal value As Integer)
            _scale = value
        End Set
    End Property
#End Region
End Class

Lindo efecto en vb.net,la verda muy lindo

vb.net el super, el efecto

Reglas del foro escribió:•Prohibido Revivir post de mas de 30 días,estos ya se consideran Antiguos.

Otro post revivido sin sentido rock666? esta es tu última advertencia, para la próxima voy a tener que aplicar una sanción



TEMA CERRADO