Despliegue Automático de un ComboBox al recibir el Foco

TRUCOS BREVES VB (2)

Despliegue Automático de un ComboBox al recibir el Foco...

En primer lugar, debes declarar la funcion en un modulo BAS:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _lParam As Long) As Long

Y escribe este código en el evento GotFocus del control ComboBox:

Sub Combo1_GotFocus()
Const CB_SHOWDROPDOWN = &H14F
Dim Tmp
Tmp = SendMessage(Combo1.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&)
End Sub

Una ventana con forma ELIPTICA !!!???

Solamente necesitamos declarar en un Modulo lo siguiente:

Public Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, _
                ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, _
                ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

En el evento click de la ventana:
Private Sub Form_Click()
       Dim Xs as Long, Ys as Long
        Xs = Me.Width / Screen.TwipsPerPixelX
        Ys = Me.Height / Screen.TwipsPerPixelY
    SetWindowRgn hWnd, CreateEllipticRng(0, 0, Xs, Ys), True
End Sub

Un Reporte de CrystalReport en una Ventana??

Dim Frm As Form
Set Frm = New Form1
CrystalReport1.Destination = crptToWindow
CrystalReport1.WindowParentHandle = Form1.hwnd
CrystalReport1.Action = 1Siendo el Form1 MDI.

Trasnformar una Hora a Decimal (y viceversa...)

En algunos cálculos es requerido transformar datos de hora a decimal y viceversa (en Topografía es útil). P.e. la hora 10:30 AM será 10.5 en decimal.

Public Function HourDec(h As Variant) As Variant
If Not IsNull(h) Then
HourDec = Hour(h) + Minute(h) / 60 + Second(h) / 3600
End If
End Function

Public Function DecHour(h As Variant) As Variant
Dim nHour As Integer
Dim nMinutes As Integer
Dim nSeconds As Integer

nHour = Int(h)
nMinutes = Int((h - nHour) * 60)
nSeconds = Int(((h - nHour) * 60 - nMinutes) * 60)
DecHour = nHour & ":" & nMinutes & ":" & nSeconds
End Function

Ejemplo:

Private Sub Command1_Click()
Dim h As Single
Dim d As String
Cls
d = "10:37:58"
h = HourDec(d)
Print "Hora Decimal = "; d
Print "Hora Estándar = "; h
Print "Hora de Decimal a Estándar = "; DecHour(h)
End Sub
El parámetro de HourDec puede ser un dato Date, expresión que retorne Date (por ejemplo la función Now), o una cadena, "hh:mm:ss" como en ejemplo.

Validar Fechas

Sub ValidarFecha(Fecha As String, valida As Boolean)

Dim cadena As Date On Error GoTo error
cadena = Format(Fecha, "dd/mm/yyyy")
If Not IsDate(cadena) Then
    MsgBox "Compruebe que ha introducido bien la fecha.", vbInformation
    Exit Sub
End If
If cadena > Date Then
    valida = True
    GoTo error
Else
    valida = False
End If
    Exit Sub
error:
MsgBox "La fecha no puede ser posterior a la fecha de hoy.",
    vbInformation, "Fecha inválida"
    valida = True
    Exit Sub
End Sub

Verificar si una Ventana "X" está cargada

Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" ( _
ByVal lpszClassName As String, ByVal lpszWindow As String) As Long

Llamaremos la función con un:

If FindWindow(vbNullString, Caption) Then
'//Esta abierta ventana con titulo Caption
End If

Sirve para ventanas dentro y fuera de la aplicación, es decir, la usaremos para verificar si un formulario ya a sido cargado o para saber si CALC.EXE esta abierto. Como un detalle, vbNullString es lo que en C se conoce como un puntero nulo, estrictamente el parámetro es la clase de la ventana. También puede ser de utilidad saber que FindWindow retorna el manejador hWnd si la ventana esta abierta.

Ejecutar un programa DOS desde VB

Private Sub Command1_Click()
Shell "C:\WINDOWS\COMMAND\EDIT.COM", vbNormalFocus
End Sub

Mandar un E-Mail llamando a la aplicacion por Default

En un Modulo colocar:

Public 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

Public Const SW_SHOW = 5

En el evento click de un boton...

Private Sub Command1_Click()
    Dim X as Long
    X = ShellExecute hWnd, "open", "mailto:lmbeber@hotmail.com", vbNullString, vbNullString, SW_SHOW
End Sub

Interceptar CRTL + ALT + DEL

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

(Recordar que todas las declaraciones de funciones deben declararse en una sola línea y que habitualmente es mas facil encontrarlo en el archivo WINAPI32.TXT con el Visor de Texto API...)

Private Sub Command1_Click()
Dim res As Integer
Dim bVal As Boolean
If Command1.Caption = "Activado" Then
    Command1.Caption = "Desactivado"
    res = SystemParametersInfo(97, True, bVal, 0)
Else
    Command1.Caption = "Desactivado"
    res = SystemParametersInfo(97, False, bVal, 0)
End If
End Sub

Como saber el Espacio libre del Disco

Crear un módulo y escribir:

Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA"_
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector_
As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long

Private Sub Form_Load()
Dim I1 As Long
Dim I2 As Long
Dim I3 As Long
Dim I4 As Long
Dim Unidad As String
Unidad = "C:/"
GetDiskFreeSpace Unidad, I1, I2, I3, I4
Label1.Caption = Unidad
Label2.Caption = I1 & " Sectores por cluster"
Label3.Caption = I2 & " Bytes por sector"
Label4.Caption = I3 & " N£mero de clusters libres"
Label5.Caption = I4 & " N£mero total de clusters"
Label6.Caption = "Espacio total en disco: " & (I1 * I2 * I4)
Label7.Caption = "Espacio libre en disco: " & (I1 * I2 * I3)
End Sub

(Nota: Este código vale igualmente para los CD-ROM y disquetes. La letra de la unidad puede estar en letra minúscula o mayúscula).

Comprobar si el Protocolo TCP/IP está instalado

Si bien esta no es una solución no muy buena, pero por lo menos sirve...
Mediante acceso a la API, puedes abrir el entorno de red para ver que es lo que hay instalado, y si el TCP/IP
no lo está ,que lo haga el usuario...

El código referente a esto es....

X = Shell("Rundll32.exe shell32.dll,Control_RunDLL NetCPL.cpl @0")

Abrir / Cerrar la Unidad de CD

    El procedimiento para lograr esto es el siguiente:

   En la sección Declaraciones de un Form, colocar el siguiente código: (podes sacarlo de el API Viewer /Visor de Texto API): (Todo debe ir en una sola linea...!)

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

En el mismo form (ej.: form1) colocar dos botones: Abrir y Cerrar.
En el codigo del boton Abrir, colocamos el siguiente codigo:

ret = mciSendString("set CDAudio door open", returnstring, 127, 0)

Y en el codigo del boton Cerrar, colocamos el siguiente codigo:

ret = mciSendString("set CDAudio door closed", returstring, 127, 0)

Listo!!

Página anterior