Tu comunidad de Seguridad Informatica

Water Effect in VB.NET Info1810 Para ver Todo el contenido del foro es necesario estar Registrado! Water Effect in VB.NET Info1810
Water Effect in VB.NET Info1810 Antes de comentar o Aportar es Obligado Leer Las: Reglas | Rules Water Effect in VB.NET Info1810
Water Effect in VB.NET Info1810Ya Esta Disponible al publico "LeProject" el Videojuego del Foro Click Aquí Para Ver el Post. Water Effect in VB.NET Info1810
Water Effect in VB.NET Info1810Pitbull Security Labs "Extras" Esta Disponible! [ENTRA]Water Effect in VB.NET Info1810

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

1-Slandg- 

-Slandg-
Administrador
Administrador

http://www.pitbullsecurity.org
Vie Oct 01, 2010 10:11 pm
Water Effect in VB.NET Waterj



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

2Ironhide 

Ironhide
Usuario
Usuario

Jue Nov 11, 2010 7:49 pm
Lindo efecto en vb.net,la verda muy lindo

3rock666 

avatar
Banned
Banned

Lun Mar 14, 2011 4:13 pm
Water Effect in VB.NET 69967 vb.net el super, el efecto

4pedrodf007 

pedrodf007
Usuario
Usuario

Lun Mar 14, 2011 7:21 pm
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

Water Effect in VB.NET 478518

TEMA CERRADO

5Contenido patrocinado 



Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.