[Aportes] Llamadas al Efecto Amishar By Santo

Juan Saldiviaa

Newbie Lvl 5
Base del aporte :http http://www.gs-zone.org/temas/efecto-en-nick-amishar-style-solo-modulo.91872/

Creamos un Modulo con el nombre ''M_NameEffect''

Código:
Option Explicit

Public Type tRGB
    r As Byte
    g As Byte
    b As Byte
End Type

Public Type Letras
    RenderX As Integer
    RenderY As Integer
    PlusX As Integer
    PlusY As Integer
    color As Long
    String As String
    Ancho As Byte
End Type

Public Type NhelkName
    Letra() As Letras
    Pos As Byte
    InitialX As Integer
    Bancala As Integer
    BancaEfecto As Byte
    DondeY As Byte
    CuantoY As Byte
    Nick As String
 
 
End Type

Public Type Nhelkk
    Nhelk As NhelkName
End Type

Public NumNames As Integer
Public Numero() As Nhelkk

Public Sub AddNameEffect(ByVal Nombre As String, ByVal colorr As Long)
 
    NumNames = NumNames + 1
 
    ReDim Preserve Numero(1 To NumNames)
 
    Call Initialize(Nombre, colorr, NumNames)

End Sub

Public Function IsName(ByVal Name2 As String, ByVal Index As Integer) As Boolean
 
        If UBound(Numero()) <= Index Then _
           IsName = (UCase$(Numero(Index).Nhelk.Nick) = UCase$(Name2))
       
End Function

Sub Initialize(ByVal Nick1 As String, ByVal Color1 As Long, ByVal Index As Integer)

    On Error GoTo A
    With Numero(Index)
        ReDim .Nhelk.Letra(1 To Len(Nick1))
        .Nhelk.Nick = Nick1
        Dim LoopC As Long
        For LoopC = 1 To Len(Nick1)
            .Nhelk.Letra(LoopC).String = mid$(Nick1, LoopC, 1)
            .Nhelk.Letra(LoopC).color = Color1
            .Nhelk.Letra(LoopC).Ancho = frmMain.TextWidth(.Nhelk.Letra(LoopC).String)
        Next LoopC

        .Nhelk.Pos = 1
        .Nhelk.Letra(1).RenderX = 1
        .Nhelk.DondeY = 1
        .Nhelk.Letra(1).RenderY = 1
    End With
    Exit Sub
A:
    Debug.Print Err.Description & "Error: " & Err.number

End Sub

Sub RenderNhelkName(ByVal X As Integer, ByVal Y As Integer, ByVal Index As Integer)
    With Numero(Index)
          'If Count_Efect > 1 Then
             ' Count_Efect = Count_Efect - 1
             ' Exit Sub
        ' End If
        'Count_Efect = 2
         ' If xs > 0 Then Exit Sub
       ' End If
        Call DameX(X, Index)
        .Nhelk.InitialX = X
        Dim LoopC As Long, tmpx As Integer, loopcc As Long, tmpy As Integer
        For LoopC = 1 To Len(.Nhelk.Nick)
            For loopcc = 1 To LoopC
                tmpx = tmpx + .Nhelk.Letra(loopcc).Ancho - 0.5
            Next loopcc
        
            If .Nhelk.Letra(LoopC).String = "H" Then tmpx = tmpx + 0.3
            If .Nhelk.Letra(LoopC).String = "y" Then tmpx = tmpx + 1
            If .Nhelk.Letra(LoopC).String = "k" Then tmpx = tmpx + 2
            If .Nhelk.Letra(LoopC).String = "a" Then tmpx = tmpx + 3.5
            If .Nhelk.Letra(LoopC).String = "r" Then tmpx = tmpx + 6
            If .Nhelk.Letra(LoopC).String = "i" Then tmpx = tmpx + 8
            If .Nhelk.Letra(LoopC).String = "u" Then tmpx = tmpx + 8.5
            If .Nhelk.Letra(LoopC).String = "s" Then tmpx = tmpx + 10

            If Not .Nhelk.BancaEfecto > 1 Then
                If .Nhelk.Bancala > 1 Then
                    .Nhelk.Bancala = .Nhelk.Bancala - 1
                Else
                    If LoopC = .Nhelk.Pos Then
                        .Nhelk.Letra(LoopC).RenderX = .Nhelk.Letra(LoopC).RenderX - 1
                        If .Nhelk.Letra(.Nhelk.Pos).RenderX <= 2 Then
                            .Nhelk.Letra(.Nhelk.Pos).RenderX = 0
                            .Nhelk.Pos = .Nhelk.Pos + 1
                            If .Nhelk.Pos = Len(.Nhelk.Nick) + 1 Then .Nhelk.Pos = 1: .Nhelk.Bancala = 180
                            .Nhelk.Letra(.Nhelk.Pos).RenderX = 15


                        End If

                    End If
                
                    If LoopC = .Nhelk.DondeY Then
                        .Nhelk.Letra(.Nhelk.DondeY).RenderY = .Nhelk.Letra(.Nhelk.DondeY).RenderY - 1
                        If .Nhelk.Letra(.Nhelk.DondeY).RenderY <= 1 Then
                            .Nhelk.Letra(.Nhelk.DondeY).RenderY = 0
                            .Nhelk.DondeY = .Nhelk.DondeY + 1
                            If .Nhelk.DondeY = Len(.Nhelk.Nick) + 1 Then .Nhelk.DondeY = 1
                            .Nhelk.Letra(.Nhelk.DondeY).RenderY = 5
                        End If
                    End If
                    .Nhelk.BancaEfecto = 0
                End If

            Else
                .Nhelk.BancaEfecto = .Nhelk.BancaEfecto - 1
            End If

            If Not .Nhelk.Bancala > 1 Then
                If LoopC >= .Nhelk.Pos Then
                    tmpx = tmpx + .Nhelk.Letra(.Nhelk.Pos).RenderX
                End If
            End If

            If LoopC = .Nhelk.DondeY Then
                tmpy = tmpy + .Nhelk.Letra(.Nhelk.DondeY).RenderY
            End If

            Select Case .Nhelk.Pos
                Case 1
                    If Not .Nhelk.Bancala > 1 Then
                        tmpx = tmpx - ((Len(.Nhelk.Nick) - 1) * 3)
                    End If
                Case Else
                    tmpx = tmpx - ((Len(.Nhelk.Nick) - .Nhelk.Pos) * 3)
            End Select


            If .Nhelk.Bancala > 1 Then
                Call RenderTextCentered(X + tmpx, Y + .Nhelk.Letra(LoopC).PlusY, .Nhelk.Letra(LoopC).String, RGB(255, RandomNumber(255, 255), RandomNumber(255, 255)), frmMain.font)
            Else
                If LoopC <= .Nhelk.Pos Then
                    Call RenderTextCentered(X + tmpx + .Nhelk.Letra(LoopC).PlusX, Y + .Nhelk.Letra(LoopC).PlusY - tmpy, .Nhelk.Letra(LoopC).String, RGB(255, RandomNumber(255, 255), RandomNumber(255, 255)), frmMain.font)
                End If
            End If
            tmpx = 0
            tmpy = 0
        Next LoopC
           ' tmpy = 1

    End With
End Sub

Private Sub DameX(ByRef X As Integer, ByVal Index As Integer)
    With Numero(Index)
        Dim tmpbyte As Integer
        Dim xx As Long

        For xx = 1 To Len(.Nhelk.Nick)
            tmpbyte = tmpbyte + .Nhelk.Letra(xx).Ancho
        Next xx
        tmpbyte = tmpbyte - (.Nhelk.Letra(Round(Len(.Nhelk.Nick) / 2)).Ancho)
        X = X - tmpbyte / 2 - 10
    End With
End Sub

Buscamos 'Nick, y remplazamos todo el 'Nick por esto
Código:
'Nick
                            line = Left$(.Nombre, Pos - 2)
                           
                            End If
                           
                            If Not M_NameEffect.IsName(line, 1) Then
                                Call RenderTextCentered(PixelOffsetX + TilePixelWidth \ 2 + 5, PixelOffsetY + 30, line, color, frmMain.font)
                            Else
                                Call RenderNhelkName(PixelOffsetX + TilePixelWidth \ 2 + 5, PixelOffsetY + 30, 1)
                            End If

Vamos al Private Sub Form_Load() Del MAIN , Antes del End Sub

Código:
Dim loopc As Long

    AddNameEffect "Aca va tu nick", vbRed
 
    For loopc = 1 To Len(M_NameEffect.Numero(1).Nhelk.Nick)
        M_NameEffect.Numero(1).Nhelk.Letra(loopc).Ancho = TextWidth(M_NameEffect.Numero(1).Nhelk.Letra(loopc).String) + 2
    Next loopc

Eso es todo aca les dejo un video jajaja




Edit
Para Que no les queden las letras arriba de otras

Van editando estas lineas
Código:
If .Nhelk.Letra(LoopC).String = "H" Then tmpx = tmpx + 0.3
If .Nhelk.Letra(LoopC).String = "y" Then tmpx = tmpx + 1
If .Nhelk.Letra(LoopC).String = "k" Then tmpx = tmpx + 2
If .Nhelk.Letra(LoopC).String = "a" Then tmpx = tmpx + 3.5
If .Nhelk.Letra(LoopC).String = "r" Then tmpx = tmpx + 6
If .Nhelk.Letra(LoopC).String = "i" Then tmpx = tmpx + 8
If .Nhelk.Letra(LoopC).String = "u" Then tmpx = tmpx + 8.5
If .Nhelk.Letra(LoopC).String = "s" Then tmpx = tmpx + 10
 
Última edición:

Beledrian

Domador de hardcodes Desarrollador de QlikView
lorwik.png

:p
buen aporte!
 

Gastin.-

COME BACK BABY
OAAAAAAAAAAAAAAAAAAAAAAAA ESE TEMON DE PALA ANCHA PAPAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA!!!!!

Good Aport
 

Toyz

Newbie Lvl 6
Especialista de Argentum
  1. If .Nhelk.Letra(LoopC).String = "H" Then tmpx = tmpx + 0.3
  2. If .Nhelk.Letra(LoopC).String = "y" Then tmpx = tmpx + 1
  3. If .Nhelk.Letra(LoopC).String = "k" Then tmpx = tmpx + 2
  4. If .Nhelk.Letra(LoopC).String = "a" Then tmpx = tmpx + 3.5
  5. If .Nhelk.Letra(LoopC).String = "r" Then tmpx = tmpx + 6
  6. If .Nhelk.Letra(LoopC).String = "i" Then tmpx = tmpx + 8
  7. If .Nhelk.Letra(LoopC).String = "u" Then tmpx = tmpx + 8.5
  8. If .Nhelk.Letra(LoopC).String = "s" Then tmpx = tmpx + 10
Más hardcode imposible.
Lo tengo hecho de una manera que no es necesaria medir el ancho de cada letra, lo hace con " ".
 

Juan Saldiviaa

Newbie Lvl 5
  1. If .Nhelk.Letra(LoopC).String = "H" Then tmpx = tmpx + 0.3
  2. If .Nhelk.Letra(LoopC).String = "y" Then tmpx = tmpx + 1
  3. If .Nhelk.Letra(LoopC).String = "k" Then tmpx = tmpx + 2
  4. If .Nhelk.Letra(LoopC).String = "a" Then tmpx = tmpx + 3.5
  5. If .Nhelk.Letra(LoopC).String = "r" Then tmpx = tmpx + 6
  6. If .Nhelk.Letra(LoopC).String = "i" Then tmpx = tmpx + 8
  7. If .Nhelk.Letra(LoopC).String = "u" Then tmpx = tmpx + 8.5
  8. If .Nhelk.Letra(LoopC).String = "s" Then tmpx = tmpx + 10
Más hardcode imposible.
Lo tengo hecho de una manera que no es necesaria medir el ancho de cada letra, lo hace con " ".
jajajajaj la intencion es lo que vale ahre
 

Lareo

Me Against The World
  1. If .Nhelk.Letra(LoopC).String = "H" Then tmpx = tmpx + 0.3
  2. If .Nhelk.Letra(LoopC).String = "y" Then tmpx = tmpx + 1
  3. If .Nhelk.Letra(LoopC).String = "k" Then tmpx = tmpx + 2
  4. If .Nhelk.Letra(LoopC).String = "a" Then tmpx = tmpx + 3.5
  5. If .Nhelk.Letra(LoopC).String = "r" Then tmpx = tmpx + 6
  6. If .Nhelk.Letra(LoopC).String = "i" Then tmpx = tmpx + 8
  7. If .Nhelk.Letra(LoopC).String = "u" Then tmpx = tmpx + 8.5
  8. If .Nhelk.Letra(LoopC).String = "s" Then tmpx = tmpx + 10
Más hardcode imposible.
Lo tengo hecho de una manera que no es necesaria medir el ancho de cada letra, lo hace con " ".
si mal no entendí, osea agarra una letra random y hace el efecto? aasi como lo tenes vos?
 

Toyz

Newbie Lvl 6
Especialista de Argentum
si mal no entendí, osea agarra una letra random y hace el efecto? aasi como lo tenes vos?

No, hace el mismo efecto usando espacios y no con las dimensiones de cada letra. Voy restando espacios hasta que queda todo comprimido jaja
 
Arriba