- 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 = "Verdana, Tahoma, 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, "###,###,###") + "Kb" + vbCrLf
memory& = memsts.dwAvailPhys
msg = msg + "Memoria Fisica Disponible: "
msg = msg + Format$(memory& \ 1024, "###,###,###") + "Kb" + vbCrLf
memory& = memsts.dwTotalVirtual
msg = msg + "Memoria Virtual Total: "
msg = msg + Format$(memory& \ 1024, "###,###,###") + "Kb" + vbCrLf
memory& = memsts.dwAvailVirtual
msg = msg + "Memoria Virtual Disponible: "
msg = msg + Format$(memory& \ 1024, "###,###,###") + "Kb" + vbCrLf + 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,
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 -> Programas:

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

- Obtener el nombre de usuario y de la compa?ia de Windows

Crear un formulario, a?adir dos etiquetas o labels y escribir el siguiente c?digo:

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias 
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, 
ByVal lpReserved As Long, lpType As Long, lpData As Any, 
lpcbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias 
"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, 
phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" 
(ByVal hKey As Long) As Long

Private Sub Form_Load()
    Dim strUser As String
    Dim strOrg As String
    Dim lngLen As Long
    Dim lngType As Long
    Dim hKey As Long
    Dim x As Long
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const REG_SZ = &H1
    x = RegOpenKey(HKEY_LOCAL_MACHINE, 
"Software\Microsoft\Windows\CurrentVersion", 
hKey) ' open desired key in registry
    strUser = Space$(256)
    lngLen = Len(strUser)
    x = RegQueryValueEx(hKey, "RegisteredOwner", 
0, lngType, ByVal strUser, lngLen)
    If x = 0 And lngType = REG_SZ And lngLen > 1 Then
        strUser = Left$(strUser, lngLen - 1)
    Else
        strUser = "Unknown"
    End If
    strOrg = Space$(256)
    lngLen = Len(strOrg)
    x = RegQueryValueEx(hKey, "RegisteredOrganization", 0, lngType, 
ByVal strOrg, lngLen)
    If x = 0 And lngType = REG_SZ And lngLen > 1 Then
        strOrg = Left$(strOrg, lngLen - 1)
    Else
        strOrg = "Unknown"
    End If
    Label1.Caption = "Usuario: " & strUser
    Label2.Caption = "Empresa: " & strOrg
    x = RegCloseKey(hKey)
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

- Imprimir el contenido de un TextBox en lםneas de X caracteres

A?adir un TextBox con las propiedades "Multiline=True" y "ScrollBars=Vertical", 
y un CommandButton. Hacer doble click sobre יl y escribir este c?digo:

Private Sub Command1_Click()
    'X es 60 en este ejmplo
    imprimeLineas Text1, 60
End Sub

En las declaraciones "Generales" del formulario, escribimos:

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

- Leer y escribir un fichero Ini 

Declaraciones generales en un m?dulo:

Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA"_
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As_
String ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As_
String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias_
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As_
Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Leer en "Ejemplo.Ini":

Private Sub Form_Load()
    Dim I As Integer
    Dim Est As String
    Est = String$(50, " ")
    I = GetPrivateProfileString("Ejemplo", "Nombre", "", Est, Len(Est), "Ejemplo.ini")
    If I > 0 Then
        MsgBox "Tu Nombre es: " & Est
    End If
End Sub

Escribir en "Prueba.Ini":

Private Sub Form_Unload(Cancel As Integer)
    Dim I As Integer
    Dim Est As String
    Est = "Ejemplo - Apartado"
    I = WritePrivateProfileString("Ejemplo", "Nombre", Est, "Ejemplo.ini")
End Sub

(Nota: si I=0 quiere decir que no existe Informaci?n en la l?nea de fichero Ini a la
que hacemos referencia. El fichero "Ejemplo.Ini" se crear? autom?ticamente).

- Crear una barra de estado sin utilizar controles OCX o VBX

Crear una PictureBox y una HScrollBar:

Propiedades de la HScrollBar:
Max -> 100
Min -> 0

Propiedades de la PictureBox:
DrawMode -> 14 - Merge Pen Not
FillColor -> &H00C00000&
Font -> Verdana, Tahoma, Arial; Negrita; 10
ForeColor -> &H00000000&
ScaleHeight -> 10
ScaleMode -> 0 - User
ScaleWidth -> 100

Insertar en el formulario o m?dulo el c?digo de la funci?n:

Sub Barra(Tam As Integer)
    If Tam > 100 Or Tam <>

Insertar en el evento Change del control HScrollBar:

Private Sub HScroll1_Change()
    Barra (HScroll1.Value)
End Sub

En el evento Paint del formulario, escribir:

Private Sub Form_Paint()
    Barra (HScroll1.Value)
End Sub

- Calcular el espacio total y espacio libre de una Unidad de 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

Crear 7 Labels:

Escribir el c?digo siguiente:

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

- Crear un efecto Shade al estilo de los programas de instalaci?n 

Crear un proyecto nuevo y escribir el c?digo siguiente:

Private Sub Form_Resize()
    Form1.Cls
    Form1.AutoRedraw = True
    Form1.DrawStyle = 6
    Form1.DrawMode = 13
    Form1.DrawWidth = 2
    Form1.ScaleMode = 3
    Form1.ScaleHeight = (256 * 2)
    For i = 0 To 255
       Form1.Line (0, Y)-(Form1.Width, Y + 2), RGB(0, 0, i), BF
       Y = Y + 2
    Next i
End Sub

- Situar el cursor encima de un determinado control (p. ej.: un botףn)

Escribir el c?digo siguiente en el m?dulo:

Declare Sub SetCursorPos Lib "User32" (ByVal X As Integer, ByVal Y As Integer)

Insertar un bot?n en el formulario y escribir el siguiente c?digo:

Private Sub Form_Load()
     X% = (Form1.Left + Command1.Left + Command1.Width / 2 + 60) / Screen.TwipsPerPixelX
     Y% = (Form1.Top + Command1.Top + Command1.Height / 2 + 360) / Screen.TwipsPerPixelY
     SetCursorPos X%, Y%
End Sub

- Men? PopUp en un TextBox

Ejemplo para no visualizar el men? PopUp impl?cito de Windows:

En el evento MouseDown del control TextBox escriba:

Private Sub Editor1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 2 Then
        Editor1.Enabled = False
        PopupMenu MiMenu
        Editor1.Enabled = True
        Editor1.SetFocus
    End If
End Sub

- Hacer sonar un fichero Wav o Midi

Insertar el siguiente c?digo en un m?dulo:

Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Insertar un bot?n en el formulario y escribir el siguiente c?digo:

Private Sub Command1_Click()
    iResult = mciExecute("Play c:\windows\ringin.wav")
End Sub

- Hacer un formulario flotante al estilo de Visual Basic

Crear un nuevo proyecto, insertar un bot?n al formulario que inserte un formulario m?s y un m?dulo.
 Pegue el siguiente c?digo en el 

m?dulo:

Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) 

As Long

Peguar el siguiente c?digo en el formulario principal:

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Unload Form2
End Sub

Private Sub Command1_Click()
   Dim ret As Integer
   If doshow = False Then 
   ret = SetParent(Form2.hWnd, Form1.hWnd) 
   Form2.Left = 0 
   Form2.Top = 0
   Form2.Show 
   doshow = True
      Else
         Form2.Hide
     doshow = False
   End If
End Sub

- Comprobar si el programa ya estב en ejecuciףn

Crear un nuevo proyecto e insertar el siguiente c?digo:

Private Sub Form_Load()
    If App.PrevInstance Then
        Msg = App.EXEName & ".EXE" & " ya est? en ejecuci?n"
        MsgBox Msg, 16, "Aplicaci?n."
        End
    End If
End Sub

- Hallar el nombre del PC en Windows 95 o Windows NT

Cree un nuevo proyecto e inserte dos ButtonClick y un M?dulo:

Pegue el siguiente c?digo en el formulario:

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim nPC as String
    Dim buffer As String
    Dim estado As Long
    buffer = String$(255, " ")
    estado = GetComputerName(buffer, 255)
    If estado <> 0 Then
        nPC = Left(buffer, 255)
    End If
    MsgBox "Nombre del PC: " & nPC
End Sub

Private Sub Command2_Click()
    Unload Form1
End Sub

Pegue el siguiente c?digo en el m?dulo:

Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA"
 (ByVal lpBuffer As String, nSize As Long) As Long

- Eliminar el sonido "Beep" cuando pulsamos Enter en un TextBox

Crear un nuevo proyecto e insertar un TextBox:

Peguar el siguiente c?digo en el formulario:

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Or KeyAscii = 9 Then KeyAscii = 0
End Sub

- Ocultar y mostrar el puntero del ratףn

Crear un nuevo proyecto e insertar dos ButtonClick y un M?dulo:

Pegue el siguiente c?digo en el formulario:

Private Sub Command1_Click()
    result = ShowCursor(False)
End Sub

Private Sub Command2_Click()
    result = ShowCursor(True)
End Sub

Usar las teclas alternativas Alt+O para ocultarlo y Alt+M para mostrarlo.

Peguar el siguiente c?digo en el m?dulo:

Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

- Calcular el nתmero de serie de un disco

Crear un nuevo proyecto e insertar el siguiente c?digo en el formulario:

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 = "C:\"
    Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, flag, cad2, 256)
    MsgBox "Numero de Serie de la unidad " & unidad & " = " & numSerie
End Sub

- Seleccionar todo un procedimiento

 Para seleccionar un procedimiento completo (ya sea para borrarlo o para copiarlo a otro formulario) abrimos la pantalla de edici?n correspondiente y luego hacemos un doble clic en la parte izquierda de la misma (donde el cursor cambia a una flecha apuntando hacia la derecha).

- 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.

- Date y Date$ no son equivalentes

La funci?n Date$ devuelve la fecha del sistema en un string con el formato MM-DD-AAAA. Date devuelve un variant con el formato de fecha especificado en el Panel de Control (puede devolver, por ejemplo, DD-MM-AA). Si queremos realizar c?lculos con fechas, debemos utilizar Date$. Para mostrar la fecha actual al usuario, basta con usar Date (sin el s?mbolo $).

- "Couldn't find installable ISAM"

 En una aplicaci?n que accede a bases de datos, este error indica que VB no encuentra Informaci?n sobre los archivos de acceso a bases de datos. Debemos crear un archivo en la carpeta de Windows con esa Informaci?n: copiar el archivo Vb.INI a dicha subcarpeta, con el nombre de la aplicaci?n ejecutable y la extensi?n INI (por ejemplo, Agenda.INI).

- Evitar la carga de complementos

 Al cargar VB 4 o 5, cualquier complemento (Add-In) activo tambiיn se ejecuta. Si hay un error en alg?n complemento, puede ocurrir un GPF (falla de protecci?n general). Para evitar esto, apagar los complementos antes de cargar VB, editando el archivo VBAddin.INI (en la carpeta de Windows), poniendo un 0 al lado de cada complemento. Por ejemplo: AppWizard.Wizard=0.

- Pasar cadenas de caracteres a una DLL

 VB presenta un problema a la hora de recibir cadenas de caracteres grandes de una DLL. Se produce una sobrecarga que demora el procesamiento, aun cuando ning?n resultado es devuelto. Por esta raz?n, en programas de tiempo cr?tico es necesario salvar este inconveniente pasando cadenas inicializadas con la longitud exacta que se espera recibir.

- Descargar formularios poco utilizados

 Hay que tener en cuenta que, aunque estיn ocultos, los formularios ocupan un espacio de memoria. Tener en memoria un formulario con muchos controles que se usar? una sola vez no resulta una muy buena idea, o sea que no es conveniente ocultarlo. En tal caso, conviene descargarlo despuיs de usado.

- Evitar el uso de las propiedades por defecto

- Comentar e indentar el c?digo

 Realizar comentarios acerca de c?mo funciona una rutina, e indentar el c?digo de la misma para que sea m?s f?cil de leer, son dos acciones que debemos realizar siempre al programar. Un simple rengl?n aclaratorio puede ahorrar horas de prueba y error el d?a de ma?ana. Indentar significa poner cada ciclo repetitivo hacia la derecha, para lo cual basta una presi?n de la tecla [TAB].

- Grabar antes de ejecutar

 Es una buena costumbre de programaci?n el grabar los programas antes de ejecutarlos. Esto es especialmente recomendado en el caso de usar alguna funci?n API, puesto que una mala definici?n de la misma, o el paso incorrecto de alg?n argumento, pueden causar un GPF (Error de protecci?n general) en Visual Basic, e incluso en el mismo Windows.

- Seleccionar varios controles

 Para setear un grupo de propiedades en varios controles, podemos acelerar el trabajo seleccion?ndolos a todos y seteando las propiedades una sola vez. Para ello se "dibuja" un rect?ngulo que contenga a todos los controles a seleccionar. Autom?ticamente, VB mostrar? en la ventana de propiedades s?lo las que son comunes a todos los controles seleccionados, pudiendo setearlas en conjunto.

-  Borrar las variables objeto

 Al terminar de usar una variable que contiene un objeto (por ejemplo, una variable definida As Database) conviene setear su valor a Nothing. Esto libera la memoria ocupada por dicha variable, lo que no siempre ocurre al cerrar el objeto. Por ejemplo:
Dim DB As Database
' Abro la base
Set DB = OpenDatabase ("C:\VB\BIBLIO.MDB")
...
' Cierro
DB.Close
' Libero la memoria
Set DB = Nothing

-  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

-  error al utilizar SetFocus

 Si utilizamos el mיtodo SetFocus sobre un control o formulario que no est? visible o habilitado (propiedad Enabled), Visual Basic puede llegar a colgar nuestra aplicaci?n, si es que no se utiliza control de errores. Antes de usar este mיtodo, hay que asegurarse que el control estי visible y habilitado.

- La excepci?n que confirma la regla

 Si bien el truco del SetFocus funciona casi siempre, hay una excepci?n muy importante, constituida por los mיtodos gr?ficos (Print, Line, Circle y PSet). Al llamar a estos mיtodos no puede usarse la estructura With ... End With, debiיndose anteponer el objeto a dichos mיtodos, aun dentro de dicha estructura. Un ejemplo ser?a:
With Picture

.Move 0, 0

Picture.Print "Hola, Mundo!"
End UIT

- Evitar cadenas nulas en campos de Access

 Si se utiliza una base de datos de Access, los campos alfanumיricos contienen valor NULL hasta tanto se les asigne alg?n valor (aunque sea una cadena vac?a). Si se lee un campo con valor NULL de un RecordSet, asignando su valor a una variable de tipo cadena, se produce un error de ejecuci?n. Para evitar esto, se concatena una cadena vac?a a cada campo en cuanto se lo lee.

-  Usar Sleep en lugar de DoEvents

 En un programa que se ejecuta en Windows 95 o Windows NT, es conveniente usar la funci?n API Sleep. DoEvents pierde parte de su tiempo procesando mensajes del mismo proceso, lo que en un entorno multitarea es innecesario. La declaraci?n de la funci?n es:
Public Declare Sub Sleep Lib "KERNEL32" Alias Sleep (ByVal Milisegundos As Long)
Y se usa de la siguiente manera:
Sleep 0&

-  Error al cambiar el tama?o de los formularios

 Si intentamos cambiar el tama?o de un formulario mientras est? minimizado, obtendremos un error. Para evitar esto, ay que chequear antes todo el estado del formulario. Esto se logra con el siguiente fragmento de c?digo:

If Me.WindowState <> 1 Then




' NO estoy minimizado
' El c?digo para mover o cambiar el tama?o del formulario va aqui.
End If

- No genera eventos al mostrar un MessageBox

Mientras un programa se encuentra mostrando un cuadro de mensaje en la pantalla (generado con la instrucci?n MsgBox) no admite que se produzca ning?n evento. Esto es para prevenir la ejecuci?n de c?digo que podr?a causar problemas, ya que un mensaje de este tipo s?lo deber?a aparecer en contadas ocasiones.

- 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

- Entrar en las Propiedades de Accesibilidad

1. Crear un nuevo formulario, Form1 por defecto
2. A?adir un boton al formulario "Command Button control"
3. A?adir el siguiente codigo a la propieded Clik del boton.

Private Sub Command1_Click()
X = Shell("Rundll32.exe shell32.dll,Control_RunDLL main.cpl @2")
End Sub