Página 1 de 9

[VB6] Coleccion de Codigos Utiles

MensajePublicado:26 Jul 2010, 13:39
por ANTRAX
Con la finalidad de facilitar codigos fuentes a los programadores del foro, creo este post, en donde iremos poniendo unicamente codigos fuentes en Visual Basic 6.
Si alguien tiene alguno simplemente lo postea.
En lo posible en caso de ser un poco confuso o largo el codigo, poner una breve descripcion de lo que hace el codigo y recuerde editar el titulo con el nombre del code.

Fuentes y creditos: Forosdelweb - Recursosvisualbasic

Saludos a todos.

ANTRAX

Ejecutar un solo ejemplar de un programa

MensajePublicado:26 Jul 2010, 13:40
por ANTRAX
Incluir este code en el programa para que se ejecute una sola vez
Código: Seleccionar todo
Private Sub Form_Load()
Dim Ya_Existe As Integer
Ya_Existe = App.PrevInstance
If Ya_Existe <> 0 Then
MsgBox "El Programa ya se esta ejecutando", 0 + 48, "News"
End
End If
End Sub

Como usar el Random

MensajePublicado:26 Jul 2010, 13:42
por ANTRAX
Como usar el Random en un programa
Código: Seleccionar todo
 Private Sub Form_Load()
  Dim Num As Double
  Randomize
  Num = Rnd
  MsgBox Num
End Sub

Saber desde que directorio se ejecuta mi aplicación

MensajePublicado:26 Jul 2010, 13:43
por ANTRAX
Código: Seleccionar todo
  Private Sub Form_Load()
 Dim Directorio as String
 ChDir App.Path
 ChDrive App.Path
 Directorio = App.Path
 If Len(Directorio) > 3 Then
 Directorio = Directorio & "\"
 End If
 End Sub

Como verificar si un fichero existe

MensajePublicado:26 Jul 2010, 13:45
por ANTRAX
Código: Seleccionar todo
Public Sub  VerificarFichero(sNombreFichero As String)
On Error Resume Next
Open sNombreFichero For Input As #1
If Err Then
MsgBox ("El fichero " & sNombreFichero & " no existe.")
Exit Sub
End If
Close #1
End Sub

en un botton:

VerificarFichero "c:\prueba.txt"
Código: Seleccionar todo
Dim Archivo As String
Archivo = "C:\MiTexto.txt"
If Dir(Archivo, vbArchive) = "" Then
MsgBox "El Fichero No Existe"
End If

Como ingresar solo numeros en un campo de texto

MensajePublicado:26 Jul 2010, 13:46
por ANTRAX
Código: Seleccionar todo
	If ((KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii < 44 Or KeyAscii > 44)) Then
		 If (KeyAscii <> 8) Then KeyAscii = 0
	 End If

Como dar vuelta a un texto

MensajePublicado:26 Jul 2010, 13:47
por ANTRAX
Vamos a imaginar que por el motivo que sea deseamos invertir el orden de los caracteres de un texto. Imaginemos que el texto lo tenemos en una variable llamada Texto y almacenamos el contenido de la caneda texto al inverso en la variable Otxet. Por ejemplo: si tenemos el texto Casa obtendremos asaC.

Para ello deberíamos escribir el siguiente código:
Código: Seleccionar todo
 
For Contador = Len(Texto) To 1 Step -1

Otxet = Otxet & Mid (Texto, Contador, 1) 
Next Contador

Como pasar de un texto a otro usando Enter

MensajePublicado:26 Jul 2010, 13:48
por ANTRAX
Insertar tres TextBox y escribir el siguiente código:
Código: Seleccionar todo
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
otra forma:
Insertar tres TextBox, cambiar la propiedad KeyPreview del formulario a True y escribir el siguiente código:
Código: Seleccionar todo
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub

Usar IF THEN ELSE ENDIF en una misma línea

MensajePublicado:26 Jul 2010, 13:50
por ANTRAX
Insertar un CommandButton y un TextBox y escribir el siguiente código:
Código: Seleccionar todo
Private Sub Command1_Click()
Dim I As Integer
Dim A As String
I = 3
A = IIf(I <> 1, "True", "False")
Text1.Text = A
End Sub
Una variante del mismo codigo:
Insertar un CommandButton y un TextBox y escribir el siguiente código:
Código: Seleccionar todo
 Private Sub Command1_Click()
 Dim I As Integer
 Dim A As String
 I = 3
If I <> 1 Then A = "True" Else A = "False"
 Text1.Text = A
 End Sub

Convertir un texto a mayúsculas o minúsculas

MensajePublicado:26 Jul 2010, 13:51
por ANTRAX
Código: Seleccionar todo
 Crear un formulario y situar un TextBox. Escribir:
Private Sub Text1_Change()
Dim I As Integer
Text1.Text = UCase(Text1.Text)
I = Len(Text1.Text)
Text1.SelStart = I
End Sub

Apagar el equipo, reiniciar Windows, reiniciar el Sistema

MensajePublicado:26 Jul 2010, 13:52
por ANTRAX
Añadir tres botones a un formulario y escribir lo siguiente en el código del formulario:
Código: Seleccionar todo
 Private Declare Function ExitWindowsEx& Lib "user32" (ByVal
uFlags&, ByVal dwReserved&)
Private Sub Command1_Click()
Dim i as integer
i = ExitWindowsEx(1, 0&) 'Apaga el equipo
End Sub
Private Sub Command2_Click()
Dim i as integer
i = ExitWindowsEx(0, 0&) 'Reinicia Windows con nuevo usuario
End Sub
Private Sub Command3_Click()
Dim i as integer
i = ExitWindowsEx(2, 0&) 'Reinicia el Sistema
End Sub

Leer y escribir un fichero Ini

MensajePublicado:26 Jul 2010, 13:53
por ANTRAX
Declaraciones generales en un módulo:
Código: Seleccionar todo
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As _
String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As _
Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'Leer en "Ejemplo.Ini":
Private Sub Form_Load()
	Dim I As Integer
	Dim Est As String
	Est = String$(50, " ")
	I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini")
	If I > 0 Then
		MsgBox "Tu Nombre es: " & Est
	End If
End Sub
'Escribir en "Prueba.Ini":
Private Sub Form_Unload(Cancel As Integer)
	Dim I As Integer
	Dim Est As String
	Est = "Ejemplo - Apartado"
	I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini")
End Sub
'Leer en "Ejemplo.Ini":
Private Sub Form_Load()
	Dim I As Integer
	Dim Est As String
	Est = String$(50, " ")
	I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini")
	If I > 0 Then
		MsgBox "Tu Nombre es: " & Est
	End If
End Sub
'Escribir en "Prueba.Ini":
Private Sub Form_Unload(Cancel As Integer)
	Dim I As Integer
	Dim Est As String
	Est = "Ejemplo - Apartado"
	I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini")
End Sub
(Nota: si I=0 quiere decir que no existe información en la línea de fichero Ini a la
que hacemos referencia. El fichero "Ejemplo.Ini" se creará automáticamente).

Re: [VB6] Coleccion de Codigos Utiles

MensajePublicado:26 Jul 2010, 14:04
por ANTRAX
Insertar el siguiente código en un módulo:
Código: Seleccionar todo
 Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Insertar un botón en el formulario y escribir el siguiente código:
Private Sub Command1_Click()
	iResult = mciExecute("Play c:\windows\ringin.wav")
End Sub

Re: [VB6] Coleccion de Codigos Utiles

MensajePublicado:26 Jul 2010, 14:04
por ANTRAX
Insertar el siguiente código en un módulo:
Código: Seleccionar todo
 Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Insertar un botón en el formulario y escribir el siguiente código:
Private Sub Command1_Click()
	iResult = mciExecute("Play c:\windows\ringin.wav")
End Sub

Hacer sonar un fichero Wav o Midi

MensajePublicado:26 Jul 2010, 14:04
por ANTRAX
Insertar el siguiente código en un módulo:
Código: Seleccionar todo
 Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Insertar un botón en el formulario y escribir el siguiente código:
Private Sub Command1_Click()
	iResult = mciExecute("Play c:\windows\ringin.wav")
End Sub