Como obtener el directorio desde donde estamos ejecutando nuestro programa

TRUCOS BREVES VB (1)

Como obtener el directorio desde donde estamos ejecutando nuestro programa:

Escribir el siguiente código:

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

Provocar la trasparencia de un formulario:

Escribir el siguiente código:

Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long,
ByVal dwNewLong As Long) As Long

Private Sub Form_Load()
Dim Resp As Long
Resp = SetWindowLong(Me.hwnd, -20, &H20&)
Form1.Refresh
End Sub

Calcular el número de colores de video del modo actual de Windows:

Crear un formulario y un TextBox y escribir:

Private Declare Function GetDeviceCaps Lib "gdi32"
(ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Sub Form_Load()
i = (2 ^ GetDeviceCaps(Form1.hdc, 12)) ^
GetDeviceCaps(Form1.hdc, 14)
Text1.Text = CStr(i) & " colores."
End Sub

Comprobar si el sistema posee tarjeta de sonido:

Crear un formulario y escribir:

Private Declare Function waveOutGetNumDevs Lib
"winmm.dll" () As Long

Private Sub Form_Load()
Dim inf As Integer
inf = waveOutGetNumDevs()
If inf > 0 Then
MsgBox "Tarjeta de sonido soportada.", vbInformation,
"Informacion: Tarjeta de sonido"
Else
MsgBox "Tarjeta de sonido no soportada.", vbInformation,
"Informacion: Tarjeta de sonido"
End If
End
End Sub

Apagar el equipo, reiniciar Windows, reiniciar el Sistema:

Añadir tres botones a un formulario y escribir lo siguiente en el código del formulario:

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

Abrir el Acceso telefónico a Redes de Windows y ejecutar una conexión:

Crear un formulario y escribir el siguiente código:
Private Sub Form_Load()
Dim AbrirConexion As Long
AbrirConexion = Shell("rundll32.exe rnaui.dll,RnaDial " &
"ConexiónInternet", 1)
SendKeys "{ENTER}"
End Sub
Centrar una ventana en Visual Basic:
 Usar:
 Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
 En vez de:
 Form1.Left = Screen.Width - Width \ 2
Form1.Top = Screen.Height - Height \ 2

Obtener el directorio de Windows y el directorio de Sistema:
 
En un módulo copiar estas líneas:
 
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA"_
 (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA"_
 (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 
Ponga dos Labels o etiquetas y un botón en el formulario:
Label1, Label2, Command1
 
Hacer doble click sobre el botón y escribir el código siguiente:
 
Private Sub Command1_Click()
    Dim Car As String * 128
    Dim Longitud, Es As Integer
    Dim Camino As String
  Longitud = 128
        Es = GetWindowsDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    Label1.Caption = Camino
        Es = GetSystemDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    Label2.Caption = Camino
 End Sub
Ocultar la barra de tareas en Windows 95 y/o Windows NT:
 En un módulo copiar estas líneas:
 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName_
 As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter
As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long,_
ByVal wFlags As Long) As Long
Global Ventana As Long
Global Const Muestra = &H40
Global Const Oculta = &H80
 
En un formulario ponga dos botones y escriba el código correspondiente
a cada uno de ellos:
 
'Oculta la barra de tareas
Private Sub Command1_Click()
    Ventana = FindWindow("Shell_traywnd", "")
    Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta)
End Sub
 
'Muestra la barra de tareas
Private Sub Command2_Click()
    Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra)
End Sub
Situar el cursor encima de un determinado control (p. ej.: un botón):
 
Escribir el código siguiente en el módulo:
 
Declare Sub SetCursorPos Lib "User32" (ByVal X As Integer, ByVal Y As Integer)
 
Insertar un botón en el formulario y escribir el siguiente código:
 
Private Sub Form_Load()
     X% = (Form1.Left + Command1.Left + Command1.Width / 2 + 60) / Screen.TwipsPerPixelX
     Y% = (Form1.Top + Command1.Top + Command1.Height / 2 + 360) / Screen.TwipsPerPixelY
     SetCursorPos X%, Y%
End Sub
Hacer sonar un fichero Wav o Midi:
 
Insertar el siguiente código en un módulo:
 
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

Comprobar si el programa ya está en ejecución:
 
Crear un nuevo proyecto e insertar el siguiente código:
 
Private Sub Form_Load()
    If App.PrevInstance Then
        Msg = App.EXEName & ".EXE" & " ya está en ejecución"
        MsgBox Msg, 16, "Aplicación."
        End
    End If
End Sub

Eliminar el sonido "Beep" cuando pulsamos Enter en un TextBox:
 
Crear un nuevo proyecto e insertar un TextBox:
 
Peguar el siguiente código en el formulario:
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Or KeyAscii = 9 Then KeyAscii = 0
End Sub

Calcular el número de serie de un disco:
 
Crear un nuevo proyecto e insertar el siguiente código en el formulario:
 
Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA"
(ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize
As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags
As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)
 
Private Sub Form_Load()
    Dim cad1 As String * 256
    Dim cad2 As String * 256
    Dim numSerie As Long
    Dim longitud As Long
    Dim flag As Long
    unidad = "C:\"
    Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256)
    MsgBox "Numero de Serie de la unidad " & unidad & " = " & numSerie
End Sub

Mas trucos