• Author / Uploaded
• LeonidParedes

• Categories
• Básico
• Puntero (Programación de computadora)
• Archivo de computadora
• Ventana (informática)
• Microsoft

Citation preview

Trucos en Visual Basic Cómo redondear un número Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Utilice la siguiente rutina para redondear un número. Le devolverá el número redondeado en formato Double con tantos decimales como indique en el parámetro 'intCntDec'. Public Function Redondear (dblnToR As Double,_ Optional intCntDec As Integer) As Double Dim dblPot As Double Dim dblF As Double If dblnToR < 0 Then dblF = -0.5 Else: dblF = 0.5 dblPot = 10 ^ intCntDec Redondear = Fix(dblnToR * dblPot * (1 + 1E-16) + dblF) / dblPot End Function Cómo dibujar letras en tres dimensiones en Visual Basic Aplicable a Microsoft Visual Basic 6 Para dibujar letras en tres dimensiones en Visual Basic lo único que hay que hacer crear un formulario e introducir en él un Command Button con el siguiente código: Private Sub Command1_Click() Dim I As Integer, X As Integer, Y As Integer ForeColor = &HFF0000: X = CurrentX: Y = CurrentY CurrentX = X: CurrentY = Y: FontSize = 14 For I = 1 To 50 Print "Texto en tres dimensiones" X = X + 1: Y = Y + 1: CurrentX = X: CurrentY = Y Next I ForeColor = &HFF00& Print "Texto en tres dimensiones" End Sub Donde en vez de "Texto en tres dimensiones" pondremos el texto que queramos. Cómo pasar de un control a otro pulsando Intro Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Para pasar de un control a otro pulsando Intro utilice la siguiente código en el evento KeyPress de cada control. El orden que siguen será el marcado en la propiedad TabIndex. If KeyAscii = 13 Then SendKeys "{Tab}", True End If Cómo juntar los contenidos de dos archivos Aplicable a Microsoft Visual Basic 5, Visual Basic 6 El comando copy de DOS permite coger los contenidos de dos ficheros y ponerlos secuencialmente en un tercero. En Visula basic se puede hacer lo mismo utilizando con la siguiente rutina: Public Function Sub Join Files (Source1 as String,_ Source2 as String, Dest as Sting) Dim Buffer() as Byte Open Source1 for Binary Access Read as #1 Open Source2 for Binary Access Read as #2 Open Dest for Binary Access Write as #3 ReDim Buffer(1 To LOF(1)) Get #1, ,Buffer Get #3, ,Buffer ReDim Buffer(1 To LOF(2)) Get #2, ,Buffer Get #3, ,Buffer Close #1, #2, #3

End Sub. Cómo pedir confirmación de descarga de un formulario Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Quizás a veces desee dar a los usuarios la opción de confirmar que desean descargar un formulario. En vez de utilizar una función MsgBox y un Select Case, puede incluir este código en el evento Form_Unload. Private Sub Form_Unload (Cancelar as Integer) Cancelar = (MsgBox ("¿Salir?", vbOKCancel Or _ vbQuestion, "Demo Confirmacion") = vbCancel) End Sub Detrás del botón Salir y de la opción Salir del menú, ponga simplemente Unload Me. Cada vez que un usuario quiera salir se les pedirá confirmación. Cómo obtener el directorio desde donde estamos ejecutando nuestro programa Aplicable a Microsoft Visual Basic 6 Para obtener el directorio desde donde estamos ejecutando nuestro programa lo único que hay que hacer es utilizar este 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 Text1.Text = Directorio End Sub En este ejemplo el directorio aparecerá en el cuadro de texto Text1. Función creada por Eduardo Fórneas. Originalmente publicada en

Cómo colocar la hora y la fecha en la barra de título de una MDI Form Aplicable a Microsoft Visual Basic 6 Para colocar la hora y la fecha en la barra de título de una MDI Form siga estos pasos: Coloque un objeto timer en el formulario MDI. El valor de la propiedad Interval del objeto timer debe ser 1000. Elimine el valor de la propiedad caption de la forma MDI. En el procedimiento Timer del objeto escriba el siguiente código: .Caption = "" & Format(Date, "dd-mm-yyyy") & " " & Format(Now, "h:nn:ss AM/PM") Donde NombreForm el el nombre de su formulario MDI y Nombre de la aplicación es el nombre que le quiere dar. En el procedimiento Load del formualario escriba el siguiente código: timer1.Enabled = true Función originalmente publicada en Cómo hacer desaparecer el cursor del ratón Aplicable a Microsoft Visual Basic 5, Visual Basic 6 Para hacer desaparecer y aparecer el cuesor del ratón pegue el siguiente código en el módulo: Declare Function ShowCursor Lib "user32" (ByVal bShow_ As Long) As Long Debe crear dos botones con: Private Sub Command1_Click() result = ShowCursor(False) End Sub y Private Sub Command2_Click() result = ShowCursor(True) End Sub Es muy importante que, en el caso del botón2 que hace reaparecer el cursor, permita seleccionarlo desde el teclado poniendo su propiedad Caption a &Mostrar.

Función creada por Eduardo Fórneas. Originalmente publicada en

Cómo saber si un array está correctamente dimensionado Aplicable a Microsoft Visual Basic 6 En ocasiones es necesario declarar un array vacío para posteriormente utilizar ReDim y asignarle el espacio que nosotros indiquemos. En un momento dado, puede ser útil comprobar en el programa si el array ha sido ya creado o no. La siguiente función devuelve True si el array dinámico no ha sido dimensionado: Public Function EstaArrayVacio(aArray as Variant) as Boolean On Error Resume Next EstaArrayVacio = UBound(aArray) EstaArrayVacio = Err ' Error 9 (Subscript out of range) End Function Utilice el siguiente código para probar la función: Private Sub Command1_Click() Dim aDynamic() as Integer MsgBox EstaArrayVacio(aDynamic) ReDim aDynamic(8) MsgBox EstaArrayVacio(aDynamic) End Sub Cómo abrir una base de datos con seguridad desde ADO Aplicable a Microsoft Visual Basic 6 La seguridad utilizada convencionalmente por Microsoft Access es una seguridad a nivel de usuario, controlada desde los ficheros .MDB y .MDA o .MDW (según versión de Microsoft Access). Microsoft Access 7.0 y Microsoft Access 97 también incorporan otro tipo de seguridad, asociada a la base de datos (se protege la base de datos con una contraseña que forma parte del fichero .MDB, y que solamente es solicitada al abrir ésta). El código aquí incluido permite abrir desde Visual Basic una base de datos cuando hay establecida seguridad a nivel de usuario. Previamente, desde el entorno de Microsoft Access se ha asignado al usuario Administrador (que es por defecto el propietario de todas las bases de datos) una contraseña ("ejemplo"). Esto se hace en Access 97 en la opción de menú Herramientas, Seguridad, Cuentas de usuario y de grupo y, una vez ahí, accediendo a la pestaña Cambiar contraseña de conexión. A partir de entonces, al abrir Access será necesario proporcionar el usuario y la contraseña. También a partir de entonces, para abrir un MDB desde VB será necesario pasarle el usuario y la contraseña. Este es el código VB que utiliza objetos de ADO 2.0 para abrir el MDB: Dim Cn As New ADODB.Connection Dim strCn As String strCn = "Provider=Microsoft.Jet.OLEDB.3.51;" & _ "Data Source=nwind.MDB;" & _ "Jet OLEDB:System database=c:\winnt\system32\System.MDW" Cn.Open ConnectionString:=strCn, _ UserID:="Admin", Password:="moises" NOTA: Aunque se disponga de Microsoft Access en idioma castellano y el usuario se llame Administrador, es necesario pasar "Admin" como UserID, y no "Administrador". Cómo crear un salvapantallas con Visual Basic Aplicable a Microsoft Visual Basic 6 La forma de crear un salvapantallas con Visual Basic es muy simple. Basta con crear un proyecto con un formulario al que se le añadirán los controles que conformarán el interfaz del salvapantallas, junto al código que se quiera incluir. Al generar el fichero ejecutable se debe dar la extensión SCR, y el fichero debe guardarse en el directorio por defecto de Windows. Un ejemplo: crear un proyecto estándar en VB y asignar las siguientes propiedades al formulario por defecto WindowState = 2 'Maximized BorderStyle = 0 'None

Incluir en el formulario una etiqueta con un texto descriptivo. Incluir a continuación el siguiente código: Private Sub Form_Click() 'El salvapantallas se desactiva al hacer click sobre el formulario Unload Me End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'El salvapantallas se desactiva al pulsar una tecla Unload Me End Sub Private Sub Form_Load() 'No se permita más de una instancia del salvapantallas If App.PrevInstance Then Unload Me End Sub Generar el fichero ejecutable con la extensión SCR, y guardarlo en el directorio por defecto de Windows. Si a continuación indicamos éste como salvapantallas por defecto en las propiedades del escritorio de Windows, cuando se venza el retardo de tiempo indicado, el formulario maximizado será visualizado como salvapantallas. Para volver al escritorio bastará con pulsar una tecla o hacer clic con el ratón. Cómo detectar si una tarjeta de crédito es válida Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6 En una aplicación de comercio electrónico o una aplicación que necesite validar el número de una tarjeta de crédito, se puede hace uso del algoritmo ISO 2894. Este algoritmo permite comprobar que la numeración de la tarjeta es correcta, pero obviamente no indica si la tarjeta sigue siendo válida (no ha sido anulada, ha caducado, etc.). A continuación, se muestra el código Visual Basic para comprobar la validez en la numeración de una tarjeta de crédito: Cree un nuevo proyecto en Visual Basic y añada una caja de texto y un botón. Pegue el siguiente código: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' EsCCValido ' ' Valida la tarjeta de crédito de acuerdo con el algoritmo ISO 2894 ' El algoritmo es: ' 1. Calcular el peso para el primer dígito: si el número de dígitos ' es par el primer peso es 2 de lo contrario es 1. Después los ' pesos alternan entre 1, 2, 1, 2, 1 ... ' 2. Multiplicar cada dígito por su peso ' 3. Si el resultado del 2º paso es mayor que 9, restar 9 ' 4. Sumar todos los dígitos ' 5. Comprobar que el resultado es divisible por 10 ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function EsCCValido(sTarjeta As String) As Boolean Dim iPeso As Integer Dim iDigito As Integer Dim iSuma As Integer Dim iContador As Integer Dim sNuevaTarjeta As String Dim cCaracter As String * 1 iPeso = 0 iDigito = 0 iSuma = 0 'Reemplazar cualquier no digito por una cadena vacía For iContador = 1 To Len(sTarjeta) cCaracter = Mid(sTarjeta, iContador, 1) If IsNumeric(cCaracter) Then

sNuevaTarjeta = sNuevaTarjeta & cCaracter End If Next iContador ' Si es 0 devolver Falso If sNuevaTarjeta = 0 Then EsCCValido = False Exit Function End If ' Si el número de dígitos es par el primer peso es 2, de lo ' contrario es 1 If (Len(sNuevaTarjeta) Mod 2) = 0 Then iPeso = 2 Else iPeso = 1 End If For iContador = 1 To Len(sNuevaTarjeta) iDigito = Mid(sNuevaTarjeta, iContador, 1) * iPeso If iDigito > 9 Then iDigito = iDigito - 9 iSuma = iSuma + iDigito ' Cambiar peso para el siguiente dígito If iPeso = 2 Then iPeso = 1 Else iPeso = 2 End If Next iContador ' Devolver verdadero si la suma es divisible por 10 If (iSuma Mod 10) = 0 Then EsCCValido = True Else EsCCValido = False End If End Function Private Sub btnComprobarCC_Click() If EsCCValido(Text1) Then MsgBox "Tarjeta válida" Else MsgBox "Tarjeta inválida" End If End Sub Ejecute la aplicación. En la caja de texto introduzca el número de la tarjeta de crédito y pulse el botón de comprobación. Puede probar con 4242 4242 4242 4242 que es un número válido Cómo dar formato para celdas numéricas en el control DBGRID Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6 A las columnas numéricas de un dbgrid se les puede aplicar un formato de visualización de los números. Para establecer este formato a través de código debe utilizarse la propiedad NumberFormat, pero en base al formato americano. Por ejemplo, imaginemos que la tercera columna en un dbgrid es una columna numérica en la que aparecen cifras de ventas con valores decimales, y queremos visualizar el punto para las unidades de millar y dos decimales tras la coma. Tenderemos a escribir el siguiente código: DBGrid1.Columns(2).NumberFormat = "#.###,##" Pues bien, el resultado será que, una vez ejecutado este código, esa columna aparecerá en blanco. La razón es que esta propiedad debe utilizarse en base al formato americano, o dicho de otro modo, el punto decimal debe ser una coma (",") y la separación de decimales un punto ("."). De esta forma, si utilizamos el siguiente código:

DBGrid1.Columns(2).NumberFormat = "#,###.##" el resultado sí será el correcto, y veremos los valores numéricos en dicha columna, y además con el formato deseado (por ejemplo, 10.235,27). PRECAUCIÓN: CUALQUIER UTILIZACIÓN POR SU PARTE DEL CÓDIGO INCLUIDO EN ESTE ARTÍCULO SE HARÁ A SU CUENTA Y RIESGO. Microsoft facilita este código "tal cual" sin garantía de ningún tipo, ya sea explícita o implícita, incluyendo expresamente en tal exención de responsabilidad y, a efectos meramente enunciativos y no limitativos, las garantías legales mercantiles implícitas y/o la adecuación a un propósito o finalidad en particular. Cómo lanzar síncronamente comandos de MS-DOS Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6 A veces interesa lanzar comandos MS-DOS desde Visual Basic y esperar a que éstos acaben. Una situación habitual es lanzar ficheros por lotes (.BAT), o comandos "net XXX", que realizan exploración por distintos servidores en la red y que pueden tardar varios segundos en ser ejecutados. A continuación se incluye un ejemplo de cómo lanzar un comando MS-DOS y esperar a que éste acabe. Se utilizan dos funciones del API de Windows. La declaración de éstas se ha obtenido del Visor de Texto API, un icono que aparece en el grupo de programas de Visual Basic. Estas funciones son: OpenProcess(): a partir del identificador de un proceso en ejecución esta función devuelve el handle de dicho proceso. GetExitCodeProcess(): recupera el código de salida de un proceso lanzado. Por otra parte, en el código de ejemplo se incluye una referencia a Environ$("Comspec") & " /c " Esta instrucción fuerza a que se cierre la ventana MS-DOS de Windows 95 o Windows 98 después de que el comando MS-DOS se haya ejecutado. En realidad la anterior instrucción se traduce en "COMMAND.COM /C" La utilización de la función Environ con el parámetro Comspec asegura que el command.com se encontrará aunque no esté en el path. El ejemplo necesita un proyecto con un Textbox y un Command button, con las propiedades por defecto. Al ejecutar el proyecto, teclear el comando MS-DOS en el Textbox y pulsar Command1. Pasados unos segundos (depende del comando a ejecutar), aparecerá el mensaje "El comando ha acabado". El código del formulario es el siguiente: Option Explicit Private Const PROCESS_QUERY_INFORMATION = &H400 Private Const STILL_ACTIVE = &H103 Private Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) _ As Long Private Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, lpExitCode As Long) _ As Long Sub EsperarShell(sCmd As String) Dim hShell As Long Dim hProc As Long Dim codExit As Long ' ejecutar comando hShell = Shell(Environ$("Comspec") & " /c " & sCmd, 2) ' esperar a que se complete el proceso hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell) Do GetExitCodeProcess hProc, codExit DoEvents Loop While codExit = STILL_ACTIVE MsgBox "El comando ha acabado"

End Sub Private Sub Command1_Click() EsperarShell (Text1.Text) End Sub Cómo depurar el SETUP1.VBP del asistente para instalar aplicaciones Aplicable a Microsoft Visual Basic 4, Visual Basic 5, Visual Basic 6 Usted puede personalizar el asistente para la instalación de aplicaciones modificando el proyecto Setup1.vbp. Sin embargo, este proyecto no puede ser depurado en el entorno de desarrollo (IDE) a menos que se emule el comportamiento de la rutina de instalación. Para depurar el proyecto Setup1.vbp en el IDE siga los siguientes pasos: Ejecute el asistente para instalar aplicaciones (también conocido como asistente para empaquetado y distribución) y cree unos discos de instalación en un directorio. Edite el fichero Setup.lst en un editor de texto y haga las siguientes modificaciones: Visual Basic 4.0 16-bit Localice: Setup=setup1.exe y reemplázelo con: Setup=c:\vb\vb.exe c:\vb\setupkit\setup1\setup1.vbp /cmd Visual Basic 4.0 32-bit Localice: Setup=setup132.exe y reemplázelo con: Setup=c:\vb\vb32.exe c:\vb\setupkit\setup1\setup1.vbp /cmd Visual Basic 5.0 Localice: Setup=setup1.exe y reemplázelo con: Setup="c:\archivos de programa\devstudio\vb\vb5.exe" "c:\archivos de programa\devstudio\vb\setupkit\setup1\setup1.vbp" /cmd Visual Basic 6.0 Localice: Spawn=setup1.exe y reemplázelo con: Spawn="C:\Archivos de Programa\Microsoft Visual Studio\VB98\VB6.exe" "C:\Archivos de Programa\Microsoft Visual Studio\VB98\Wizards\ PDWizard\Setup1\Setup1.vbp" /cmd Comience la instalación ejecutando Setup.exe. Cuando Setup.exe termina, se ejecuta el IDE de Visual Basic cargando el proyecto Setup1.vbp. Establezca los puntos de ruptura que considere oportunos para hacer la depuración y pulse F5 o F8. Cómo detectar el estado de un impresora local Aplicable a Microsoft Visual Basic 6 Las funciones de la API de Windows para comprobar el estado de una impresora requieren que haya un documento en el spooler. Esta restricción obliga, en la mayoría de los casos, a mandar un trabajo de impresión para detectar el estado de la impresora. Para evitar este incoveniente se puede abrir el puerto de la impresora (normalmente lpt1) con CreateFile y tratarlo como un puerto de comunicaciones normal. La API ClearCommError permite detectar errores en el puerto. El siguiente ejemplo muestra cómo examinar el estado de una impresora (este método sólo funciona para impresoras locales) : Cree un nuevo proyecto. Añada un módulo de proyecto. Copie el siguiente código en el módulo de proyecto: Public Const GENERIC_WRITE = &H40000000 Public Const GENERIC_READ = &H80000000 Public Const FILE_ATTRIBUTE_NORMAL = &H80 Public Const CREATE_ALWAYS = 2

Public Const OPEN_ALWAYS = 4 Public Const INVALID_HANDLE_VALUE = -1 Public Type COMSTAT Filler1 As Long Filler2 As Long Filler3 As Long Filler4 As Long Filler5 As Long Filler6 As Long Filler7 As Long Filler8 As Long Filler9 As Long Filler10 As Long End Type Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _ As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, _ lpStat As COMSTAT) As Long Public Const CE_BREAK = &H10 ' break condition Public Const CE_PTO = &H200 ' printer timeout Public Const CE_IOE = &H400 ' printer I/O error Public Const CE_DNS = &H800 ' device not selected Public Const CE_OOP = &H1000 ' out of paper Coloque un botón en el formulario y copie el siguiente código: Private Sub Command1_Click() Dim mHandle As Long Dim lpErrors As Long Dim x As COMSTAT mHandle = CreateFile("lpt1", GENERIC_WRITE Or GENERIC_READ, _ 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) If mHandle < 0 Then MsgBox "error de apertura del puerto " & mHandle Else If ClearCommError(mHandle, lpErrors, x) = False Then MsgBox "Error en ClearCommError" End If End If If lpErrors And CE_BREAK Then MsgBox "Error genérico" End If If lpErrors And CE_PTO Then MsgBox "Timeout de impresora" End If If lpErrors And CE_IOE Then MsgBox "Error de entrada/salida" End If If lpErrors And CE_DNS Then MsgBox "Dispositivo no seleccionado" End If If lpErrors And CE_OOP Then MsgBox "Sin papel" End If CloseHandle mHandle End Sub

Ejecute la aplicación y pulse el botón para comprobar el estado de la impresora. Cómo minimizar todas las ventanas Aplicable a partir de Microsoft Visual Basic 4.0 32 Bits En Visual Basic es fácil minimizar todas las ventanas visibles mediante programación usando el API keybd_event. El truco consiste en imitar los eventos de teclado requeridos para abrir el menú de la barra de tareas y enviar la letra "M" para seleccionar la opción "Minimizar todas las ventanas". Con tres llamadas al API keybd_event podremos conseguirlo. El segundo argumento de la llamada a keybd_event es el código de tecla (hardware scan code), y en este caso podríamos usar el valor 91, sin embargo dado que las aplicaciones podrían no usar este código, se ha dejado a cero. Ejemplo paso a paso ------------------1. Inicie un nuevo proyecto EXE. Form1 se crea por defecto. 2. Añada un botón de comando en Form1. 3. Copie y pegue el siguiente código en la ventana de código de Form1. Private Declare Sub keybd_event Lib "user32" ( ByVal bVk As Byte,_ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Const KEYEVENTF_KEYUP = &H2 Const VK_LWIN = &H5B Private Sub Command1_Click() ' 77 is the character code for the letter 'M' Call keybd_event(VK_LWIN, 0, 0, 0) Call keybd_event(77, 0, 0, 0) Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0) End Sub 4. Pulse la tecla F5 para ejecutar la aplicación y haga clic en el botón de comandos, se minimizarán todas las ventanas Cómo ejecutar como procedimiento el contenido de un string Aplicable a partir de Microsoft Visual Basic 4.0 En Visual Basic se está avanzando en la posibilidad de ejecutar el código apuntado por un puntero a función, tal y como se permite en Visual C++. Ya en Visual Basic 5.0 se incorporaba la función AddressOf, que permitía obtener la dirección de una función. Pasando esa dirección a un programa C++, éste podía ejecutar la función. En Visual Basic 6.0 se avanza un paso más y se crea la función CallByName, que permite ejecutar una función si se conoce su nombre en tiempo de ejecución. Basta con pasar a CallByName una cadena (string) como argumento, conteniendo el nombre de la función a ejecutar. Los argumentos que recibe CallByName son: el objeto contenedor de la función (por ejemplo, un Formulario), la cadena que contiene el nombre de la función, el tipo de función y los argumentos de ésta. El siguiente ejemplo crea dos funciones (Divide y Multiplica). Si en Text2 y Text3 colocamos los argumentos, al pulsar el botón se ejecuta la operación que hallamos escrito en Text1 (Multiplica o Divide). Public Function Divide(arg1 As Long, arg2 As Long) Divide = arg1 / arg2 End Function Public Function Multiplica(arg1 As Long, arg2 As Long) Multiplica = arg1 * arg2 End Function Private Sub Command1_Click()

MsgBox CallByName(Me, Text1.Text, VbMethod, Text2.Text, Text3.Text) End Sub Cómo establecer los márgenes de la impresora Aplicable a partir de Microsoft Visual Basic 4.0 Para indicar los márgenes de un trabajo de impresión hay que utilizar las propiedades de escala de la impresora. El siguiente ejemplo establece el margen izquierdo a 0'6 pulgadas y el margen superior a 0'7 pulgadas. El factor 1440 convierte las pulgadas a twips: Printer.ScaleLeft = -0.6 * 1440 Printer.ScaleTop = -0.7 * 1440 Printer.CurrentX = 0 Printer.CurrentY = 0 Cómo testear la línea de comandos Aplicable a partir de Microsoft Visual Basic 4.0 Durante el desarrollo de una aplicación en el entorno integrado de Visual Basic, a veces es necesario probar los parámetros que se le pasan en la línea de comandos. En Visual Basic, se puede indicar la línea de comandos en tiempo de depuración de la siguiente forma: En Visual Basic 4: Seleccione el menú Herramientas. Elija Opciones. Muestre la pestaña Avanzado. Introduzca los parámetros en "Argumentos de la línea de comandos". En Visual Basic 5 y 6: Seleccione el menú Proyecto. Elija la opción Propiedades. Muestre la pestaña Generar. Introduzca los parámetros en "Argumentos de la línea de comandos". Cómo desplazar el cursor hasta el final de una caja de texto Aplicable a partir de Microsoft Visual Basic 4.0 En ocasiones es necesario que cuando el usuario sitúa el foco en una caja de texto, la introducción de datos comience al final del texto previamente introducido. Para desplazar el cursor al final del texto, teclee el siguiente texto en el evento GetFocus de la caja de texto: Private Sub Text1_GotFocus() Text1.SelStart = Len(Text1.Text) End Sub Cómo obtener la operación realizada sobre un formulario modal Aplicable a partir de Microsoft Visual Basic 4.0 A veces es necesario mostrar un formulario modal donde el usuario introduzca una serie de datos y después pulse Aceptar o Cancelar. En función de la operación realizada (Aceptar o Cancelar) se puede mostrar un segundo formulario con más información o con los resultados de la operación. Desafortunadamente, no es posible lanzar otro diálogo desde el formulario modal ya que éste último debe permanecer en primer plano. Para evitar este problema, se puede utilizar una variable booleana en el formulario modal que indique la operación realizada por el usuario. Al descargar el formulario, sus variables no desaparecen sino que siguen memoria, por lo que se pueden consultar desde un segundo formulario y actuar en consecuencia. A continuación se muestra un ejemplo: 1. Añada formularios al proyecto (Form1 y Form2) 2. Sitúe un botón (Command1) en Form1 3. Sitúe dos botones (Command1 y Command2)en Form2 4. Escriba el siguiente código en Form1: Private Command1_Click() Form2.Show vbModal If Form2.Operacion Then MsgBox "Operación A" Else MsgBox "Operación B" End If

Set Form2 = Nothing End Sub 5. Escriba el siguiente código en Form2: Public Operacion as Boolean Private Command1_Click() Operacion = True Unload Me End Sub Private Command2_Click() Operacion = False Unload Me End Sub Ejecute el proyecto y pruebe a pulsar el botón del formulario uno y después a pulsar cualquier botón del formulario dos. Cómo añadir controles dinámicamente en formularios Aplicable a partir de Microsoft Visual Basic 6.0 Hasta Visual Basic 5.0 si se quería añadir un control a un formulario se utilizaba la función Load, que permitía añadir un control a un array ya existente. Esta limitación se ha eliminado de Visual Basic 6.0, y ya es posible añadir y borrar controles a la colección "Controls", sin necesidad de que exista un array ya creado. Además, el nuevo control puede responder a eventos si se define con la palabra "WithEvents". Como muestra, un sencillo ejemplo que crea un botón y se añade código al evento: Dim WithEvents cmdObj1 As CommandButton Private Sub cmdObj1_Click() MsgBox "Esto es un control dinámico" End Sub Private Sub Form_Load() Set cmdObj1 = Form1.Controls.Add("VB.CommandButton", "cmdBoton1") cmdObj1.Caption = "Púlsame" cmdObj1.Left = 1500 cmdObj1.Top = 1000 cmdObj1.Visible = True End Sub Private Sub Form_Unload(Cancel As Integer) Form1.Controls.Remove "cmdBoton1" End Sub Cómo desactivar los repintados de una ventana Aplicable a partir de Microsoft Visual Basic 4.0 32 bits En ocasiones es conveniente que durante un cierto tiempo una ventana determinada no produzca repintados, ya que la información que se quiere mostrar es amplia y no interesa que el usuario vaya viendo cómo se va generando. La función LockWindowUpdate permite inhibir los repintados hasta que se vuelva a llamar de nuevo a esta función con el parámetro NULL. Al llamar a la función LockWindowUpdate, la ventana no procesa los repintados no pudiendo tampoco el usuario moverla de posición. A continuación, se muestra un ejemplo: Cree un nuevo proyecto con dos botones y una caja de texto. Copie el siguiente código en el formulario: Private Declare Function LockWindowUpdate Lib "user32" _ (ByVal hwndLock As Long) As Long Private Sub Command1_Click() LockWindowUpdate Me.hWnd Text1 = "prueba" End Sub Private Sub Command2_Click() LockWindowUpdate 0&

End Sub Pulse el botón Command1. Comprobará que la caja de texto no cambia a pesar de modificar su propiedad Text. Si pulsa el botón Command2 podrá observar cómo se reflejan los cambios. Cómo obtener un puntero a una variable Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Una de las características de Visual Basic que los programadores de C o Pascal echan de menos es el uso de punteros. Visual Basic 5.0 proporciona una serie de funciones no documentadas ni soportadas que permiten obtener un puntero a una variable, a un objeto o una cadena. Con un poco de imaginación y gracias a esta nueva funcionalidad se pueden construir listas enlazadas, árboles, etc., que permitan superar las limitaciones de Visual Basic. A continuación, se describen estas funciones no documentadas: VarPtr(nombre_variable): obtiene un puntero a una variable de tipo Integer, Long, etc., excepto String. StrPtr(nombre_variable_string): obtiene un puntero a una variable de tipo String. ObjPtr(nombre_variable_objeto): obtiene un puntero a una variable de tipo objeto. Ejemplo: Dim x As String * 255 Dim y As New Form1 Dim z As Integer MsgBox StrPtr(x) MsgBox ObjPtr(y) MsgBox VarPtr(z) Cómo registrar/desregistrar controles ActiveX rápidamente Aplicable a partir de Microsoft Visual Basic 4.0 32 bits A continuación, se indica cómo registrar/desregistrar DLLs y OCXs, asociando un tipo de fichero con una acción: Desde el "Explorador de Windows" seleccione en el menú Ver\Opciones y elija la pestaña "Tipos de Archivo". Haga clic en el botón "Nuevo tipo". Rellene el campo "Descripción del tipo". Ejemplos: Ficheros DLL Ficheros OCX Rellene el campo "Extensión asociada". Ejemplos: DLL OCX Haga clic en el botón "Nueva" para añadir una acción al tipo de fichero. Rellene el campo "Acción". Ejemplos: Registrar DeRegistrar En el campo "Aplicación utilizada para realizar la acción" indique la aplicación Regsvr32.exe. Ejemplos: · Para registrar un fichero utilice Regsvr32.exe. · Para desregistrar un fichero utilice Regsvr32.exe /u. Observe que Regsvr32 es sólo para ficheros de 32-bit. Si intenta registrar ficheros de 16-bit ocurrirá un error. Cómo evitar utilizar variables no declaradas Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Visual Basic ofrece la posibilidad de utilizar variables que no han sido declaradas previamente (con la instrucción Dim por ejemplo). Cuando esto ocurre, VB asume que las variables no declaradas son de tipo Variant. El problema de utilizar variables no declaradas es que es complejo depurar una aplicación. Se puede evitar esta situación situando la instrucción Option Explicit en la sección General Declaraciones de un módulo o formulario. Si su código incluye alguna variable no declarada se recibirá un error en tiempo de compilación Cómo rellenar un ComboBox con los meses del año

Aplicable a partir de Microsoft Visual Basic 4.0 32 bits A continuación, se muestra una técnica para llenar de forma sencilla un ComboBox con los meses del año: For i = 1 To 12 Combo1.AddItem Format("28/" & i _ & "/1997", "mmmm") Next Cómo evitar múltiples instancias de una misma aplicación Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Se puede evitar fácilmente que los usuarios ejecuten varias instancias de la misma aplicación, haciendo uso de la propiedad PrevInstance del objeto App: If App.PrevInstance Then MsgBox "La aplicación ya está abierta" Unload Me End If Cómo evitar que los complementos se ejecuten al lanzar Visual Basic Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Cuando se ejecuta Visual Basic 4 o 5, también se ejecutan los complementos seleccionados. Si hay un error en alguno de los complementos, éstos pueden generar fallos de protección general en Visual Basic. Para prevenir que ocurran este tipo de problemas, se pueden desactivar los complementos editando el fichero VBAddin.INI que se encuentra en el directorio WINDOWS. Al editar este fichero, aparecen entradas como la siguiente: AppWizard.Wizard=1 Cambie todos los "1" por "0" y grabe el fichero. Al ejecutar de nuevo VB no se carga ningún complemento. Por supuesto, para añadir o quitar complementos dentro de VB, se recomienda utilizar el Administrador de complementos que se encuentra en el menú Complementos. Cómo limpiar las cajas de texto y otros controles de un formulario Aplicable a partir de Microsoft Visual Basic 4.0 32 bits En ocasiones es necesario limpiar o inicializar todos los campos de un formulario. Si el formulario contiene bastantes controles, esta tarea puede llegar a ser tediosa. La siguiente rutina limpia de forma automática el contenido de cualquier campo en un formulario: Public Sub LimpiarControles(frmForm _ As Form) Dim ctlControl As Object On Error Resume Next For Each ctlControl In frmForm.Controls ctlControl.Text = "" ctlControl.ListIndex = -1 DoEvents Next ctlControl End Sub En el formulario llame a la función de la siguiente forma: LimpiarControles Me Cómo especificar la longitud máxima en un ComboBox Aplicable a partir de Microsoft Visual Basic 4.0 32 bits El control ComboBox no tiene la propiedad MaxLength como una caja de texto. Sin embargo, se puede añadir código para simular esta propiedad. Por ejemplo, pegue el siguiente código en el evento KeyPress de un ComboBox: Private Sub Combo1_KeyPress(KeyAscii As Integer) Const MAXLENGTH = 10 If Len(Combo1.Text) >= MAXLENGTH And _ KeyAscii vbKeyBack Then KeyAscii = 0 End Sub Se puede cambiar la constante MAXLENGTH a cualquier valor que se desee. Cómo mostrar un error de forma detallada al llamar a una API Aplicable a partir de Microsoft Visual Basic 4.0 32 bits La mayor parte de las APIs de 32 bits retornan información detallada sobre el error

producido en caso de fallo. Para obtener esta información en un formato adecuado y útil, se pueden utilizar las funciones de la API GetLastError y FormatMessage. Añada el siguiente código en un módulo de proyecto (.BAS): Option Explicit Public Declare Function GetLastError _ Lib "kernel32" () As Long Public Declare Function FormatMessage _ Lib "kernel32" Alias "FormatMessageA" _ (ByVal dwFlags As Long, _ lpSource As Any, _ ByVal dwMessageId As Long, _ ByVal dwLanguageId As Long, _ ByVal lpBuffer As String, _ ByVal nSize As Long, _ Arguments As Long) As Long Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Public Function InformacionError() As String Dim sError As String * 500 Dim lErrNum As Long Dim lErrMsg As Long lErrNum = GetLastError lErrMsg = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _ ByVal 0&, lErrNum, 0, sError, Len(sError), 0) LastSystemError = Trim(sError) End Function Para comprobar si se produjo algún error al llamar a alguna API utilice el siguiente código: Private Sub Command1_Click() MsgBox InformacionError End Sub Cómo comprobar la existencia de un fichero determinado Aplicable a partir de Microsoft Visual Basic 4.0 32 bits En ocasiones es necesario saber si un fichero existe antes de utilizarlo y evitar futuros problemas. La siguiente función muestra cómo verificar la existencia de un fichero: Public Sub VerificarFichero(_ sNombreFichero As String) On Error Resume Next Open sNombreFichero For Input As #1 If Err Then MsgBox ("El fichero " &_ sNombreFichero & " no existe.") Exit Sub End If Close #1 End Sub Private Sub Command1_Click() VerificarFichero "prueba.txt" End Sub Cómo mostrar colores degradados en un formulario de VB Aplicable a partir de Microsoft Visual Basic 4.0 32 bits ¿Se ha preguntado alguna vez cómo se consigue el efecto de color producido en la pantalla del SETUP.EXE?. Este efecto se denomina degradado o "dithering" y puede ser fácilmente incorporado en sus formularios utilizando la siguiente rutina: Sub Degradado(vForm As Form) Dim intContador As Integer vForm.DrawStyle = vbInsideSolid vForm.DrawMode = vbCopyPen vForm.ScaleMode = vbPixels

vForm.DrawWidth = 2 vForm.ScaleHeight = 256 For intContador = 0 To 255 vForm.Line (0, intContador)-(Screen.Width, _ intContador - 1), RGB(0, 0, 255 - intContador), B Next intContador End Sub Puede llamar a esta función desde el evento Paint del formulario. La rutina muestra un color azul degradado aunque usted puede modificar el color en la función RGB. Si muestra un MsgBox sobre el formulario al que ha aplicado el degradado y mueve la ventana de este MsgBox antes de cerrarla, puede observar efectos extraños en el repintado del formulario. En este caso, se recomienda simular el cuadro de mensaje con un formulario, en cuyo caso el movimiento de la ventana no ocasiona ningún efecto colateral. Cómo implementar la función "Deshacer" en una caja de texto Aplicable a partir de Microsoft Visual Basic 4.0 Cuando se modifica el contenido de una caja de texto, el sistema operativo Windows mantiene un buffer con los datos añadidos o borrados. Se puede utilizar la función de la API SendMessage para recuperar el texto modificado. El mensaje EM_UNDO permite recuperar el texto modificado en una caja de texto. El mensaje EM_EMPTYUNDOBUFFER vacía el buffer de "Deshacer". El mensaje EM_CANUNDO devuelve True si hay texto en el buffer de "Deshacer". A continuación, se muestra un ejemplo: · Cree un nuevo proyecto en Visual Basic. Form1 es creado por defecto. · Añada el siguiente código a la sección "Declaraciones" de Form1: Private Declare Function SendMessage Lib _ "User" (ByVal hWnd As Integer, ByVal wMsg _ As Integer, ByVal wParam As Integer, _ lParam As Long) As Long Const WM_USER = &H400 Const EM_CANUNDO = WM_USER + 22 Const EM_EMPTYUNDOBUFFER = _ WM_USER + 29 Const EM_UNDO = WM_USER + 23 · Añada una caja de texto a Form1. Text1 es creado por defecto. Establezca su propiedad MultiLine a True. · Añada un botón a Form1. Command1 es creado por defecto. Establezca su propiedad Caption a "Undo". · Añada el siguiente código al evento Click de Command1: Private Sub Command1_Click() Dim OK As Long OK = SendMessage(Text1.hWnd, _ EM_UNDO, 0, 0&) OK = SendMessage(Text1.hWnd, _ EM_EMPTYUNDOBUFFER, 0, 0&) End Sub · Añada un segundo botón a Form1. Command2 es creado por defecto. Establezca su propiedad Caption a "Redo". · Añada el siguiente código al evento Click de Command2: Private Sub Command2_Click() Dim OK As Long OK = SendMessage(Text1.hWnd, _ EM_CANUNDO, 0, 0&) If OK = 0 Then MsgBox "No puedo deshacer los cambios", _ 16, "Error" End If OK = SendMessage(Text1.hWnd, _ EM_UNDO, 0, 0&)

End Sub Cómo determinar qué fuentes están instaladas en el sistema Aplicable a partir de Microsoft Visual Basic 4.0 La colección Fonts de los objetos Screen y Printer proporcionan una lista de todas las fuentes instaladas en el sistema operativo. El siguiente ejemplo muestra cómo recuperar las fuentes de pantalla e impresora instaladas: · Cree un nuevo proyecto en Visual Basic. Por defecto, se crea el formulario Form1. · Añada un control Listbox al Form1. Por defecto, la lista tiene el nombre List1. · Añada un botón tipo Command al Form1. Por defecto, el botón tiene el nombre Command1. · Añada un segundo botón tipo Command al Form1. Por defecto, el botón tiene el nombre Command2. · Añada el siguiente código al evento Click de Command1. Private Sub Command1_Click() List1.Clear Dim X As Integer For X = 0 To Printer.FontCount - 1 List1.AddItem Printer.Fonts(X) Next X End Sub · Añada el siguiente código al evento Click de Command2. Private Sub Command2_Click() List1.Clear Dim X As Integer For X = 0 To Screen.FontCount - 1 List1.AddItem Screen.Fonts(X) Next X End Sub Cómo obtener el nombre corto (MS-DOS) a partir del nombre largo de un fichero. Aplicable a partir de Microsoft Visual Basic 4.0 32 bits La API de 32 bits GetShortPathName obtiene el nombre corto de un fichero (formato 8.3) a partir de su nombre largo. Haga la prueba con el siguiente ejemplo: · Cree un nuevo proyecto en Visual Basic. Por defecto, se crea el formulario Form1. · Añada un botón tipo Command al Form1. Por defecto, el botón tiene el nombre Command1. · Añada el siguiente código al evento Click del Command1: Private Sub Command1_Click() Dim sNombreCorto As String * 255 GetShortPathName "C:\Archivos de _ programa\Accesorios\Wordpad.exe",_ sNombreCorto, 255 MsgBox sNombreCorto End Sub ·

Añada el siguiente código en la sección Declaraciones del Form1: Private Declare Function GetShortPathName Lib _ "kernel32" Alias "GetShortPathNameA" (ByVal _ lpszLongPath As String, ByVal lpszShortPath As _ String, ByVal cchBuffer As Long) As _ Long Cómo reproducir un CD de audio Aplicable a partir de Microsoft Visual Basic 4.0 32 bits Desde Visual Basic se puede reproducir un CD de audio mediante el uso de MCI, como se muestra en el siguiente ejemplo para VB 16 bits: 'Introduzca en un formulario un MMControl _ (Multimedia Control) Declare Function mciSendString& Lib _

"MMSYSTEM" (ByVal lpstrCommand$, _ ByVal lpstrReturnStr As Any, ByVal _ wReturnLen%, ByVal hCallBack%) Sub cmdPlay_Click () Dim Resultado As Long Dim PistaActual As Integer 'Apertura del dispositivo Resultado = mciSendString( _ "open cdaudio alias cd wait", _ 0&, 0, 0) 'Establecer formato de tiempo en pistas Resultado = mciSendString("set cd time _ format tmsf", 0&, 0, 0) 'Comenzar desde el principio Resultado = mciSendString("play cd", 0&, 0, 0) 'O reproducir por ejemplo la pista 4 PistaActual = 4 resultado = mciSendString("play cd from" & _ Str (PistaActual) , 0&, 0, 0) End Sub Sub cmdStop_Click () Dim lRet As Long 'Parar reproducción lRet = mciSendString("stop cd wait", 0&, 0, 0) DoEvents 'Procesar evento 'Cerrar dispositivo lRet = mciSendString("close cd", 0&, 0, 0) End Sub Cómo saber si un ejecutable es de Windows o MS-DOS Aplicable a todas las versiones Para saber si un ejecutable es de MS-DOS o Windows, se debe examinar el byte número 25 del fichero EXE. Si contiene el valor 40h es un ejecutable de Windows: Function WinExe (ByVal Exe As String) As Integer Dim fh As Integer Dim t As String * 1 fh = FreeFile Open Exe For Binary As #fh Get fh, 25, t Close #fh WinExe = (Asc(t) = &H40&) End Function Cómo enviar un fichero de Windows 95 a la papelera Aplicable a las versiones 4.0/32 bits y 5.0

Las aplicaciones de 32-bit pueden llamar a la función SHFileOperation de la API de Windows para enviar un fichero a la papelera de reciclaje de Windows95. El siguiente ejemplo muestra cómo utilizar esta función y la instrucción ParamArray de VB: Option Explicit Private Type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAborted As Boolean hNameMaps As Long sProgress As String End Type Private Const FO_DELETE = &H3 Private Const FOF_ALLOWUNDO = &H40 Private Declare Function SHFileOperation _ Lib "shell32.dll" Alias _ "SHFileOperationA" _ (lpFileOp As SHFILEOPSTRUCT) As Long Public Function BorrarFichero(ParamArray _ vntNombreFichero() As Variant) As Long Dim I As Integer Dim sNombreFicheros As String Dim SHOpFichero As SHFILEOPSTRUCT For I = LBound(vntNombreFichero) To _ UBound(vntNombreFichero) sNombreFicheros = sNombreFicheros & _ vntNombreFichero(I) & vbNullChar Next sNombreFicheros = sNombreFicheros & vbNullChar With SHOpFichero .wFunc = FO_DELETE .pFrom = sNombreFicheros .fFlags = FOF_ALLOWUNDO End With BorrarFichero = _ SHFileOperation(SHOpFichero) End Function El argumento ParamArray permite pasar cualquier número de ficheros a la función: ' Borrado de un único fichero Resultado = BorrarFichero("BORRA.ME") ' Borrado de varios ficheros Resultado = BorrarFichero("BORRA.ME", _ PRUEBA1.DOC", "PRUEBA2.TXT") Cómo crear accesos directos -shortcuts- en Windows 95 desde Visual Basic Aplicable a partir de Microsoft Visual Basic 4.0 32 bits La librería STKIT432.DLL que Visual Basic 4.0 instala en el directorio SYSTEM de WINDOWS, incluye la siguiente función para crear accesos directos en el menú inicio de Windows 95. Declare Function fCreateShellLink Lib "STKIT432.DLL" _

(ByVal lpstrFolderName As String, _ ByVal lpstrLinkName As String, _ ByVal lpstrLinkPath As String, _ ByVal lpstrLinkArgs As String) As Long Esta función se puede utilizar para crear un acceso directo en cualquier lugar del disco. El primer parámetro de la función (lpstrFolderName) es relativo a la carpeta Programas del Menú de Inicio. Esto quiere decir que si se pasa un cadena nula como primer parámetro, el acceso directo será creado en la propia carpeta de Programas. De igual manera, se puede navegar desde la carpeta de Programas a cualquier directorio del disco duro. Por ejemplo, el siguiente código creará un acceso directo en el escritorio del usuario: Resultado = fCreateShellLink _ ("..\..\Escritorio", "Bloc de_ notas", "c:\windows\notepad.exe", "") Como crear un grupo de programas: Muy útil para crear instalaciones por ejemplo: Añadir un textbox y hacerlo oculto. Una vez oculto, escribir estas líneas sustituyendo "Nombre del Grupo" por que que se desea crear, y que lo colocamos en Inicio -> Programas. Private Sub Command1_Click() Text1.LinkTopic = "Progman|Progman" Text1.LinkMode = 2 Text1.LinkExecute "[CreateGroup(" + "Nombre del Grupo" + ")]" End Sub Vaciar la carpeta de Documentos de Windows: Inicie un nuevo proyecto y añada el siguiente código: Private Declare Function SHAddToRecentDocs Lib "Shell32" (ByVal lFlags As Long, ByVal lPv As Long) As Long Private Sub Form_Load() SHAddToRecentDocs 0, 0 End Sub Abrir la ventana de Propiedades de agregar o quitar aplicaciones: Añada el siguiente código: Private Sub Command1_Click() X = Shell("Rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl @0") End Sub Uso de Random: La función Rnd o Random posee la virtud de obtener números aleatorios entre 0 y 1: El único inconveniente a la hora de usar Rnd, es que hay que inicializarlo, en otro caso, el resultado de la función Rnd, será siempre el mismo dentro de un determinado ordenador. Por ejemplo, el código: Private Sub Form_Load() Dim Num As Double Num = Rnd MsgBox Num End Sub Nos daría como resultado siempre el mismo número. Para solucionar este problema, debemos escribir la sentencia Randomize antes de llamar a la función Rnd. De esta manera, la función Rnd actuará correctamente. El código quedaría así: Private Sub Form_Load() Dim Num As Double Randomize Num = Rnd MsgBox Num End Sub Calcular la etiqueta o label de un disco duro: Hallar la etiqueta o label del mismo disco duro:

Escribir el siguiente código: 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 = "D:\" Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256) MsgBox "Label de la unidad " & unidad & " = " & cad1 End Sub Imprimir un RichTextBox tal y como se ve: Imprimir un RichTextBox con su formato original. Private Sub Command1_Click() On Error GoTo ErrorDeImpresion Printer.Print "" RichTextBox1.SelPrint Printer.hDC Printer.EndDoc Exit Sub ErrorDeImpresion: Exit Sub End Sub Otra forma: En el Formulario [Form1 por defecto] : Private Sub Form_Load() Dim LineWidth As Long Me.Caption = "Rich Text Box Ejemplo de Impresion" Command1.Move 10, 10, 600, 380 Command1.Caption = "&Imprimir" RichTextBox1.SelFontName = "Arial" RichTextBox1.SelFontSize = 10 LineWidth = WYSIWYG_RTF(RichTextBox1, 1440, 1440) Me.Width = LineWidth + 200 End Sub Private Sub Form_Resize() RichTextBox1.Move 100, 500, Me.ScaleWidth - 200, Me.ScaleHeight 600 End Sub Private Sub Command1_Click() PrintRTF RichTextBox1, 1440, 1440, 1440, 1440 End Sub Crear un módulo y escribir: Private Type Rect Left As Long Top As Long Right As Long Bottom As Long End Type Private Type CharRange cpMin As Long cpMax As Long End Type Private Type FormatRange hdc As Long hdcTarget As Long

rc As Rect rcPage As Rect chrg As CharRange End Type Private Const WM_USER As Long = &H400 Private Const EM_FORMATRANGE As Long = WM_USER + 57 Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72 Private Const PHYSICALOFFSETX As Long = 112 Private Const PHYSICALOFFSETY As Long = 113 Private Declare Function GetDeviceCaps Lib "gdi32" ( _ ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _ (ByVal lpDriverName As String, ByVal lpDeviceName As String, _ ByVal lpOutput As Long, ByVal lpInitData As Long) As Long Public Function WYSIWYG_RTF(RTF As RichTextBox, LeftMarginWidth As Long, _ RightMarginWidth As Long) As Long Dim LeftOffset As Long, LeftMargin As Long, RightMargin As Long Dim LineWidth As Long Dim PrinterhDC As Long Dim r As Long Printer.Print Space(1) Printer.ScaleMode = vbTwips LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _ PHYSICALOFFSETX), vbPixels, vbTwips) LeftMargin = LeftMarginWidth - LeftOffset RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset LineWidth = RightMargin - LeftMargin PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0) r = SendMessage(RTF.hWnd, EM_SETTARGETDEVICE, PrinterhDC, _ ByVal LineWidth) Printer.KillDoc WYSIWYG_RTF = LineWidth End Function Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _ TopMarginHeight, RightMarginWidth, BottomMarginHeight) Dim LeftOffset As Long, TopOffset As Long Dim LeftMargin As Long, TopMargin As Long Dim RightMargin As Long, BottomMargin As Long Dim fr As FormatRange Dim rcDrawTo As Rect Dim rcPage As Rect Dim TextLength As Long Dim NextCharPosition As Long Dim r As Long Printer.Print Space(1) Printer.ScaleMode = vbTwips LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _ PHYSICALOFFSETX), vbPixels, vbTwips) TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, _ PHYSICALOFFSETY), vbPixels, vbTwips) LeftMargin = LeftMarginWidth - LeftOffset TopMargin = TopMarginHeight - TopOffset RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset rcPage.Left = 0 rcPage.Top = 0 rcPage.Right = Printer.ScaleWidth rcPage.Bottom = Printer.ScaleHeight

rcDrawTo.Left = LeftMargin rcDrawTo.Top = TopMargin rcDrawTo.Right = RightMargin rcDrawTo.Bottom = BottomMargin fr.hdc = Printer.hdc fr.hdcTarget = Printer.hdc fr.rc = rcDrawTo fr.rcPage = rcPage fr.chrg.cpMin = 0 fr.chrg.cpMax = -1 TextLength = Len(RTF.Text) Do NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr) If NextCharPosition >= TextLength Then Exit Do fr.chrg.cpMin = NextCharPosition Printer.NewPage Printer.Print Space(1) fr.hDC = Printer.hDC fr.hDCTarget = Printer.hDC Loop Printer.EndDoc r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0)) End Sub 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 Determinar si un fichero existe o no: Escriba el siguiente código: (una de tanta maneras aparte de Dir$()) Private Sub Form_Load() On Error GoTo Fallo x = GetAttr("C:\Autoexec.bat") MsgBox "El fichero existe." Exit Sub Fallo: MsgBox "El fichero no existe." End Sub Capturar la pantalla entera o la ventana activa: Añadir dos botones y escribir el siguiente código: Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Sub Command1_Click() 'Captura la ventana activa keybd_event 44, 0, 0&, 0& End Sub Private Sub Command2_Click() 'Captura toda la pantalla keybd_event 44, 1, 0&, 0& End Sub Salvar el contenido de un TextBox a un fichero en disco: Añada el siguiente código: Private Sub Command1_Click() Dim canalLibre As Integer

'Obtenemos un canal libre que nos dará 'el sistema oparativo para poder operar canalLibre = FreeFile 'Abrimos el fichero en el canal dado Open "C:\fichero.txt" For Output As #canalLibre 'Escribimos el contenido del TextBox al fichero Print #canalLibre, Text1 Close #canalLibre End Sub Como desplegar la lista de un ComboBox automáticamente: Insertar un ComboBox y un Botón en un nuevo proyecto y escribir el siguiente código: Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Sub Form_Load() Combo1.Clear Combo1.AddItem "Objeto 1" Combo1.AddItem "Objeto 2" Combo1.AddItem "Objeto 3" Combo1.AddItem "Objeto 4" Combo1.AddItem "Objeto 5" Combo1.AddItem "Objeto 6" Combo1.AddItem "Objeto 7" Combo1.Text = "Objeto 1" End Sub Private Sub Command1_Click() 'ComboBox desplegado Dim Resp As Long Resp = SendMessageLong(Combo1.hwnd, &H14F, True, 0) End Sub Nota: Resp = SendMessageLong(Combo1.hwnd, &H14F, False, 0) oculta la lista desplegada de un ComboBox, aunque esto sucede también cuando cambiamos el focus a otro control o al formulario. Selección y eliminación de todos los elementos de un ListBox: Insertar un ListBox y dos Botón en un nuevo proyecto. Poner la propiedad MultiSelect del ListBox a "1 - Simple" y escriba el siguiente código: Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Sub Form_Load() List1.AddItem "Texto 1" List1.AddItem "Texto 2" List1.AddItem "Texto 3" List1.AddItem "Texto 4" List1.AddItem "Texto 5" List1.AddItem "Texto 6" List1.AddItem "Texto 7" End Sub Private Sub Command1_Click() 'Seleccion de todo el contenido Dim Resp As Long Resp = SendMessageLong(List1.hwnd, &H185&, True, -1) End Sub Private Sub Command2_Click() 'Eliminacion de todos los elementos seleccionados Dim Resp As Long Resp = SendMessageLong(List1.hwnd, &H185&, False, -1) End Sub Calcular el tamaño de fuentes de letra: Es útil para utilizar con la propiedad Resize sobre los controles al cambiar de resolución de pantalla.

Escribir el siguiente código: Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Sub Form_Load() Dim ObCaps As Long Dim ObDC As Long Dim ObDesktop As Long Dim Cad As String ObDesktop = GetDesktopWindow() ObDC = GetDC(ObDesktop) ObCaps = GetDeviceCaps(ObDC, 88) If ObCaps = 96 Then Cad = "Pequeñas If ObCaps = 120 Then Cad = "Grandes" MsgBox "Fuentes de letra " & Cad End Sub *) Esta función ha sido corregida por un error en las etiquetas, 96 corresponde a pequeñas y 120 a Grandes, agradecimientos a Andrés Moral Gutiérrez por su correción (01/06/1998) 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 Pasar de un TextBox a otro al pulsar Enter: Insertar tres TextBox y escribir el siguiente código: Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Private Sub Text3_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub otra forma: Insertar tres TextBox, cambiar la propiedad KeyPreview del formulario a True y escribir el siguiente código: Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SendKeys "{tab}" KeyAscii = 0 End If End Sub Usar IF THEN ELSE ENDIF en una misma línea:

Insertar un CommandButton y un TextBox y escribir el siguiente código: Private Sub Command1_Click() Dim I As Integer Dim A As String I = 3 A = IIf(I 1, "True", "False") Text1.Text = A End Sub Convertir un texto a mayúsculas o minúsculas: Crear un formulario y situar un TextBox. Escribir: Private Sub Text1_Change() Dim I As Integer Text1.Text = UCase(Text1.Text) I = Len(Text1.Text) Text1.SelStart = I End Sub Presentar la ventana AboutBox (Acerca de) por defecto: Escribir el siguiente código en el formulario: Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long Private Sub Command1_Click() Call ShellAbout(Me.hwnd, "Título Programa", "Copyright 1997, Dueño de la aplicación", Me.Icon) End Sub Incrementar un menú en ejecución: Abrir un proyecto nuevo, y haga doble click sobre el formulario. Meidante el gestór de menús escribir lo siguiente: Caption -> Editor Name -> MnuEditor Pulse Insertar y el botón "->" Caption -> Añadir Name -> MnuAñadir Pulse Insertar Caption -> Quitar Name -> MnuQuitar Enabled -> False Pulse Insertar Caption -> Salir Name -> MnuSalir Pulse Insertar Caption -> Name -> MnuIndex Index -> 0 Pulse Aceptar Escribir el siguiente código en el formulario: Private ultElem As Integer Private Sub Form_Load() ultElem = 0 End Sub Private Sub MnuQuitar_Click() Unload MnuIndex(ultElem) ultElem = ultElem - 1 If ultElem = 0 Then MnuQuitar.Enabled = False End If End Sub Private Sub MnuSalir_Click() End End Sub Private Sub MnuAñadir_Click() ultElem = ultElem + 1

Load MnuIndex(ultElem) MnuIndex(ultElem).Caption = "Menu -> " + Str(ultElem) MnuQuitar.Enabled = True End Sub Cambiar el fondo de Windows desde Visual Basic: Crear un formulario y escribir: Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long Private Sub Form_Load() Dim fallo As Integer fallo = SystemParametersInfo(20, 0, "C:\WINDOWS\FONDO.BMP", 0) 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 Ajustar un Bitmap a la pantalla: Crear un formulario con un BitMap cualquiera y una etiqueta o Label con los atributos que quiera. Escribir lo siguiente: Private Sub Form_Paint() Dim i As Integer For i = 0 To Form1.ScaleHeight Step Picture1.Height For j = 0 To Form1.ScaleWidth Step Picture1.Width PaintPicture Picture1, j, i, Picture1.Width, Picture1.Height Next Next End Sub Private Sub Form_Resize() Picture1.Left = -(Picture1.Width + 200) Picture1.Top = -(Picture1.Height + 200) Label1.Top = 100 Label1.Left = 100 End Sub Detectar la unidad del CD-ROM: Si para instalar una aplicación o ejecutar un determinado software necesitas saber si existe el CD-ROM:. Crear un formulario con una etiqueta y escribir lo siguiente: Option Explicit Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6 Function StripNulls(startStrg$) As String Dim c%, item$ c% = 1 Do If Mid$(startStrg$, c%, 1) = Chr$(0) Then item$ = Mid$(startStrg$, 1, c% - 1)

startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$)) StripNulls$ = item$ Exit Function End If c% = c% + 1 Loop End Function Private Sub Form_Load() Dim r&, allDrives$, JustOneDrive$, pos%, DriveType& Dim CDfound As Integer allDrives$ = Space$(64) r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$) allDrives$ = Left$(allDrives$, r&) Do pos% = InStr(allDrives$, Chr$(0)) If pos% Then JustOneDrive$ = Left$(allDrives$, pos%) allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$)) DriveType& = GetDriveType(JustOneDrive$) If DriveType& = DRIVE_CDROM Then CDfound% = True Exit Do End If End If Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM If CDfound% Then label1.Caption = "La unidad de CD-ROM corresponde a la unidad: " & UCase$(JustOneDrive$) Else label1.Caption = "Su sistema no posee CD-ROM o unidad no encontrada." End If End Sub Calcular la profundidad de color (bits por pixel) y resolución 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() Dim col, bit, largo, alto As Integer col = GetDeviceCaps(Form1.hdc, 12) If col = 1 Then bit = GetDeviceCaps(Form1.hdc, 14) If bit = 1 Then Text1.Text = "Resolucion de 1 bit / 2 colores" ElseIf bit = 4 Then Text1.Text = "Resolucion de 4 bits / 16 colores" End If ElseIf col = 8 Then Text1.Text = "Resolucion de 8 bits / 256 colores" ElseIf col = 16 Then Text1.Text = "Resolucion de 16 bits / 65000 colores" Else Text1.Text = "Resolucion de 16 M colores" End If largo = GetDeviceCaps(Form1.hdc, 8) alto = GetDeviceCaps(Form1.hdc, 10) Text1.Text = Text1.Text & " " & largo & "x" & alto & " pixels" 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 Crear una ventana con la información del Sistema: Crear un formulario e insertar un módulo y escribir en el formulario lo siguiente: Private Sub Form_Load() Dim msg As String MousePointer = 11 Dim verinfo As OSVERSIONINFO verinfo.dwOSVersionInfoSize = Len(verinfo) ret% = GetVersionEx(verinfo) If ret% = 0 Then MsgBox "Error Obteniendo Information de la Version" End End If Select Case verinfo.dwPlatformId Case 0 msg = msg + "Windows 32s " Case 1 msg = msg + "Windows 95 " Case 2 msg = msg + "Windows NT " End Select ver_major$ = verinfo.dwMajorVersion ver_minor$ = verinfo.dwMinorVersion build$ = verinfo.dwBuildNumber msg = msg + ver_major$ + "." + ver_minor$ msg = msg + " (Construido " + build$ + ")" + vbCrLf + vbCrLf Dim sysinfo As SYSTEM_INFO GetSystemInfo sysinfo msg = msg + "CPU: " Select Case sysinfo.dwProcessorType Case PROCESSOR_INTEL_386 msg = msg + "Procesador Intel 386 o compatible." + vbCrLf Case PROCESSOR_INTEL_486 msg = msg + "Procesador Intel 486 o compatible." + vbCrLf Case PROCESSOR_INTEL_PENTIUM msg = msg + "Procesador Intel Pentium o compatible." + vbCrLf Case PROCESSOR_MIPS_R4000 msg = msg + "Procesador MIPS R4000." + vbCrLf Case PROCESSOR_ALPHA_21064 msg = msg + "Procesador DEC Alpha 21064." + vbCrLf Case Else msg = msg + "Procesador (desconocido)." + vbCrLf End Select msg = msg + vbCrLf Dim memsts As MEMORYSTATUS Dim memory& GlobalMemoryStatus memsts memory& = memsts.dwTotalPhys msg = msg + "Memoria Fisica Total: "

msg = msg + Format$(memory& \ 1024, "###,###,###") memory& = memsts.dwAvailPhys msg = msg + "Memoria Fisica Disponible: " msg = msg + Format$(memory& \ 1024, "###,###,###") memory& = memsts.dwTotalVirtual msg = msg + "Memoria Virtual Total: " msg = msg + Format$(memory& \ 1024, "###,###,###") memory& = memsts.dwAvailVirtual msg = msg + "Memoria Virtual Disponible: " msg = msg + Format$(memory& \ 1024, "###,###,###") vbCrLf MsgBox msg, 0, "Acerca del Sistema" MousePointer = 0 End End Sub Escribir lo siguiente en el módulo: Type SYSTEM_INFO dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOrfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long dwReserved As Long End Type Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS) Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO) Public Const PROCESSOR_INTEL_386 = 386 Public Const PROCESSOR_INTEL_486 = 486 Public Const PROCESSOR_INTEL_PENTIUM = 586 Public Const PROCESSOR_MIPS_R4000 = 4000 Public Const PROCESSOR_ALPHA_21064 = 21064 Mostrar un fichero AVI a pantalla completa: Crear un formulario y escribir: Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String,

+ "Kb" + vbCrLf + "Kb" + vbCrLf + "Kb" + vbCrLf + "Kb" + vbCrLf +

ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Sub Form_Load() CmdStr$ = "play e:\media\avi\nombre.avi fullscreen" ReturnVal& = mciSendString(CmdStr$, 0&, 0, 0&) End Sub Crear un link con un programa añadiéndolo al grupo de programas situado en Inicio -> Programas o Start -> Programs: Crear un formulario y escribir: Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long Private Sub Form_Load() iLong = fCreateShellLink("", "Visual Basic", "C:\Archivos de Programa\DevStudio\Vb\vb5.exe", "") 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 Borrar un fichero y enviarlo a la papelera de reciclaje: Crear un formulario y escribir el siguiente código: Private Type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Boolean hNameMappings As Long lpszProgressTitle As String End Type Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Private Const FO_DELETE = &H3 Private Const FOF_ALLOWUNDO = &H40 Public Sub PapeleraDeReciclaje(ByVal Fichero As String) Dim SHFileOp As SHFILEOPSTRUCT Dim RetVal As Long With SHFileOp .wFunc = FO_DELETE .pFrom = FileName .fFlags = FOF_ALLOWUNDO End With RetVal = SHFileOperation(SHFileOp)

End Sub Private Sub Form_Load() Recycle "c:\a.txt" End Sub El programa preguntará si deseamos o no eliminar el fichero y enviarlo a la papelera de reciclaje. El parámetro .fFlags nos permitirá recuperar el fichero de la papelera si lo deseamos. Si eliminamos esta línea, el fichero no podrá ser recuperado. 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 Situar una ScroolBar horizontal en un ListBox: Crear un formulario y escribir el siguiente código: Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Sub Form_Load() Dim x As Integer, i As Integer For i = 1 To 20 List1.AddItem "El número final de la selección es el " & i Next i x = SendMessage(List1.hwnd, &H194, 200, ByVal 0&) End Sub Forzar a un TextBox para que admita únicamente números: Crear un formulario, añadir un TextBox y escribir el siguiente código: Sub Text1_Keypress(KeyAscii As Integer) If KeyAscii Asc("9") Then 'KeyAscii = 8 es el retroceso o BackSpace If KeyAscii 8 Then KeyAscii = 0 End If End If End Sub Forzar a un InputBox para que admita únicamente números: Crear un formulario y escribir el siguiente código: Private Sub Form_Load() Dim Numero As String Do Numero = InputBox("Introduzca un numero:") Loop Until IsNumeric(Numero) MsgBox "El numero es el " & Numero Unload Me End Sub Hacer Drag & Drop de un control (ejemplo de un PictureBox): En un formulario, añadir un PictureBox con una imagen cualquiera y escribir el siguiente código: Private DragX As Integer Private DragY As Integer Sub Form_DragDrop(Source As Control, X As Single, Y As Single) Source.Move (X - DragX), (Y - DragY) End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Si el boton del raton es el derecho, no hacemos nada If Button = 2 Then Exit Sub Picture1.Drag 1 DragX = X

DragY = Y End Sub Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Picture1.Drag 2 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 Ejecuta pausas durante un determinado espacio de tiempo en segundos: Llamada: Espera(5) Sub Espera(Segundos As Single) Dim ComienzoSeg As Single Dim FinSeg As Single ComienzoSeg = Timer FinSeg = ComienzoSeg + Segundos Do While FinSeg > Timer DoEvents If ComienzoSeg > Timer Then FinSeg = FinSeg - 24 * 60 * 60 End If Loop End Sub Editor de texto: Seleccionar todo el texto: Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) Copiar texto: Clipboard.Clear Clipboard.SetText Text1.SelText Text1.SetFocus Pegar texto: Text1.SelText = Clipboard.GetText() Text1.SetFocus Cortar texto: Clipboard.SetText Text1.SelText Text1.SelText = "" Text1.SetFocus Deshacer texto: (Nota: esta operación sólo es eficaz con el control Rich TextBox). En un módulo copie esta línea: Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _ hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long Esta es la instrucción de la función deshacer: UndoResultado = SendMessage(Text1.hwnd, &HC7, 0&, 0&) If UndoResultado = -1 Then Beep MsgBox "Error al intentar recuperar.", 20, "Deshacer texto" End If Seleccionar todo el texto: SendKeys "^A" Copiar texto: SendKeys "^C" Pegar texto: SendKeys "^V" Cortar texto:

SendKeys "^X" Deshacer texto: SendKeys "^Z" 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 Cambiar rápidamente la propiedad Enabled La propiedad Enabled de un objeto se puede alternar fácilmente con una única línea de código: optAlternar.Enabled = NOT optAlternar.Enabled Este código es independiente de la definición de True y False, la cual varía según la versión de VB utilizada. Ya sea que se represente numéricamente (-1 = True; 0 = False) o lógicamente, la operación NOT se adapta para dar el resultado correcto. Evitar el "beep" del [ENTER]

Muchas veces, cuando se ingresa información en una caja de texto y se presiona la tecla [ENTER], se escucha un "beep". Para evitar esto, colocar el código siguiente en el evento KeyPress de la caja de texto: If KeyAscii = Asc(vbCR) Then KeyAscii = 0 End If TextBox de sólo lectura Para hacer que un TextBox sea de sólo lectura, podemos setear su propiedad Enabled a False. Sin embargo, esto le da un feo color gris que habitualmente dificulta. Otra manera de hacerlo, más elegante, es incluir el siguiente código en el evento KeyPress de dicho control (el cual no impide que el usuario coloque el cursor sobre él): KeyAscii = 0 Cantidad de Bytes que Ocupa un Directorio Sub Form_Load() Dim FileName As String Dim FileSize As Currency Dim Directory As String Directory = "c:\windows\" FileName = Dir$(Directory & "*.*") FileSize = 0 Do While FileName "" FileSize = FileSize + FileLen(Directory & FileName) FileName = Dir$ Loop Text1.Text = "Este directorio ocupa la cantidad de bytes = " + Str$(FileSize) End Sub Cantidad de Bytes que Ocupa un Directorio Sub Form_Load() Dim FileName As String Dim FileSize As Currency Dim Directory As String Directory = "c:\windows\" FileName = Dir$(Directory & "*.*") FileSize = 0 Do While FileName "" FileSize = FileSize + FileLen(Directory & FileName) FileName = Dir$ Loop Text1.Text = "Este directorio ocupa la cantidad de bytes = " + Str$(FileSize) 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 Centrar una Ventana Para Centrar una ventana en el medio de la pantalla, colocar el siguiente codigo en el evento Load de un Form: Me.Move (Sreen.Width - Me.Width) / 2, Me.Move (Screen.Height - Me.Height) / 2 Enviar Faxes Utilizando los controles de VB Utilizaremos para ello los controles MAPI Messages y MAPI Session para crear un mensaje de Exchange. Si en el campo de la dirección e-mail empiezas por "Fax: " y continuas con el nº de fax, conseguirás enviar el mensaje a través del servicio MS Fax. Ten cuidado de utilizar un perfil de Exchange que solo incluya el servicio Fax, no el Internet Mail, porque si no intentará enviarlo por los dos sistemas. MAPISession1.LogonUI = False wPerfil = "Configuraciones de MS Exchange" MAPISession1.UserName = wPerfil MAPISession1.SignOn MAPIMessages1.SessionID = MAPISession1.SessionID Sesion = True lblEstado = "Creando mensaje..." MAPIMessages1.ComposeMAPIMessages1.MsgSubject = "" ' No utilizar el campo de texto. Lo intenta imprimir con el Word como ' segunda hoja y falla dando error WordBasic nº 124 (teniendo instalado el Parche) MAPIMessages1.MsgNoteText = "Este es el texto de la prueba....." MAPIMessages1.RecipIndex = 0 MAPIMessages1.RecipIndex = NumDestino MAPIMessages1.RecipType = mapToList MAPIMessages1.RecipDisplayName = Data1.Recordset.Fields(1) MAPIMessages1.RecipAddress = "Fax:" & Data1.Recordset.Fields(0) MAPIMessages1.AttachmentIndex = I MAPIMessages1.AttachmentPosition = I MAPIMessages1.AttachmentPathName = wPath MAPIMessages1.AttachmentName = wName lblEstado = "Enviando mensaje..." MAPIMessages1.Send MAPISession1.SignOff Encriptacion XOR El operador lógico XOR suministra un interesante algoritmo de encriptación, se codifica en la primera llamada y se decodifica en la segunda. Ejemplo: Private Sub Form_Load() Dim s As String s = "Hola!" '//Codifica XORStringEncrypt s, "MiClave" Show Print "Codificado: "; s '//Decodifica XORStringEncrypt s, "MiClave" Print "Decodificado: "; s End Sub Private Sub XORStringEncrypt(s As String, PassWord As String) Dim n As Long Dim i As Long Dim Char As Long n = Len(PassWord) For i = 1 To Len(s) Char = Asc(Mid$(PassWord, (i Mod n) - n * ((i Mod n) = 0), 1)) Mid$(s, i, 1) = Chr$(Asc(Mid$(s, i, 1)) Xor Char)

Next End Sub Leer una Cadena (string) dentro de otra... En particular existen muchos comando tales conmo: CommandString="Source=File.txt;Path=C:\CommonFiles;Title=;..." Resulta que deseamos obtener lo que corresponde a Path= de la cadena anterior. La siguiente función se usa de esta manera: s = GetSubString(CommandString, "Path=", ";") Public Function GetSubString( _ s As String, _ StartDelim As String, _ EndDelim As String _ ) As String Dim nStartDelim As Long Dim nEndDelim As Long nStartDelim = InStr(s, StartDelim) If nStartDelim Then nStartDelim = nStartDelim + Len(StartDelim) nEndDelim = InStr(nStartDelim, s, EndDelim) If nEndDelim Then GetSubString = Mid$(s, nStartDelim, nEndDelim - nStartDelim) End If End If End Function En el siguiente ejemplo, obtengo el nombre de la base de datos de un DataEnvirnment Dim DE As New dePPDMMirror gsDatabaseConnection = DE.cnnPPDMMirror.ConnectionString gsDatabaseName = GetSubString(gsDatabaseConnection, "Source=", ";") Set DE = Nothing Fecha aleatoria A veces es útil, generalmente para pruebas, generar una fecha aleatoria dentro de un rango, p.e deseo una fecha entre el 1/1/1960 y 1/1/2000, llamariamos a esta función como MyDate=GetRandomDate("1/1/1960", "1/1/2000") Private Function GetRandomDate(ByVal StartDate As Date, ByVal EndDate As Date) As Date Static AnotherCall As Boolean Dim nDays As Single On Error GoTo ErrorHandler If Not AnotherCall Then Randomize Timer AnotherCall = True End If nDays = DateValue(EndDate) - DateValue(StartDate) GetRandomDate = CDate(DateValue(StartDate) + nDays * Rnd()) Exit Function ErrorHandler: GetRandomDate = Null End Function 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. Incremento continuo Desafortunadamente Visual Basic no tiene operador de incrementación continua, es decir el famoso i++ del lenguaje C. Podamos simular algo parecido: Public Static Function Plus(Optional Start As Variant) As Long Dim i As Long If Not IsMissing(Start) Then i = Start-1 End If i = i + 1 Plus = i End Function Esta pequeña función puede ser extremadamente útil en código para obtener recursos, digamos que es común: Dim I As Long I=100 Caption = LoadResString(I) lblPINCode = LoadResString(1 + I) fraAccount = LoadResString(2 + I) optChecking.Caption = LoadResString(3 + I) optSavings.Caption = LoadResString(4 + I) ... cmdOK.Caption = LoadResString(n + I) Supongamos que hacemos un cambio en el archivo recursos : lblPINCode ya no se usa en el formulario, y compilamos el recurso. Para actualizar el código tendremos que ir línea por línea para actualizar el I + x. - Nada práctico. Mientras que si escribimos: Caption = LoadResString(Plus(100)) lblPINCode = LoadResString(Plus) fraAccount = LoadResString(Plus) optChecking.Caption = LoadResString(Plus) optSavings.Caption = LoadResString(Plus) ... cmdOK.Caption = LoadResString(Plus) La actualización mensionada consistirá solo en eliminar la línea: lblPINCode = LoadResString(PlusI). Mejor imposible Crear Cadenas Multineas de manera practica Pienso que todos nos hemos hartado de escribir s = s + "algo"& vbCrLf & _ ... etc. La siguiente función es una alternativa simple de crear cadenas multiline: Public Function StrChain(ParamArray v() As Variant) As String Dim i As Integer

Dim n As Integer Dim rtn As String n = UBound(v) For i = 0 To n rtn = rtn & v(i) If i < n Then rtn = rtn & vbCrLf End If Next StrChain = rtn End Function P.e: Text1 = StrChain( _ "Hola", _ "cómo", _ "estas") O simplemente Text1 = StrChain( "Hola", "cómo", "estas"), es más cómodo que: Text1 = "Hola"& vbCrLf & "cómo" & VbCrLf & "estas" Claro, suponiendo que las cadenas concatenadas sean extensas, como un SQL o un comando Script. Saber si un archivo es binario o solo texto Algunos archivos tienen extensiones personalizadas y algunas veces debemos evaluar si son o no binarios antes de procesarlos. Public Function IsBinaryFile(File As String) As Boolean Const aLf = 10, aCR = 13, aSP = 32 Const MaxRead = 2 ^ 15 - 1 Dim ff As Integer Dim s As Integer Dim i As Integer Dim n As Integer Dim Rtn As Boolean On Error GoTo IsBinaryFile_Err ff = FreeFile Open File For Binary Access Read As #ff n = IIf(LOF(ff) > MaxRead, MaxRead - 1, LOF(ff)) Do i = i + 1 If i >= n Then IsBinaryFile = False Rtn = True Else s = Asc(Input$(1, #ff)) If s >= aSP Then Else If s = aCR Or s = aLf Then Else IsBinaryFile = True Rtn = True End If End If End If Loop Until Rtn Close ff Exit Function IsBinaryFile_Err: If ff Then Close ff MsgBox "Error verifying file " & File & vbCrLf & Err.Description End Function

Simplemente pase el nombre del archivo al argumento y la función retornata un valor bolean. Por ejemplo MsgBox "¿ Es binario Command.Com ? ... " & IsBinaryFile("command.com"). Saber si un archivo es binario o solo texto Algunos archivos tienen extensiones personalizadas y algunas veces debemos evaluar si son o no binarios antes de procesarlos. Public Function IsBinaryFile(File As String) As Boolean Const aLf = 10, aCR = 13, aSP = 32 Const MaxRead = 2 ^ 15 - 1 Dim ff As Integer Dim s As Integer Dim i As Integer Dim n As Integer Dim Rtn As Boolean On Error GoTo IsBinaryFile_Err ff = FreeFile Open File For Binary Access Read As #ff n = IIf(LOF(ff) > MaxRead, MaxRead - 1, LOF(ff)) Do i = i + 1 If i >= n Then IsBinaryFile = False Rtn = True Else s = Asc(Input$(1, #ff)) If s >= aSP Then Else If s = aCR Or s = aLf Then Else IsBinaryFile = True Rtn = True End If End If End If Loop Until Rtn Close ff Exit Function IsBinaryFile_Err: If ff Then Close ff MsgBox "Error verifying file " & File & vbCrLf & Err.Description End Function Simplemente pase el nombre del archivo al argumento y la función retornata un valor bolean. Por ejemplo MsgBox "¿ Es binario Command.Com ? ... " & IsBinaryFile("command.com"). Como saber si mi form esta abierto... El procedimiento IsLoadForm retorna un bolean que indica si el formulario solicitado por su nombre se encuentra abierto. Opcionalmente se puede hacer activo si se encuentra en memoria. La función es útil en interfaces MDI. Public Function IsLoadForm(ByVal FormCaption As String, Optional Active As Variant) As Boolean Dim rtn As Integer, i As Integer rtn = False Name = LCase(FormCaption) Do Until i > Forms.Count - 1 Or rtn If LCase(Forms(i).Caption) = FormCaption Then rtn = True i = i + 1 Loop If rtn Then If Not IsMissing(Active) Then If Active Then

Forms(i - 1).WindowState = vbNormal End If End If End If IsLoadForm = rtn End Function Como contar los caracteres de una cadena... Option Explicit Function Cuantos(Inicio, Cadena As String, Caracter As String) Dim Resultado, sCuantos sCuantos = 0 'Inicializa la suma 'evita que entre si no hay nada que buscar If IsNull(Cadena) Or IsNull(Caracter) Or Len(Cadena) = 0 Or Len(Caracter)= 0 Then Exit Function Resultado = InStr(Inicio, Cadena, Caracter) 'localiza la 1ª coincidencia Do While Resultado > 0 'y cuenta hasta que termina sCuantos = sCuantos + 1 Inicio = Resultado + 1 Resultado = InStr(Inicio, Cadena, Caracter) Loop Cuantos = sCuantos End Function Obligar a introducir solamente números (I) Private Sub txtText1_KeyPress(KeyAscii As Integer) 'solo admitirá dígitos, el punto y la coma 'si se pulsa alguna otra tecla, anulará la pulsación de teclado If InStr("0123456789.,", Chr(KeyAscii)) = 0 Then KeyAscii = 0 End If End Sub Sub Text1_Keypress(KeyAscii As Integer) If KeyAscii Asc("9") Then 'KeyAscii = 8 es el retroceso o BackSpace If KeyAscii 8 Then KeyAscii = 0 End If End If End Sub Obligar a introducir solamente números (II) Private Sub txtText1_LostFocus() If IsNumeric(txtText1) = False then MsgBox "Lo siento. Debe Ingresar SOLAMENTE Números.",vbInformation,"Cuidado!" txtText1.SetFocus End If Convertir números en texto Esta función, convierte un número en su correspondiente trascripción a letras. Funciona bien con números enteros y con hasta 2 decimales, pero más de 2 decimales se pierde y no "sabe" lo que dice. Debes introducir este código en un módulo (por ejemplo) y realizar la llamada con el número que deseas convertir. Por Ejemplo: Label1 = Numlet(CCur(Text1)) Option Explicit Dim Unidades$(9), Decenas$(9), Oncenas$(9) Dim Veintes$(9), Centenas$(9) Function Numlet$(NUM#) Dim DEC$, MILM$, MILL$, MILE$, UNID$ ReDim SALI$(11) Dim var$, I%, AUX$ 'NUM# = Round(NUM#, 2)

var$ = Trim$(Str$(NUM#)) If InStr(var$, ".") = 0 Then var$ = var$ + ".00" End If If InStr(var$, ".") = Len(var$) - 1 Then var$ = var$ + "0" End If var$ = String$(15 - Len(LTrim$(var$)), "0") + LTrim$(var$) DEC$ = Mid$(var$, 14, 2) MILM$ = Mid$(var$, 1, 3) MILL$ = Mid$(var$, 4, 3) MILE$ = Mid$(var$, 7, 3) UNID$ = Mid$(var$, 10, 3) For I% = 1 To 11: SALI$(I%) = " ": Next I% I% = 0 Unidades$(1) = "UNA " Unidades$(2) = "DOS " Unidades$(3) = "TRES " Unidades$(4) = "CUATRO " Unidades$(5) = "CINCO " Unidades$(6) = "SEIS " Unidades$(7) = "SIETE " Unidades$(8) = "OCHO " Unidades$(9) = "NUEVE " Decenas$(1) = "DIEZ " Decenas$(2) = "VEINTE " Decenas$(3) = "TREINTA " Decenas$(4) = "CUARENTA " Decenas$(5) = "CINCUENTA " Decenas$(6) = "SESENTA " Decenas$(7) = "SETENTA " Decenas$(8) = "OCHENTA " Decenas$(9) = "NOVENTA " Oncenas$(1) = "ONCE " Oncenas$(2) = "DOCE " Oncenas$(3) = "TRECE " Oncenas$(4) = "CATORCE " Oncenas$(5) = "QUINCE " Oncenas$(6) = "DIECISEIS " Oncenas$(7) = "DIECISIETE " Oncenas$(8) = "DIECIOCHO " Oncenas$(9) = "DIECINUEVE " Veintes$(1) = "VEINTIUNA " Veintes$(2) = "VEINTIDOS " Veintes$(3) = "VEINTITRES " Veintes$(4) = "VEINTICUATRO " Veintes$(5) = "VEINTICINCO " Veintes$(6) = "VEINTISEIS " Veintes$(7) = "VEINTISIETE " Veintes$(8) = "VEINTIOCHO " Veintes$(9) = "VEINTINUEVE " Centenas$(1) = " CIENTO " Centenas$(2) = " DOSCIENTOS " Centenas$(3) = " TRESCIENTOS " Centenas$(4) = "CUATROCIENTOS " Centenas$(5) = " QUINIENTOS " Centenas$(6) = " SEISCIENTOS " Centenas$(7) = " SETECIENTOS " Centenas$(8) = " OCHOCIENTOS " Centenas$(9) = " NOVECIENTOS " If NUM# > 999999999999.99 Then Numlet$ = " ": Exit Function

If Val(MILM$) >= 1 Then SALI$(2) = " MIL ": '** MILES DE MILLONES SALI$(4) = " MILLONES " If Val(MILM$) 1 Then Unidades$(1) = "UN " Veintes$(1) = "VEINTIUN " SALI$(1) = Descifrar$(Val(MILM$)) End If End If If Val(MILL$) >= 1 Then If Val(MILL$) < 2 Then SALI$(3) = "UN ": '*** UN MILLON If Trim$(SALI$(4)) "MILLONES" Then SALI$(4) = " MILLON " End If Else SALI$(4) = " MILLONES ": '*** VARIOS MILLONES Unidades$(1) = "UN " Veintes$(1) = "VEINTIUN " SALI$(3) = Descifrar$(Val(MILL$)) End If End If For I% = 2 To 9 Centenas$(I%) = Mid$(Centenas(I%), 1, 11) + "AS" Next I% If Val(MILE$) > 0 Then SALI$(6) = " MIL ": '*** MILES If Val(MILE$) 1 Then SALI$(5) = Descifrar$(Val(MILE$)) End If End If Unidades$(1) = "UNA " Veintes$(1) = "VEINTIUNA" If Val(UNID$) >= 1 Then SALI$(7) = Descifrar$(Val(UNID$)): '*** CIENTOS If Val(DEC$) >= 10 Then SALI$(8) = " CON ": '*** DECIMALES SALI$(10) = Descifrar$(Val(DEC$)) End If End If If Val(MILM$) = 0 And Val(MILL$) = 0 And Val(MILE$) = 0 And Val(UNID$) = 0 Then SALI$(7) = " CERO " AUX$ = "" For I% = 1 To 11 AUX$ = AUX$ + SALI$(I%) Next I% Numlet$ = Trim$(AUX$) End Function Function Descifrar$(numero%) Static SAL$(4) Dim I%, CT As Double, DC As Double, DU As Double, UD As Double Dim VARIABLE$ For I% = 1 To 4: SAL$(I%) = " ": Next I% VARIABLE$ = String$(3 - Len(Trim$(Str$(numero%))), "0") + Trim$(Str$(numero%)) CT = Val(Mid$(VARIABLE$, 1, 1)): '*** CENTENA DC = Val(Mid$(VARIABLE$, 2, 1)): '*** DECENA DU = Val(Mid$(VARIABLE$, 2, 2)): '*** DECENA + UNIDAD UD = Val(Mid$(VARIABLE$, 3, 1)): '*** UNIDAD If numero% = 100 Then SAL$(1) = "CIEN " Else

If CT 0 Then SAL$(1) = Centenas$(CT) If DC 0 Then If DU 10 And DU 20 Then If DC = 1 Then SAL$(2) = Oncenas$(UD): Descifrar$ = Trim$(SAL$(1) + " " + SAL$(2)) then Exit Function If DC = 2 Then SAL$(2) = Veintes$(UD): Descifrar$ = Trim$(SAL$(1) + " " + SAL$(2)) then Exit Function End If SAL$(2) = " " + Decenas$(DC) If UD 0 Then SAL$(3) = "Y " End If If UD 0 Then SAL$(4) = Unidades$(UD) End If Descifrar = Trim$(SAL$(1) + SAL$(2) + SAL$(3) + SAL$(4)) End Function Seleccionar todo el Texto al recibir el Foco Insertar el siguiente Codigo en el evento GotFocus de un TextBox: Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLenght = Len(Text1.Text) End Sub Convertir a Mayúsculas/Minúsculas segun vamos escribiendo Insertar el siguiente Codigo en el evento Change de un control TextBox Private Sub Text1_Change() Dim I as Integer Text1.Text = UCase(Text1.Text) I = Len(Text1.Text) Text1.SelStart(I) End Sub Nota: Si queremos convertir a minusculas, solo hay que cambiar UCase por LCase. Este codigo convierte a mayusculas/minusculas segun vamos escribiendo.Pasar de Decimal a Binario Function DecimalABinario(ByVal valor As Long) As String ' Declaración de variables privadas a la función Dim mayor As Integer Dim retorno As String Dim a As Integer ' Localizamos el mayor exponente mayor = 0 Do While True If 2 ^ mayor > valor Then If mayor > 0 Then mayor = mayor - 1 End If Exit Do End If mayor = mayor + 1 Loop ' Calculamos el valor binario retorno = "" For a = mayor To 0 Step -1 If valor < (2 ^ a) Then retorno = retorno & "0" Else retorno = retorno & "1" valor = valor - (2 ^ a) End If

Next a DecimalABinario = retorno End Function Inhabilitar por un ratito los botones de la barra Inicio: Los eventos Resize suelen tener ejecución asíncrona. Cuando un formulario utiliza controles ActiveX complejos (léase acceso a datos) que toman acciones de redimensionamiento, pueden fallar si el usuario, por ejemplo, maximiza la ventana antes de que termine de cargarse el formulario, o situaciones similares. La siguiente técnica permite evitar este efecto. '//Protect while loading Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Const GWL_STYLE = (-16) Private Const WS_SYSMENU = &H80000 Public Sub EnabledToolBoxMenu(frm As Form, Action As Boolean) Static rtn, rtnI If Action Then If rtnI Then rtn = SetWindowLong(frm.hwnd, GWL_STYLE, rtnI) End If Else rtnI = GetWindowLong(frm.hwnd, GWL_STYLE) rtn = rtnI And Not (WS_SYSMENU) rtn = SetWindowLong(frm.hwnd, GWL_STYLE, rtn) End If End Sub La forma correcta de usar el procedimiento es la siguiente: Private Loading Private Sub Form_Load() Loading=True '//Código de carga... Loading=False EnabledToolBoxMenu Me, True End Sub Private Sub Form_Activate() If Loading Then EnabledToolBoxMenu Me, False End If End Sub NOTA. Se pueden inhabilitar / habilitar separadamente los bótones. API suministra otras constantes similares a WS_SYSMENU. Ver documentación de SetWindowLong. Ejecutar un programa DOS desde VB Private Sub Command1_Click() Shell "C:\WINDOWS\COMMAND\EDIT.COM", vbNormalFocus End Sub Ejecutar Microsoft Word desde VB Hay que hacer automatización, o sea, instanciar un objeto Word Dim oWord as new Word.ApplicationoWord.Visible = True 'Si quieres abrir un documento en blanco o uno concreto oWord.Documents.Add oWord.Documents.Open "" Bloquear el Boton Inicio, Crtl + Tab y Ctrl + Alt + Supr Declarar en un Módulo lo siguiente: Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _ (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long (Ojo, toda esta declaracion debe estar en una sola linea!!)

En el Evento Click del Form1 colocar lo siguiente: Sub Form_Click() Dim blnOld as Boolean If MsgBox ("Desea Bloquear ahora?", vbInformation + vbYesNo, "Bloqueo") = vbYes then SystemParametersInfo 97&, True, blnOld, 0& Else SystemParametersInfo 97&, False, blnOld, 0& End If End Sub Activar/Desactivar el Bloqueo de Mayusculas Solamente necesitamos declarar en un Modulo lo siguiente: Public Declare Function GetKeyboardState Lib "user32" Alias "GetKeyboardState" (pbKeyState As Byte) As Long Public Declare Function SetKeyboardState Lib "user32" Alias "SetKeyboardState" (lppbKeyState As Byte) As Long Public Type KeyboardBytes kbByte(0 To 255) as Byte End Type En el Evento Click de la ventana (Form) colocaremos el siguiente codigo y nos fijaremos en la actitud de la lucecita del Bloqueo de Mayusculas... Private Sub Form_Click() Dim kbArray as KeyboardBytes GetKeyboardState kbArray kbArray.kbByte(&H14) = IIF(kbArray.kbByte(&H14) = 1, 0, 1) SetKeyboardState kbArray End Sub Cómo Activar el Protector de Pantallas? En un modulo, declarar lo siguiente: Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long y en el evento click de un boton: Private Sub Command1_Click() Call SendMessage(Me.hWnd, &H112, &HF140, 0&) End Sub Ocultar / Mostrar la Barra de Herramientas de WIn95/NT Poner el siguiente Codigo en un Modulo: Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (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 (NOTA: Las dos declaraciones deben estar en una misma Linea) Poner dos (2) botones en un Form y escribir: Private Sub Command1_Click() Ventana = FindWindow("Shell_Traywnd", " ") Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Oculta) End Sub Private Sub Command2_Click() Call SetWindowPos(Ventana, 0, 0, 0, 0, 0, Muestra) End Sub Cambiar el Papel Tapiz de Win95 Insertar el siguiente Codigo en un Modulo:

Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long Nota: Debe estar todo en una sola linea (Usar el Visor de Texto API, que viene con Visual Basic) Insertar el siguiente Codigo en el evento Click de un CommandButton Private Sub Command1_Click() Dim Cambio as Integer Cambio = SystemParametersInfo(20, 0, "C:\Windows\Nubes.bmp", 0) 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:[email protected]", vbNullString, vbNullString, SW_SHOW 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") Mover un Archivo a la Papelera en lugar de usar KILL Crear un formulario y escribir el siguiente código (en las declaraciones Generales): Private Type SHFILEOPSTRUCT hWnd As Long

wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Boolean hNameMappings As Long lpszProgressTitle As String End Type Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Private Const FO_DELETE = &H3 Private Const FOF_ALLOWUNDO = &H40 Public Sub PapeleraDeReciclaje(ByVal Fichero As String) Dim SHFileOp As SHFILEOPSTRUCT Dim RetVal As Long With SHFileOp .wFunc = FO_DELETE .pFrom = Fichero .fFlags = FOF_ALLOWUNDO End With RetVal = SHFileOperation(SHFileOp) End Sub Private Sub CommandButton1_Click() PapeleraDeReciclaje "c:\a.txt" End Sub El programa preguntará si deseamos o no eliminar el archivo y enviarlo a la papelera de reciclaje. El parámetro .fFlags nos permitirá recuperar el fichero de la papelera si lo deseamos. Si eliminamos esta línea, el fichero no podrá ser recuperado. Deshabilitar el ingreso de texto en ciertos TextBox... Private Sub txtCampo_KeyPress(KeyAscii As Integer) keyascii=0 End Sub Insertar el siguiente Codigo en un Modulo: Declare Function mciExecute Lib "winmm.dll" ( ByVal lpstrCommand As String) Insertar el siguiente codigo en el boton del formulario: Private Sub Command1_Click() iResult = mciExecute(" Play C:\WINDOWS\RINGIN.WAV") End Sub Escuchar un Archivo MIDI / WAV (2) Primero tienes que insertar un MMControl en el formulario. Luego, en propiedades lo haces invisible. Haz doble click en el formulario y activa la opción LOAD, que se refiere a cuando se carga el formulario. Finalmente escribe lo siguiente: MMCONTROL1.FILENAME=("ruta y nombre del archivo Mid") MMCONTROL1.COMMAND=OPEN 'para abrir el control MMCONTROL1.COMMAND=PLAY 'para iniciar la ejecución MMCONTROL1.COMMAND=STOP 'para parar la ejecución MMCONTROL1.COMMAND=CLOSE 'para cerrar el control 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!! Imprimir una imagen Ejemplo. El modo de escala en que se trabaja es Pixeles, el modo de impresión es Centímetros, y se imprimirá el contenido creado en un PictureBox usando métodos gráficos (PSet, Line, Circle, ...). Si se desea imprimir el Picture, simplemente en vez de Image, usamos Picture (esta resaltado con cursiva). Se imprime en una área de 4 por 4 cm, con margen 1 cm a la izquierda, 1 cm arriba. ptrX1 = 1 '//cm ptrX2 = 5 '//cm ptrY1 = 1 '//cm ptrY2 = 5 '//cm ... With pic_AnyName Printer.ScaleMode = vbCentimeters .Parent.ScaleMode = vbCentimeters .ScaleMode = vbCentimeters Printer.PaintPicture .Image, _ ptrX1, ptrY1, (ptrX2 - ptrX1), (ptrY2 - ptrY1), _ 0, 0, .Width, .Height, vbSrcCopy .Parent.ScaleMode = vbPixels .ScaleMode = vbPixels End With Imprimir archivos "PRN" Los archivos PRN son trabajos de impresora generados por Windows en conjunto con el Driver de alguna Impresora. Para generarlos, creamos una Impresora con salida a archivo. Así, podemos generar un archivo de impresora en vez de enviar directamente la salida a Printer. El siguiente procedimiento ejecuta la tarea de Impresión: Private CancelPrinting As Boolean Private Sub PrintPRNFile(PRNFile As String) Const Buffer As Long = 8192 Dim Chunk As String Dim numLoops As Long Dim LeftOver As Long Dim i As Long Dim FCnl As Long Dim PCnl As Long On Error GoTo SubErr '//Abre el archivo y el port de impresora Screen.MousePointer = vbHourglass CancelPrinting = False FCnl = FreeFile Open PRNFile For Binary Access Read As #FCnl PCnl = FreeFile Open CStr(Printer.Port) For Binary Access Write As #PCnl '//Calcula el tamaño del archivo numLoops = LOF(1) \ Buffer LeftOver = LOF(1) Mod Buffer '//lo imprime Chunk = Space$(Buffer) For i = 1 To numLoops Get #FCnl, , Chunk Put #PCnl, , Chunk DoEvents If CancelPrinting Then Exit For Next If Not CancelPrinting Then

Chunk = Space$(LeftOver) Get #FCnl, , Chunk Put #PCnl, , Chunk End If EndSub: Close #FCnl, #PCnl Screen.MousePointer = vbDefault Exit Sub SubErr: MsgBox Err.Description, vbInformation, "Impresion del archivo..." Resume EndSub End Sub RECOMENDACIONES. Es conveniente colocar un Botón para configurar la Impresora antes de enviar el trabajo (un archivo de impresora debe ejecutarse con el mismo controlador de la impresora que lo creo). Adicionamos un control CommonDialog, y: Private Sub cmdConfig_Click() cdlPrinterSetup.Flags = cdlPDPrintSetup cdlPrinterSetup.ShowPrinter DoEvents End Sub También es conveniente crear la opción de cancelar: Private Sub cmdCancel_Click() CancelPrinting = True End Sub Impresion Directa con VB? Private Sub Command1_Click() Open "LPT1" For Output As #1 Print #1, Chr(27) & "W" & Chr(1); "Hola, mundo" & Chr(27) & "W" & Chr(0) 'Imprime en ancho doble Print #1, Chr(15) & "Nro. de boleta" & Chr(17) 'Imprime condensado Close #1 End Sub Imprimir un TextBox en lineas de X caracteres... Añade un TextBox con las propiedades "Multiline=True" y "ScrollBars=Vertical", y un CommandButton. Haz doble click sobre él y escribe este código: Private Sub Command1_Click() 'X es 60 en este ejmplo ImprimeLineas Text1, 60 End Sub Public Sub ImprimeLineas(Texto As Object, Linea As Integer) Dim Bloque As String 'Numero de caracteres = NumC 'Numero de Bloques = NumB Dim NumC, NumB As Integer NumC = Len(Texto.Text) If NumC > Linea Then NumB = NumC \ Linea For I = 0 To NumB Texto.SelStart = (Linea * I) Texto.SelLength = Linea Bloque = Texto.SelText Printer.Print Bloque Next I Else Printer.Print Texto.Text End If Printer.EndDoc End Sub Imprimir en modo apaisado/vertical:

printer.Orientation=vbPRPRPPortrait 'horizontal printer.Orientation=bPRPLandScape 'vertical Lanzar (o imprimir) un documento de Word cualquiera Con este código, Word no se abre, imprime el doc, se cierra y libera memoria Private Sub Command1_Click() Dim AppWord As Word.Application Dim DocWord As Word.Document 'Asignamos el documento Set AppWord = CreateObject("word.application") Set DocWord = AppWord.Documents.Open("C:\hola.doc") 'Colocamos el texto en el marcador DocWord.Bookmarks("NombreCreador").Select AppWord.Selection.TypeText Text:=Text1.Text 'Imprimimos en segundo plano AppWord.Documents(1).PrintOut Background 'Comprobamos que Word no sigue imprimiendo Do While AppWord.BackgroundPrintingStatus = 1 Loop 'Cerramos el documento sin guardar cambios AppWord.Documents.Close (wdDotNotSaveChanges) 'Liberamos Set DocWord = Nothing 'Nos cargamos el objeto creado AppWord.Quit Set AppWord = Nothing End Sub Imprimir el contenido de un RichTextBox tal como se ve: Insertar el siguiente Codigo en el evento Click de un CommandButton Private Sub Command1_Click() On Error GoTo ElError Printer.Print " " RichTextBox1.SelPrint Printer.hDC Printer.EndDoc ElError: End Sub

Usa esa cadena asi: Var = Microsoft.VisualBasic.Format(Datatimepic... "DD/MM/YYYY HH:MM:SS") Si estas manejando una fecha actual, entonces escribe: Var = Microsoft.VisualBasic.Format(Now, "DD/MM/YYYY HH:MM:SS") Se nota con el viejo estilo del VB60, pero es valido tambien en Visual Basic .NET (2003) y 2005. Suponiendo que Var es del tipo String, debes de tener cuidado que cuando metas una consulta SQL a una BD de SQL Server. Acuerdate que el tipo de dato DateTime o SmallDatetime debe de meterse del siguiente modo: SELECT ("2007-10-05 12:00:00) AS FECHA; Si estas manejando una BD de Orale, el formato de insercion seria asi:

SELECT TOCHAR(FECHA1, "DD/MM/YYYY HH:MM:SS") AS FECHA suponiendo que FECHA1 es del tipo DATE en Oracle. Dudas o comentarios a [email protected]

All the patterns: 0 MM/dd/yyyy

08/22/2006

1 dddd, dd MMMM yyyy

Tuesday, 22 August 2006

2 dddd, dd MMMM yyyy

HH:mm Tuesday, 22 August 2006 06:30

3 dddd, dd MMMM yyyy

hh:mm tt Tuesday, 22 August 2006 06:30 AM

4 dddd, dd MMMM yyyy

H:mm Tuesday, 22 August 2006 6:30

5 dddd, dd MMMM yyyy

h:mm tt Tuesday, 22 August 2006 6:30 AM

6 dddd, dd MMMM yyyy HH:mm:ss

Tuesday, 22 August 2006 06:30:07

7 MM/dd/yyyy HH:mm

08/22/2006 06:30

8 MM/dd/yyyy hh:mm tt

08/22/2006 06:30 AM

9 MM/dd/yyyy H:mm

08/22/2006 6:30

10 MM/dd/yyyy h:mm tt

08/22/2006 6:30 AM

10 MM/dd/yyyy h:mm tt

08/22/2006 6:30 AM

10 MM/dd/yyyy h:mm tt

08/22/2006 6:30 AM

11 MM/dd/yyyy HH:mm:ss

08/22/2006 06:30:07

12 MMMM dd

August 22

13 MMMM dd

August 22

14 yyyy'-'MM'-'dd'T'HH':'mm':'ss.fffffffK

2006-08-22T06:30:07.7199222-04:00

15 yyyy'-'MM'-'dd'T'HH':'mm':'ss.fffffffK

2006-08-22T06:30:07.7199222-04:00

16 ddd, dd MMM yyyy HH':'mm':'ss 'GMT' Tue, 22 Aug 2006 06:30:07 GMT

17 ddd, dd MMM yyyy HH':'mm':'ss 'GMT' Tue, 22 Aug 2006 06:30:07 GMT

18 yyyy'-'MM'-'dd'T'HH':'mm':'ss

2006-08-22T06:30:07

19 HH:mm

06:30

20 hh:mm tt

06:30 AM

21 H:mm

6:30

22 h:mm tt

6:30 AM

23 HH:mm:ss

06:30:07

24 yyyy'-'MM'-'dd HH':'mm':'ss'Z'

2006-08-22 06:30:07Z

25 dddd, dd MMMM yyyy HH:mm:ss

Tuesday, 22 August 2006 06:30:07

26 yyyy MMMM

2006 August

27 yyyy MMMM

2006 August

The patterns for DateTime.ToString ( 'd' ) : 0 MM/dd/yyyy 08/22/2006

The patterns for DateTime.ToString ( 'D' ) : 0 dddd, dd MMMM yyyy Tuesday, 22 August 2006

The patterns for DateTime.ToString ( 'f' ) : 0 dddd, dd MMMM yyyy HH:mm Tuesday, 22 August 2006 06:30

1 dddd, dd MMMM yyyy hh:mm tt Tuesday, 22 August 2006 06:30 AM

2 dddd, dd MMMM yyyy H:mm

Tuesday, 22 August 2006 6:30

3 dddd, dd MMMM yyyy h:mm

tt Tuesday, 22 August 2006 6:30 AM

The patterns for DateTime.ToString ( 'F' ) : 0 dddd, dd MMMM yyyy HH:mm:ss Tuesday, 22 August 2006 06:30:07

The patterns for DateTime.ToString ( 'g' ) : 0 MM/dd/yyyy HH:mm 08/22/2006 06:30

1 MM/dd/yyyy hh:mm tt 08/22/2006 06:30 AM

2 MM/dd/yyyy H:mm

08/22/2006 6:30

3 MM/dd/yyyy h:mm tt 08/22/2006 6:30 AM

The patterns for DateTime.ToString ( 'G' ) : 0 MM/dd/yyyy HH:mm:ss 08/22/2006 06:30:07

The patterns for DateTime.ToString ( 'm' ) : 0 MMMM dd August 22

The patterns for DateTime.ToString ( 'r' ) : 0 ddd, dd MMM yyyy HH':'mm':'ss 'GMT' Tue, 22 Aug 2006 06:30:07 GMT

The patterns for DateTime.ToString ( 's' ) :

0 yyyy'-'MM'-'dd'T'HH':'mm':'ss 2006-08-22T06:30:07

The patterns for DateTime.ToString ( 'u' ) : 0 yyyy'-'MM'-'dd HH':'mm':'ss'Z' 2006-08-22 06:30:07Z

The patterns for DateTime.ToString ( 'U' ) : 0 dddd, dd MMMM yyyy HH:mm:ss Tuesday, 22 August 2006 06:30:07

The patterns for DateTime.ToString ( 'y' ) : ToString("yyyy-MM-dd HH:mm:ss:fff")

El formato DateTime no es si o si "dd/MM/yyyy HH:mm:ss", no pienses en el tipo de dato como si tuviera un formato. El DateTime es un objeto, y tiene las propiedades Day, Month, Year, ...... Cuando vos lo mostras podes hacerlo con el formato que quieras. Asumo que para mostrarlo estaras usando el metodo .ToString(), que te convierte todos esos valores a un texto con el formato predeterminado que tiene tu maquina (lo toma de la configuracion regional), en este caso dd/MM/yyyy HH:mm:ss. En vez de eso podrias hacer asi: .ToString("dd/MM/yyyy HH:mm") y eso te devolveria un texto con la fecha en ese formato (podes poner vos el formato que quieras). Cuidado!. El metodo Parse, que usas para obtener la fecha a partir del texto, tambien varia segun la configuracion de la maquina. Por ejemplo, en tu maquina te devuelve 09 de enero, pero en otra maquina podria devolver 01 de septiembre. Para hacerlo bien, deberias especificar ademas en que formato viene la fecha que contiene el string. Eso lo harias asi: System.IFormatProvider MiFp = new System.Globalization.CultureInfo("es-ES",false); System.DateTime fechaR = new System.DateTime(); fechaR= System.DateTime.ParseExact(fechaReco, "dd/MM/yyyy HH:mm", MiFp); despues, cuando necesites mostrar la fecha en algun lugar, usarias: fechaR.ToString("dd/MM/yyyy HH:mm") Bueno, espero haber ayudado. Chau, suerte!

This C# code snippet displays the date and time in various formats.

using C = System.Console; ... static void Main() { DateTime dateTime = DateTime.Now; C.WriteLine ("d = {0:d}", dateTime ); C.WriteLine ("D = {0:D}", dateTime ); C.WriteLine ("f = {0:f}", dateTime );

// mm/dd/yyyy // month dd, yyyy // day, month dd, yyyy hh:mm

C.WriteLine AM/PM C.WriteLine C.WriteLine C.WriteLine C.WriteLine C.WriteLine (Sortable) C.WriteLine C.WriteLine

("F = {0:F}", dateTime );

// day, month dd, yyyy HH:mm:ss

("g ("G ("M ("R ("s

// // // // //

= = = = =

{0:g}", {0:G}", {0:M}", {0:R}", {0:s}",

dateTime dateTime dateTime dateTime dateTime

); ); ); ); );

("t = {0:t}", dateTime ); ("T = {0:T}", dateTime );

mm/dd/yyyy HH:mm mm/dd/yyyy hh:mm:ss month dd ddd Month yyyy hh:mm:ss GMT yyyy-mm-dd hh:mm:ss

// hh:mm AM/PM // hh:mm:ss AM/PM

// yyyy-mm-dd hh:mm:ss (Sortable) C.WriteLine ("u = {0:u}", dateTime ); // day, month dd, yyyy hh:mm:ss AM/PM C.WriteLine ("U = {0:U}", dateTime ); // month, yyyy (March, 2006) C.WriteLine ("Y = {0:Y}", dateTime ); C.WriteLine ("Month = " + dateTime.Month); // month number (3) // day of week name (Friday) C.WriteLine ("Day Of Week = " + dateTime.DayOfWeek); // 24 hour time (16:12:11) C.WriteLine ("Time Of Day = " + dateTime.TimeOfDay); // (632769991310000000) C.WriteLine("DateTime.Ticks = " + dateTime.Ticks); // Ticks are the number of 100 nanosecond intervals since 01/01/0001 12:00am // Ticks are useful in elapsed time measurement. }

Date and time formatting example (program output) d = 3/3/2006 D = Friday, March 03, 2006 f = Friday, March 03, 2006 4:20 PM F = Friday, March 03, 2006 4:20:26 PM g = 3/3/2006 4:20 PM G = 3/3/2006 4:20:26 PM M = March 03 R = Fri, 03 Mar 2006 16:20:26 GMT

s = 2006-03-03T16:20:26 t = 4:20 PM T = 4:20:26 PM u = 2006-03-03 16:20:26Z U = Friday, March 03, 2006 10:20:26 PM Y = March, 2006 Month = 3 Day Of Week = Friday Time Of Day = 16:20:26.1406250 DateTime.Ticks = 632769996261406250