Notas:
Trucos
y rutinas para
Visual Basic (2ª parte)
Actualizado el 31-Ago-1997
La página con los links de TODOS los trucos
Contenido:
Notas:
|
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.
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 FunctionEl 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
