Resultados 1 al 2 de 2

Tema: Links - HackHispano -V1.0

  1. #1 Links - HackHispano -V1.0 
    Avanzado
    Fecha de ingreso
    Mar 2006
    Ubicación
    Cybersiberia Profesion: Ricotero a Full
    Mensajes
    568
    Descargas
    0
    Uploads
    0
    Muy Buenas, estube realizando este programita, pedido por VERTIGO-MDQ en el post http://www.hackhispano.com/foro/showthread.php?t=20791 la cual pide como crear enlaces a ciertas web's pues aqui dejo el codigo fuente y el programita para que lo disfruten.-
    -------------------------------------------------------------------------
    En un Formulario poner:
    Código:
    Option Explicit
    Dim fichero1 As String
    Dim fichero2 As String
    Dim flag As Boolean
    Dim flag2 As Boolean
    Dim flag3 As Boolean
    Dim flag4 As Boolean
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    'Para el modo de ventana en el ShellExecute
    Private Const SW_SHOWNORMAL = 1
    
    Private Sub Command1_Click()
    ShowWindow Me.hwnd, 6
    End Sub
    
    Private Sub Command2_Click()
    End
    End Sub
    
    Private Sub Command3_Click()
    If Command3.Caption = ">      OPCIONES      >" Then
    Command3.Caption = "<      OPCIONES      <"
    Form1.Width = 6500
    Shape1.Width = 6495
    Else
    Command3.Caption = ">      OPCIONES      >"
    Form1.Width = 3360
    Shape1.Width = 3360
    End If
    End Sub
    
    Private Sub Command6_Click()
    CommonDialog1.Filter = "Programas (*.exe)|*.exe"
    CommonDialog1.ShowOpen
    fichero1 = CommonDialog1.FileName
    Text4.Text = CommonDialog1.FileTitle
    End Sub
    
    Private Sub Command7_Click()
    CommonDialog1.Filter = "Programas (*.exe)|*.exe"
    CommonDialog1.ShowOpen
    fichero2 = CommonDialog1.FileName
    Text3.Text = CommonDialog1.FileTitle
    End Sub
    
    Private Sub Command8_Click()
    If Text1.Text = "" Then
    MsgBox "ERROR - Complete el Campo", vbCritical, "Error"
    GoTo ex
    ElseIf Text5.Text = "" Then
    MsgBox "ERROR - Complete el Campo", vbCritical, "Error"
    GoTo ex
    ElseIf Text4.Text = "" Then
    MsgBox "ERROR - Complete el Campo", vbCritical, "Error"
    GoTo ex
    ElseIf Text2.Text = "" Then
    MsgBox "ERROR - Complete el Campo", vbCritical, "Error"
    GoTo ex
    ElseIf Text3.Text = "" Then
    MsgBox "ERROR - Complete el Campo", vbCritical, "Error"
    GoTo ex
    ElseIf Text6.Text = "" Then
    MsgBox "ERROR - Complete el Campo", vbCritical, "Error"
    GoTo ex
    End If
    Command3.Caption = ">      OPCIONES      >"
    Form1.Width = 3360
    Shape1.Width = 3360
    With Label2
    .Caption = Text1.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    With Label4
    .Caption = Text5.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    With Label5
    .Caption = Text2.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    With Label6
    .Caption = Text6.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    ex:
    End Sub
    
    Private Sub Form_Load()
    Form1.Width = 3360
    Shape1.Width = 3360
    With Label2
    .Caption = Text1.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    With Label4
    .Caption = Text5.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    With Label5
    .Caption = Text4.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    With Label6
    .Caption = Text3.Text
    .AutoSize = True
    .MousePointer = 99
    .ForeColor = vbRed
    End With
    
    
    End Sub
    
    Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim ReturnValue As Long
    If Button = 1 Then
    Call ReleaseCapture
    ReturnValue = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
    End Sub
    
    Private Sub Label2_Click()
    If Label2.Caption = "link 1 - Paginas web" Then
    MsgBox "ERROR - Edite en Opciones", vbCritical, "Error"
    GoTo ex
    End If
    ShellExecute Me.hwnd, vbNullString, Label2.Caption, vbNullString, "C:\", SW_SHOWNORMAL
    ex:
    End Sub
    
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    cambiarColor
    End Sub
    
    Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lHandle As Long
    lHandle = LoadCursor(0, HandCursor)
    If (lHandle > 0) Then SetCursor lHandle
    
    If flag Then
    Label2.ForeColor = vbBlue
    flag = False
    End If
    
    End Sub
    
    Private Sub cambiarColor()
    If flag = False Then
    Label2.ForeColor = vbRed
    flag = True
    End If
    
    If flag2 = False Then
    Label4.ForeColor = vbRed
    flag2 = True
    End If
    
    If flag3 = False Then
    Label5.ForeColor = vbRed
    flag3 = True
    End If
    
    If flag4 = False Then
    Label6.ForeColor = vbRed
    flag4 = True
    End If
    
    End Sub
    
    Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lHandle As Long
    lHandle = LoadCursor(0, HandCursor)
    If (lHandle > 0) Then SetCursor lHandle
    If flag Then
    Label4.ForeColor = vbBlue
    flag2 = False
    End If
    End Sub
    Private Sub Text1_GotFocus()
     With Text1
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    Text1.Text = ""
    End Sub
    Private Sub Text3_GotFocus()
    With Text3
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    Text3.Text = ""
    End Sub
    Private Sub Text4_GotFocus()
    With Text4
            .SelStart = 0
            .SelLength = Len(.Text)
       End With
    Text4.Text = ""
    End Sub
    Private Sub Text5_GotFocus()
    With Text5
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    Text5.Text = ""
    End Sub
    Private Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lHandle As Long
    lHandle = LoadCursor(0, HandCursor)
    If (lHandle > 0) Then SetCursor lHandle
    
    If flag Then
    Label5.ForeColor = vbBlue
    flag3 = False
    End If
    
    End Sub
    Private Sub Label6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lHandle As Long
    lHandle = LoadCursor(0, HandCursor)
    If (lHandle > 0) Then SetCursor lHandle
    
    If flag Then
    Label6.ForeColor = vbBlue
    flag4 = False
    End If
    
    End Sub
    Private Sub Label4_Click()
    If Label4.Caption = "link 2 - Paginas web" Then
    MsgBox "ERROR - Edite en Opciones", vbCritical, "Error"
    GoTo ex
    End If
    
    ShellExecute Me.hwnd, vbNullString, Label4.Caption, vbNullString, "C:\", SW_SHOWNORMAL
    ex:
    End Sub
    Private Sub Label5_Click()
    If Label5.Caption = "link 3 - Programas" Then
    MsgBox "ERROR - Edite en Opciones", vbCritical, "Error"
    GoTo ex
    End If
    If Label5.Caption = "Nombre Corto" Then
    MsgBox "ERROR - Edite en Opciones", vbCritical, "Error"
    GoTo ex
    End If
    Dim res As Long
     res = ShellExecute(Me.hwnd, "Open", fichero1, "", "", 1)
    ex:
     End Sub
    Private Sub Label6_Click()
    If Label6.Caption = "link 4 - Programas" Then
    MsgBox "ERROR - Edite en Opciones", vbCritical, "Error"
    GoTo ex
    End If
    If Label6.Caption = "Nombre Corto" Then
    MsgBox "ERROR - Edite en Opciones", vbCritical, "Error"
    GoTo ex
    End If
    
    Dim res2 As Long
     res2 = ShellExecute(Me.hwnd, "Open", fichero2, "", "", 1)
    ex:
    End Sub
    -------------------------------------------------------------------------
    En un modulo poner
    Código:
    Public Const HandCursor = 32649&
    Public Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
    Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
    
    Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam _
    As Long, lParam As Any) As Long
    Declare Sub ReleaseCapture Lib "user32" ()
    Public Const WM_NCLBUTTONDOWN = &HA1
    Public Const HTCAPTION = 2
    -------------------------------------------------------------------------
    Click Aqui para descargar el Programita (ya compilado .exe)

    Clcik Aqui para descargar las Fuentes (Necesitas el VB 6.0)
    -------------------------------------------------------------------------
    No es Gran cosa pero ...Espero que les Guste .....

    Saludos.-
    Citar  
     

  2. #2  
    Medio
    Fecha de ingreso
    May 2002
    Ubicación
    Buenos Aires, Argent
    Mensajes
    95
    Descargas
    0
    Uploads
    0
    Muy Lindo Programita, Saludos ....
    ŞαדαתђэớЪα
    ψ Hεll ψ Ω Heaven Ω
    Citar  
     

Temas similares

  1. [LINKS]Descargas P2P
    Por De pinto en el foro OFF-TOPIC
    Respuestas: 13
    Último mensaje: 15-07-2009, 17:09
  2. Links Del Manifiesto
    Por Sn@ke en el foro NOTICIAS
    Respuestas: 0
    Último mensaje: 12-02-2003, 04:36
  3. Links MUY Recomendables
    Por POSIX en el foro HACK HiSPANO
    Respuestas: 3
    Último mensaje: 26-09-2002, 20:42

Marcadores

Marcadores

Permisos de publicación

  • No puedes crear nuevos temas
  • No puedes responder temas
  • No puedes subir archivos adjuntos
  • No puedes editar tus mensajes
  •