• Fuentes

 #210345  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
 #210346  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
 #210347  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
 #210351  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
 #210354  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
 #210356  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
 #210359  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
 #210362  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
 #210363  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).
 #210369  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
 #210370  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
 #210371  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
  • 1
  • 2
  • 3
  • 4
  • 5
  • 9