Trucos y rutinas para
Visual Basic
(2ª parte)

Actualizado el 31-Ago-1997


La página con los links de TODOS los trucos


Contenido:

  1. ¿Recursos?: Si, Gracias!
  2. Comprobar cómo se cierra una aplicación
  3. Averiguar el signo decimal
  4. Usar los IO Ports en VB 16 y 32 bits
  5. Funciones para leer/escribir en archivos INI (16 y 32 bits), también para VB3 o anterior
  6. Desglosar una ruta/nombre de archivo
  7. Cómo saber si un programa ha finalizado (VB4 16 ó 32)
  8. Cómo saber si un programa ha finalizado (VB3)
  9. Obtener la etiqueta y número de serie del volumen en VB de 16 bits. También para 32 bits
  10. Usar Shell para ejecutar una orden del MS-DOS
  11. Como llamar al Microsoft Internet Mail y News desde un programa VB
  12. Ejecutar cualquier tipo de archivo, incluso accesos directos (LNK)
  13. Un Huevo de Pascua (Easter Egg), el del VB4
  14. Ejemplo de cómo restar Fechas y Horas
  15. Leer la línea de comandos y quitarle los 'posibles' caracteres de comillas
  16. Determinar la resolución de la pantalla.
  17. Usa tus propias instrucciones en lugar de las de VB
  18. Descargar una DLL o Ejecutable que esté en memoria (sólo 16 bits)
  19. Barra de botones al estilo Office y un ToolTip sencillo
  20. Revisión de la barra de botones.
  21. No permitir cambiar el tamaño de una ventana redimensionable

 

Notas:

  • Todos estos ejemplos y rutinas son de libre uso.
  • Si tienes algunos que quieras que se añadan, sólo tienes que enviarmelo por e-mail
  • Cuando haya una cantidad más o menos "considerable", veré de crear un fichero de ayuda.
  • Cualquier comentario SIEMPRE es bienvenido.
  • Gracias por colaborar.

1.- ¿Recursos?: Si, Gracias! (21/Ene/97)

Pues el truco con el que empiezo este nuevo archivo es para simular un Frame usando Shape.
Con lo cual, el consumo de recursos del sistema, creo, será menor.
Usa el control Shape y dibuja 2 en el form. dale el tamaño y la posición que quieras, pero uno encima del otro. Al primero le pones BorderWidth=2 y el color negro. Al segundo lo dejas con BorderWidth=1, pero el color blanco. Debe estar el segundo encima del primero, para que haga el efecto 3D.
Fácil, verdad?
El único problema es que si incluyes controles en el interior, para moverlos, no es tan fácil cómo si usaras un frame, pero...
En el programa que incluyo hoy, hay ejemplo de esto que estoy diciendo.


2.- Comprobar cómo se cierra una aplicación (21/Ene/97)

Al cerrar un form, podemos saber si es nuestro código el que cierra la aplicación o bien se cierra por otra causa.
Esta comprobación se hace en Form_QueryUnload y puede ser:


QueryUnload Method
Constant
Value
Description
vbFormCode
1
Unload method invoked from code.
vbAppWindows
2
Current Windows session ending.
vbFormMDIForm
4
MDI child form is closing because the MDI form is closing.
vbFormControlMenu
0
User has chosen Close command from the Control-menu box on a form.
vbAppTaskManager
3
Windows Task Manager is closing the application.

'Ejemplo para usarlas:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    'Sólo cerrar si es un mensaje de windows
    Select Case UnloadMode
    Case vbFormCode, vbAppTaskManager, vbAppWindows
        'ok, cerrar
    Case Else
        MsgBox "No se permite cerrar la aplicación.", vbInformation, "Mensajes"
        Cancel = True
        WindowState = vbMinimized
    End Select
End Sub

3.- Averiguar el signo decimal (coma o punto) (18/Feb/97)

Esto lo he usado para el programa de la calculadora y lo copié de un ejemplo que venía con el Visual Basic para MS-DOS
El listado, dejo hasta los comentarios en inglés, para que no digan que me quiero apuntar el tanto.

    ' Determine whether "." or "," should be used as
    ' decimal separator based on value returned by
    ' FORMAT$ (country specific).
    temp$ = Format$(1.5, "#.#")
    If InStr(temp$, ",") Then
        Decimal = ","
    Else
        Decimal = "."
    End If

4.- Usar los IO Ports en con VB 16 y 32 bits (26/Feb/97)

He "bajado" unas librerías de http://www.softcircuits.com/ con rutinas para manejar los puertos de entrada/salida, además de otras cosillas. Esto hay que agradecerselo, además de a la gente de softcircuits, a Victor Limiñana, ya que gracias a una consulta que me hizo sobre este tema, he podido encontrar estas librerías.
Además de los archivos comprimidos con, en algunos casos, ejemplos de cómo usarlos y hasta el código C para crear las librerías, me he tomado la libertad de poner, en el original inglés, los archivos LEEME que acompañan a dichas librerías. Espero que os sirva de algo.

La librería y ejemplos para 16 bits (vbhlp16.zip 37.962 bytes)
El contenido del archivo Vbhelper16.txt

La librería de varias utilidades para 32 bits y ejemplos (vbhlp32.zip 30.945)
El contenido del archivo Vbhlp32.txt

La librería para IO en Windows95, no sirve para NT (win95IO.zip 1.676 bytes)
El contenido del archivo Win95io.txt


5.- Funciones para leer/escribir en archivos INI (16 y 32 bits) (1/Mar/97)

Estas funciones simulan las que incorpora VB4: GetSetting y SaveSetting, pero siempre trabajan con archivos INI, no lo hacen con el registro, como ocurre si el VB4 es 32 bits.
Las funciones usadas del API son: GetPrivateProfileString y WritePrivateProfileString.
En caso de que lo uses con VB3 o anterior, deja sólo la declaración de las funciones del API, sin los #If...#Else...#End If

'--------------------------------------------------
' Profile.bas                           (24/Feb/97)
' Autor:        Guillermo Som Cerezo, 1997
' Fecha inicio: 24/Feb/97 04:05
'
' Módulo genérico para las llamadas al API
' usando xxxPrivateProfileString
'--------------------------------------------------
Option Explicit

#If Win32 Then
    'Declaraciones para 32 bits
    Private 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
    Private 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
#Else
    'Declaraciones para 16 bits
    Private Declare Function GetPrivateProfileString Lib "Kernel" _
        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
         ByVal lpDefault As String, ByVal lpReturnedString As String, _
         ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Private Declare Function WritePrivateProfileString Lib "Kernel" _
        (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
         ByVal lpString As Any, ByVal lplFileName As String) As Integer
#End If


'----------------------------------------------------------------------------
'Función equivalente a GetSetting de VB4.
'GetSetting     En VB4/32bits usa el registro.
'               En VB4/16bits usa un archivo de texto.
'Pero al usar las llamadas del API, siempre se escriben en archivos de texto.
'----------------------------------------------------------------------------
Public Function LeerIni(lpFileName As String, lpAppName As String, lpKeyName As String, Optional vDefault) As String
    'Los parámetros son:
    'lpFileName:    La Aplicación (fichero INI)
    'lpAppName:     La sección que suele estar entrre corchetes
    'lpKeyName:     Clave
    'vDefault:      Valor opcional que devolverá
    '               si no se encuentra la clave.
    '
    Dim lpString As String
    Dim LTmp As Long
    Dim sRetVal As String

    'Si no se especifica el valor por defecto,
    'asignar incialmente una cadena vacía
    If IsMissing(vDefault) Then
        lpString = ""
    Else
        lpString = vDefault
    End If

    sRetVal = String$(255, 0)

    LTmp = GetPrivateProfileString(lpAppName, lpKeyName, lpString, sRetVal, Len(sRetVal), lpFileName)
    If LTmp = 0 Then
        LeerIni = lpString
    Else
        LeerIni = Left(sRetVal, LTmp)
    End If
End Function


'----------------------------------------------------------------------------
'Procedimiento equivalente a SaveSetting de VB4.
'SaveSetting    En VB4/32bits usa el registro.
'               En VB4/16bits usa un archivo de texto.
'Pero al usar las llamadas del API, siempre se escriben en archivos de texto.
'----------------------------------------------------------------------------
Sub GuardarIni(lpFileName As String, lpAppName As String, lpKeyName As String, lpString As String)
    'Guarda los datos de configuración
    'Los parámetros son los mismos que en LeerIni
    'Siendo lpString el valor a guardar
    '
    Dim LTmp As Long

    LTmp = WritePrivateProfileString(lpAppName, lpKeyName, lpString, lpFileName)
End Sub

6.- Desglosar una ruta/nombre de archivo (1/Mar/97)

Una función para desglosar en el Path y el Nombre del archivo, la ruta que recibe como parámetro.
Creo que está suficientemente explicada, cómo para necesitar más aclaración.

Public Sub SplitPath(ByVal sTodo As String, sPath As String, Optional vNombre, Optional vExt)
    '----------------------------------------------------------------
    'Divide el nombre recibido en la ruta, nombre y extensión
    '(c)Guillermo Som, 1997                         ( 1/Mar/97)
    '
    'Esta rutina aceptará los siguientes parámetros:
    'sTodo      Valor de entrada con la ruta completa
    'Devolverá la información en:
    'sPath      Ruta completa, incluida la unidad
    'vNombre    Nombre del archivo incluida la extensión
    'vExt       Extensión del archivo
    '
    'Los parámetros opcionales sólo se usarán si se han especificado
    '----------------------------------------------------------------
    Dim bNombre As Boolean      'Flag para saber si hay que devolver el nombre
    Dim i As Integer

    If Not IsMissing(vNombre) Then
        bNombre = True
        vNombre = sTodo
    End If

    If Not IsMissing(vExt) Then
        vExt = ""
        i = InStr(sTodo, ".")
        If i Then
            vExt = Mid$(sTodo, i + 1)
        End If
    End If

    sPath = ""
    'Asignar el path
    For i = Len(sTodo) To 1 Step -1
        If Mid$(sTodo, i, 1) = "\" Then
            sPath = Left$(sTodo, i - 1)
            'Si hay que devolver el nombre
            If bNombre Then
                vNombre = Mid$(sTodo, i + 1)
            End If
            Exit For
        End If
    Next
End Sub

11.- Como llamar al Microsoft Internet Mail y News desde un programa VB (5/Mar/97)

Este "truco" me lo ha enviado Joe LeVasseur

Pon dos botones en un Form e inserta este código:

Private Sub Command1_Click()
    Dim ValDev&, Programa$
    Programa = "EXPLORER.EXE /root,c:\windows\Internet Mail." & _
        "{89292102-4755-11cf-9DC2-00AA006C2B84}"
    ValDev = Shell(Programa, vbNormalFocus)
End Sub

Private Sub Command2_Click()
    Dim ValDev&, Programa$
    Programa = "EXPLORER.EXE /root,c:\windows\Internet News." & _
        "{89292103-4755-11cf-9DC2-00AA006C2B84}"
    ValDev = Shell(Programa, vbNormalFocus)
End Sub

Si usas el Microsoft Internet News/Mail,
se arrancan cuando pulsas el botón.
Es que no hay un EXE para ellos- son hijos del Explorer.
				Joe

12.- Ejecutar cualquier archivo, incluso accesos directos (LNK) (13/Mar/97)

Esta pregunta me había surgido antes y no encontraba la "puñetera" respuesta. Probé con el Explorer.exe, al estilo del truco anterior, pero nada...
De estas cosas que miras la ayuda y "de casualidad" lees que con start se pueden ejecutar aplicaciones desde la línea de comando... y si se pueden ejecutar aplicaciones... ¿se podrán ejecutar accesos directos? PUES SI !
Y no sólo accesos directos, sino TODO lo que le eches: archivos de cualquier extensión; el START se encarga de llamar a la aplicación correspondiente... lo que uno se ha complicado haciendo DDE y todo el rollo para esta tarea tan fácil!

¿Cómo se hace?

Dim ret As Long
ret = Shell("start " & sFile)
'Si Quieres que no se muestre la ventana:
ret = Shell("start " & sFile, 6)

sFile será "lo que queramos" ejecutar. CUALQUIER COSA!


13.- Un Huevo de Pascua (Easter Egg), el del VB4 (24/Mar/97)

Este "truco" me lo ha mandado el señor Joe LeVasseur y se trata del Easter Egg del Visual Basic 4, se trata de lo siguiente:
Crea un proyecto nuevo e inserta un TextBox, en la propiedad Text escribe: Thunder, seleccionalo y marca la opción "lock controls", ahora pasa el cursor por las ToolBox y "sorpresa!"


14.- Ejemplo de cómo restar fechas y horas (26/Mar/97)

Dos ejemplos de cómo restar fechas y horas.
Para saber los segundos entre dos horas o los días entre dos fechas.

Crea un form con los siguientes controles, dejale los nombre por defecto.
4 TextBox
2 Labels
2 Commands
Distribuyelos para que los dos primeros TextoBoxes estén con el primer label y command, lo mismo con el resto.
Añade lo siguiente al form y pulsa F5

'Ejemplo de prueba para restar fechas y horas       (26/Mar/97)
'(c) Guillermo Som, 1997
Option Explicit


Private Sub Command1_Click()
    Dim t0 As Variant, t1 As Variant

    'Text1 Tendrá una fecha anterior
    'Text2 tendrá la nueva fecha
    t0 = DateValue(Text1)
    t1 = DateValue(Text2)
    Label1 = t1 - t0

End Sub


Private Sub Command2_Click()
    Dim t0 As Variant, t1 As Variant

    'Text3 Tendrá una hora anterior
    Text4 = Format(Now, "hh:mm:ss")
    t0 = Format(Text3, "hh:mm:ss")
    t1 = Format(Text4, "hh:mm:ss")
    Label2 = Format(TimeValue(t1) - TimeValue(t0), "hh:mm:ss")

End Sub


Private Sub Form_Load()
    'Para probar la diferencia de fechas
    Text1 = DateValue(Now)
    Text2 = DateValue(Now + 10)
    '
    'Para probar la diferencia de horas
    Text3 = Format(Now, "hh:mm:ss")
    Text4 = Format(Now, "hh:mm:ss")

    Command1_Click
    Command2_Click
End Sub

15.- Leer la línea de comandos y quitarle los 'posibles' caracteres de comillas que tenga. (26/Mar/97)

Algunas veces cuando recibimos un archivo de la línea de comandos, pueden tener caracteres de comillas, sobre todo si trabajamos con VB4 de 32 bits.
Para usar esta función deberás asignarla a una cadena o usarla directamente.

sFile = LineaComandos()

Private Function LineaComandos() As String
    Dim sTmp As String
    Dim i As Integer

    'Comprobar si hay algún archivo en la línea de comandos
    sTmp = Trim$(Command$)
    If Len(sTmp) Then
        'Si tiene los caracteres de comillas, quitarselos
        i = InStr(sTmp, Chr$(34))
        If i Then
            sTmp = Left$(sTmp, i - 1) & Mid$(sTmp, i + 1)
            i = InStr(sTmp, Chr$(34))
            If i Then
                sTmp = Left$(sTmp, i - 1) & Mid$(sTmp, i + 1)
            End If
        End If
    End If
    LineaComandos = sTmp
End Function

16.- Determinar la Resolución de la pantalla. (10/Abr/97)

Un truco/colaboración/rutina del colega Joe LeVasseur.

Option Explicit
' Como determinar resolución de la
' pantalla con VB4-Win95/NT.
' Dos versiones- con el API y sin...
' Pon tres botones y un textbox encima de
' un form y insertar este codigo.
'
' Joe LeVasseur lvasseur@tiac.net

Private Declare Function GetSystemMetrics Lib "user32" _
    (ByVal nIndex As Long) As Long

Private Sub Command1_Click()
    Dim resolucionX&, resolucionY&
    resolucionX = GetSystemMetrics(0)
    resolucionY = GetSystemMetrics(1)
    Text1.Text = CStr(resolucionX & "x" & resolucionY)
End Sub

Private Sub Command2_Click()
    Dim resolucionX&, resolucionY&
    resolucionX = Screen.Width / Screen.TwipsPerPixelX
    resolucionY = Screen.Height / Screen.TwipsPerPixelY
    Text1.Text = CStr(resolucionX & "x" & resolucionY)
End Sub

Private Sub Command3_Click()
    Text1.Text = ""
End Sub

Private Sub Form_Load()
    Text1.Text = ""
    Command1.Caption = "&Con API"
    Command2.Caption = "&Sin API"
    Command3.Caption = "&Borrar"
    Me.Caption = "Ejemplo para el Guille"
End Sub

17.- Usar tus propias instrucciones en lugar de las de VB. (29/Jun/97)

Esto no es realmente un truco, es que o lo adivinas por equivocación o, como en mi caso, lo lees en un libro.
Ya había notado yo cosas raras con algunas variables, pero no me "fijé" en el detalle... en fin, no pretenderás que esté siempre al loro de todo lo que me ocurra... 8-¿
El tema es que si declaras una función con el mismo nombre que una ya existente, se usará esa función o instrucción en lugar de la que incluye el VB.

Por ejemplo, (para seguir siendo un "copión"), pongo el mismo ejemplo que el libro ese que estoy leyendo ahora.
Se trata de una implementación especial de KILL, pero en esta nueva versión, permite varios archivos como parámetros

Puedes usarla de esta forma:
Kill "archivo1.txt", sUnArchivo$, "archivoX.*"
Kill "UnoSolo.bak"

Function Kill(ParamArray vFiles() As Variant) As Boolean
    Dim v As Variant

    On Error Resume Next
    For Each v In vFiles
	VBA.Kill v
    Next
    Kill = (Err = 0)
End Function

El truco está en anteponer VBA. a la instrucción propia del VB y así se sabe exactamente a que se está refiriendo.


18.- Descargar una DLL o EXE que esté en memoria (sólo 16 bits) (6/Jul/97)

Esto puede servir para descargar una aplicación o librería dinámica de la memoria de nuestro Windows. La forma es sencilla, sólo hay que crear un módulo BAS y escribir este código en el SUB MAIN, como parámetro debemos pasarle la DLL o EXE que queremos "eliminar" y este programita se encargará del resto...

AVISO: Esto sólo funcionará de forma correcta en Windows 3.xx NO USARLO EN WINDOWS 95.
A mí no me ha funcionado bien en Win95 y deja colgado el Explorer, al menos el que se incluye con el IE 4.0 beta.
El que avisa...

'--------------------------------------------------------------
'Descargar una DLL o EXE que esté en memoria        ( 6/Jul/97)
'
'Basado en un código de Bruce McKinney y que realiza la misma
'tarea que WPS.exe para descargar módulos y ejecutables.
'(se supone)
'--------------------------------------------------------------
Option Explicit

Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer
Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer) As Integer
Declare Sub FreeModule Lib "Kernel" (ByVal hModule As Integer)

Public Sub Main()
    Dim hModule As Integer

    'El módulo a librerar se pasa en la línea de comandos
    hModule = GetModuleHandle(Command$)
    If hModule = 0 Then Exit Sub
    'Libera todas copias de este módulo
    Do While GetModuleUsage(hModule) > 0
        Call FreeModule(hModule)
    Loop
End Sub

19.- Barra de botones al estilo Office y un ToolTip sencillo (6/Ago/97)

Esto no es realmente un truco sino más bien una pequeña "utilidad", pero creo que encaja bien en este apartado de los trucos.
Pulsa en este link para ir a la página con la explicación y los listados.

Pulsa en este otro para ver la revisión del 7/Ago/97


21.- No permitir cambiar el tamaño de una ventana redimensionable (31/Ago/97)

Seguramente te preguntarás ¿que utilidad puede tener esto? Si a la ventana se le puede cambiar el tamaño, ¿por qué no permitir que se cambie?
La respuesta, para mí, es sencilla, pero la dejo para que pienses un poco cual sería el motivo...

Bueno, ahí va: en algunas ocasiones me gusta que los bordes de la ventana se vean de forma "normal", es decir como si se pudiese cambiar el tamaño, pero no me gusta que lo puedan cambiar, así que lo que he hecho en estas ocasiones es simplemente conservar el tamaño inicial de la ventana (el que tiene al cargarse) y cuando el usuario decide cambiarle el tamaño, no permitirselo y volver al que tenía inicialemente.

Este "truco" lo mandé ayer día 30 a la lista de VB-ESP, pero tenía un inconveniente: que al cambiar el tamaño por el lado izquierdo o por la parte superior, se movia el form, esto sigue igual, si alguien tiene la forma de conseguirlo, sin que sea dejando el form en la posición inicial, que eso es fácil, sino que recuerde la última posición si sólo se ha movido...

Aquí tienes todo el código necesario:

'--------------------------------------------------------------
'Prueba para no cambiar el tamaño de una ventana con
'bordes dimensionables                              (30/Ago/97)
'--------------------------------------------------------------
Option Explicit

'Tamaño inicial del Form
Dim iH As Integer
Dim iW As Integer


Private Sub Form_Load()
    'Guardar el tamaño inicial
    iH = Height
    iW = Width
End Sub


Private Sub Form_Resize()
    'Sólo comprobar si el estado es Normal
    If WindowState = vbNormal Then
        'Si se cambia la altura
        If Height <> iH Then
            Height = iH
        End If
        'Si se cambia el ancho
        If Width <> iW Then
            Width = iW
        End If
    End If
End Sub

 

ir al índice