Página 1 de 10

[VB6] Coleccion de Codigos Utiles

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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

Publicado: 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