Mensajes

[Código ligeramente mejorado ya se se queda tanto tiempo muerto!¡.]

MMM se me hace familiar...

http://foro.elhacker.net/programacion_visual_basic/source_triangulo_pascal-t279857.0.html;msg1379201

bueno andaba aburrido e hice el codigo para generar el triangulo de pascal

se nesesitan

2 textBox (textbox 2 en propiedad multilinea = true)
1 CommandButton

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////

Option Explicit

Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String
On Error GoTo 1
Dim a                       As Long
Dim b                       As Long
Dim CelVar()                As Double
    If nLineas > 0 Then
        ReDim CelVar(nLineas, nLineas)
        For a = 1 To nLineas
            For b = 1 To a: DoEvents
                CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
                GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(3, " "), "")
            Next b
            If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf
        Next a
1:      Erase CelVar
    End If
End Function

Private Sub Form_Load()
    Text2.Alignment = 2 '   //  Modo centralizado
End Sub

Private Sub Command1_Click()
    Text2.Text = GenerateTrianglePascal(Val(Text1.Text))
End Sub



con dowhile y doevents

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////

Option Explicit

Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String
On Error GoTo 1
Dim a                           As Long
Dim b                           As Long
Dim CelVar()                    As Double
    If nLineas > 0 Then
        ReDim CelVar(nLineas, nLineas)
        a = 1: Do While a <= nLineas
            b = 1: Do While b <= a: DoEvents
                CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
                GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(2, " "), "")
            b = b + 1: Loop
            If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf
        a = a + 1: Loop
1:      Erase CelVar
    End If
End Function

Private Sub Form_Load()
    Text2.Alignment = 2 '   //  Modo centralizado
End Sub

Private Sub Command1_Click()
    Text2.Text = GenerateTrianglePascal(Val(Text1.Text))
End Sub




Código ligeramente mejorado ya se se queda tanto tiempo muerto!¡.

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Codigo siempre y cuando         //
' // no se eliminen los creditos originales de este codigo      //
' // No importando que sea modificado/editado o engrandesido    //
' // o achicado, si es en base a este codigo                    //
' ////////////////////////////////////////////////////////////////

Option Explicit

Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String)
'On Error GoTo 1
Dim a                       As Long
Dim b                       As Long
Dim Puntero                 As Long
Dim Longitud                As Long
Dim Temporal                As String
Dim CelVar()                As Double
Dim OutDataTemp             As String
Const KiloByte              As Long = 5120
    If nLineas > 0 Then
        ReDim CelVar(nLineas, nLineas)
        Puntero = 1
        OutDataTemp = Space(KiloByte)
        Temporal = Space(255)
        For a = 1 To nLineas
            For b = 1 To a: DoEvents
                CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b))))
                Temporal = CelVar(a, b) & IIf(a <> b, " ", "")
                Longitud = Len(Temporal)
                Mid(OutDataTemp, Puntero, Longitud) = Temporal
                Puntero = Puntero + Longitud
                If Puntero > KiloByte Then
                    OutData = OutData & OutDataTemp
                    OutDataTemp = Space(KiloByte)
                    Puntero = 2
                End If
            Next b
            If a <> nLineas Then
                Puntero = Puntero
                Mid(OutDataTemp, Puntero, 2) = vbCrLf
                Puntero = Puntero + 2
            End If
            Caption = a
        Next a
1:      Erase CelVar
    End If
    OutData = OutData & Trim$(OutDataTemp)
End Sub
Private Sub Form_Load()
    Text2.Alignment = 2 '   //  Modo centralizado
End Sub
Private Sub Command1_Click()
Dim datas                   As String
    Call GenerateTrianglePascal(Val(Text1.Text), datas)
    Text2.Text = datas
End Sub



la longitud de los números esta limitada por el buffer que solo le asigne 255 caracteres.

El limite de lineas es de 932 si es que no se aumentan los buffers de memoria


P.D.: El código en lugar de hacerle un redim a celvar(x,x) puede hacerse de esta forma Celver(1,x) pero decidí dejar los registros anteriores por si alguien deseaba hacerles cambios aun que de esta forma en la que lo deje gasta mas memoria ram en el modo celvar(1,x) no gastaría tanta pero tendría que estarse usando copymemori (API) para mover el de 1 a 0 y sacar los nuevos valores.



Dulces Lunas!¡

[GetTempFileName]

GetTempFileName

Código [Seleccionar] Expandir



http://allapi.mentalis.org/apilist/GetTempFileName.shtml



Sangriento Infierno Lunar!¡.

alguna vez alguien me dijo que asi se solucionaba...

Código (vb) [Seleccionar] Expandir



rem Declaraciones API:
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

rem Variables privadas del control:
private lib32 as long

rem control_Initialize:
lib32=loadlibrary ("Shell32.dll")

rem control_finalize:
call FreeLibrary (lib32)



Código (vb) [Seleccionar] Expandir



Rem Declaraciones API:
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Rem Variables privadas del control:
Private lib32 As Long

Private Sub UserControl_Initialize()
    lib32 = LoadLibrary("Shell32.dll")
End Sub

Private Sub UserControl_Terminate()
    FreeLibrary (lib32)
End Sub




Dulce Infierno Lunar.

se me olvido prueba con esto:

Código (vb) [Seleccionar] Expandir


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   Cancel = Not MsgBox("salir realmente", vbOKCancel) = vbOK
End Sub


Dulces Lunas!¡.

[as <TIPO>]

una correccion

Código (vb) [Seleccionar] Expandir


Dim Que As Variant


Deberia ser

Código (vb) [Seleccionar] Expandir


Private Que As VbMsgBoxResult


o mas sencillo metelo directamente en el

Código (vb) [Seleccionar] Expandir


if msgbox(...) = vbyes then
...
end if


lo que devuelve no ocupa mas de 1 byte asi que podrias ponerlo en un byte y no en un vvariant que ocupa mas de 6 bytes (no recuerdo cuantyos esactamente).

P.D.: Cuando escribes msgbox vb6 te da la sintansis y al ultimo aparece as <TIPO>  el tipo es lo devuelto.

Dulce Infierno Lunar!¡.

perdonen aqui dejo la modificacion que nunca hice y que en si es la correcta

Código (vb) [Seleccionar] Expandir




Option Explicit

'   //  GetSystemMetrics
Const SM_CXSCREEN = 0 'X Size of screen
Const SM_CYSCREEN = 1 'Y Size of Screen
'   //  CreatePen
Const PS_DOT = 2
Const PS_SOLID = 0
'   //  Apis
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Type POINTAPI
   x                   As Long
   y                   As Long
End Type
Private Type tLineas
   PuntoInicio         As POINTAPI
   PuntoFinal          As POINTAPI
End Type
Dim RegionWindows       As RECT
Dim hdcDestino          As Long
Dim hdwdestop           As Long

Private Sub Form_Load()
   Hide
   '   //  Región/Resolución de Pantalla
   With RegionWindows
       .Bottom = GetSystemMetrics(SM_CYSCREEN)
       .Left = 1
       .Right = GetSystemMetrics(SM_CXSCREEN)
       .Top = 1
   End With
   hdwdestop = GetDesktopWindow
   hdcDestino = GetDC(hdwdestop)
   Timer1.Interval = 100
   Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Call ReleaseDC(hdwdestop, hdcDestino)
End Sub

Private Sub Timer1_Timer()
Dim Linea               As tLineas
Dim hPen                As Long
   '   //  Dibujamos lineas al Azar
       '   //  Calculamos el Punto de Inicio
   Linea.PuntoInicio.x = NumeroAleatorio(RegionWindows.Left, RegionWindows.Right)
   Linea.PuntoInicio.y = NumeroAleatorio(RegionWindows.Top, RegionWindows.Bottom)
       '   //  Calculamos el Punto Final
   Linea.PuntoFinal.x = NumeroAleatorio(RegionWindows.Left, RegionWindows.Right)
   Linea.PuntoFinal.y = NumeroAleatorio(RegionWindows.Top, RegionWindows.Bottom)
   '   //  Dibujamos la Linea
   '   //  Dibujamos los puntos    Inicio y Final en color rojo
       '   //  Color de la Linea
       hPen = CreatePen(PS_SOLID, 1, vbRed)
       Call DeleteObject(SelectObject(hdcDestino, hPen))
       Ellipse hdcDestino, Linea.PuntoInicio.x - 2, Linea.PuntoInicio.y - 2, Linea.PuntoInicio.x + 2, Linea.PuntoInicio.y + 2
       Ellipse hdcDestino, Linea.PuntoFinal.x - 2, Linea.PuntoFinal.y - 2, Linea.PuntoFinal.x + 2, Linea.PuntoFinal.y + 2
       Call DeleteObject(hPen)
       '   //  Color de la Linea
       hPen = CreatePen(PS_SOLID, 1, (RGB(NumeroAleatorio(0, 255), NumeroAleatorio(0, 255), NumeroAleatorio(0, 255))))
       Call DeleteObject(SelectObject(hdcDestino, hPen))
       '   //  Iniciamos una nueva Linea (Punto de Inicio)
       MoveToEx hdcDestino, Linea.PuntoInicio.x, Linea.PuntoInicio.y, ByVal 0&
       '   //  Finalizamos la Linea (Punto Final)
       LineTo hdcDestino, Linea.PuntoFinal.x, Linea.PuntoFinal.y
       DeleteObject hPen
End Sub
Public Function NumeroAleatorio(MinNum As Long, MaxNum As Long) As Long
Dim Tmp                                 As Long
   If MaxNum < MinNum Then: Tmp = MaxNum: MaxNum = MinNum: MinNum = Tmp
   Randomize: NumeroAleatorio = CLng((MinNum - MaxNum + 1) * Rnd + MaxNum)
End Function



Dulce Infierno Lunar!¡.

http://foro.elhacker.net/programacion_visual_basic/lineas_al_aire-t281968.0.html;msg1389871#msg1389871


Dulces Lunas!¡.

en el subforo de vb6 esta esto puedes traducirlo a C Sharp

http://foro.elhacker.net/programacion_visual_basic/resuelto_pulsar_mouse-t292487.0.html;msg1450327#msg1450327

es un Hook Real, mas no con un timer y las api que describes OJO es un HOOK AL MOUSE solo debes intercectar el mensaje de windows hacia las pulsaciones de las teclas Suerte xP.

Dulce Infierno Lunar!¡.

Corrijo algo ilogico. (es un string,.. no dire mas solo corrijo).

Código (vbnet) [Seleccionar] Expandir


    For Pos = 1 To RichTextBox1.Text.Length
        Rem     Procesos.
    Next


En un string que no se le hace una asignacion anterior debes hacerle un.

Código (vbnet) [Seleccionar] Expandir


    if Not VarString is nothing then
        For Pos = 1 To RichTextBox1.Text.Length
            Rem     Procesos.
        Next
    End If


Sangriento Infierno Lunar!¡.

[load frm_Main]

viste que se pudo ()

Nota, los que quieran ponerlo como animacion de entrada deben llamar al procedimiento en el evento activate del form, o sino en el Form_Load pero deben llamar a Me.Show antes

si llaman a load frm_Main donde frm_Main es el formulario la animacion no se viera xP (Almenos que se compruebe si esta visible o no el form dentro del proceso aninacion respectivo).

el evento form_load no creo que sirva si esta oculto xP.
y en form_activate se va a activar cadavez que se active la ventana es mejor llamar al proceso de forma externa dentro de un Sub main()

Sangriento Infierno Lunar!¡.