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 [email protected]

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