Trucos y rutinas para
Visual Basic (1ª parte)
Actualizado el 29/Dic/2004
La página con los links de TODOS los trucos
Contenido:
- Todos estos ejemplos y rutinas son de libre uso.
- Si tienes algunos que quieras que se añadan, sólo tienes que enviármelo por e-mail
- Cuando haya una cantidad más o menos "considerable", veré de crear un fichero de ayuda.
- Cualquier comentario SIEMPRE es bienvenido.
- Gracias por colaborar.
1.-Mover un Form sin caption ¡Al fin un método sencillo!
'-------------------------------------------------------------------- 'NOTAS: 'Listado a insertar en un módulo (.bas) 'si se quiere poner en un formulario (.frm) 'declarar la función como Private y quitar el Global de las constantes '-------------------------------------------------------------------- 'Constantes y declaración de función: ' 'Constantes para SendMessage Global Const WM_LBUTTONUP = &H202 Global Const WM_SYSCOMMAND = &H112 Global Const SC_MOVE = &HF010 Global Const MOUSE_MOVE = &HF012 #If Win32 Then Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long #Else Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long #End If ' ' 'Este código se pondrá en el Control_MouseDown... ' Dim lngRet As Long 'Simular que se mueve la ventana, pulsando en el Control If Button = 1 Then 'Envía un MouseUp al Control lngRet = SendMessage(Control.hWnd, _ WM_LBUTTONUP, 0, 0) 'Envía la orden de mover el form lngRet = SendMessage(FormX.hWnd, _ WM_SYSCOMMAND, MOUSE_MOVE, 0) End If
Código para usar en Windows 2000 y Windows XP (29/Dic/04)
Pues eso... aunque sea una "pila" de años después, aquí tienes el código "recomendable" para usar con los sistemas operativos de la familia NT: Windows 2000, Windows XP y Windows 2003.
El tema consiste en usar los valores "adecuados" de las constantes y en utilizar ReleaseCapture... no me preguntes porqué, ya que esta "aportación" la recibí hace años de un "lector", (cuyo nombre no recuerdo, pero si doy con el e-mail en el que me lo dijo lo pondré, ya que suelo guardar todos los correos que recibo), y ayer de casualidad me topé con ella, y como creo que es interesante, la publico ahora... ¡más vale tarde que nunca!
Además, en este ejemplo, he usado varios tipos de controles: Picture, Label y CommandButton para que veas que se puede usar cualquier control para mover el formulario, de hecho utilizo un método genérico para indicarle al Windows de que debe mover el formulario.
Como puedes comprobar en el código, lo mismo da hacerlo en el evento MouseDown que MouseMove.Aquí tienes una captura del formulario en tiempo de diseño y más abajo el código completo.
El formulario en tiempo de diseño
'------------------------------------------------------------------------------ ' Mover un form sin caption, pulsando en cualquier control (27/Mar/00) ' Probado en Windows 2000 y XP ' Actualizado usando un método (29/Dic/04) ' ' ©Guillermo 'guille' Som, 2000-2004 '------------------------------------------------------------------------------ Option Explicit ' Constantes y declaración de función: ' ' Constantes para SendMessage Const WM_SYSCOMMAND As Long = &H112& Const MOUSE_MOVE As Long = &HF012& Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Long) As Long Private Sub cmdCerrar_Click() Unload Me End Sub Private Sub cmdCerrar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' ¡incluso con el botón de cerrar! If Button = vbLeftButton Then moverForm End If End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then moverForm End If End Sub Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then moverForm End If End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then moverForm End If ' ' ' Este código se pondrá en el Control_MouseDown... ' ' (sólo válido si el control tiene hWnd) ' ' ' Dim res As Long ' Const WM_LBUTTONUP As Long = &H202 ' ' ' Simular que se mueve la ventana, pulsando en el Control ' If Button = vbLeftButton Then ' ' Envía un MouseUp al Control ' res = SendMessage(Me.Picture1.hWnd, WM_LBUTTONUP, 0, 0) ' ' Envía la orden de mover el form ' ReleaseCapture ' res = SendMessage(Me.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0) ' End If End Sub Private Sub moverForm() Dim res As Long ' ReleaseCapture res = SendMessage(Me.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0) End Sub
2.-Mover y soltar controles con Drag & Drop (AL FIN!)
'-------------------------------------------------------------------- 'Me ha costado cogerle el tranquillo al tema del Drag & Drop, 'ya que los ejemplos no ayudaban mucho para lo que yo lo quería. 'Se usan: DragOver, DragDrop, MouseDown y MouseUp. 'El único coñazo es tener que poner código en todos los controles... '-------------------------------------------------------------------- 'Variables a nivel del módulo Dim DY As Single Dim DX As Single Private Sub CancelarDrag(Source As Control) Source.Visible = True Source.Drag vbCancel End Sub Private Sub FinalizarDrag(Source As Control, Button As Integer) If Button = vbLeftButton Then Source.Visible = True Source.ZOrder Source.Drag vbEndDrag End If End Sub Private Sub IniciarDrag(Source As Control, Button As Integer, X As Single, Y As Single) If Button = vbLeftButton Then DX = X DY = Y 'Permitir la operación de Drag & Drop Source.Drag vbBeginDrag 'Cambiar a no visible, ya que si no, el form no detectaría que se ha soltado, si el puntero del ratón no sale del control. Source.Visible = False 'Comienza el espectáculo Source.Drag End If End Sub Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single) 'Si se quieren excluir algunos controles, 'hacer aquí la comparación. Source.Visible = True Source.Move X - DX -60, Y - DY -60 Source.Drag vbEndDrag Source.ZOrder End Sub 'En cada control poner este código: (cambiar %Control% por el nombre apropiado) ' Private Sub %Control%_DragDrop(Source As Control, X As Single, Y As Single) CancelarDrag Source End Sub ' Private Sub %Control%_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) IniciarDrag %Control%, Button, X, Y End Sub ' Private Sub %Control%_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) FinalizarDrag %Control%, Button End Sub ' 'Se puede añadir DragOver para que muestre un icono no permitiendo que se suelte. '
3.-Cambiar el tamaño de un Picture usando el API de Windows
'-------------------------------------------------------------------- 'Redimensionar un Picture usando el API de Windows 'Funciones usadas: GetWindowLong, SetWindowLong y SetWindowPos 'El ejemplo tiene en el Form los siguientes objetos: 'Label1() y Text1() en cada PicColumn() 'Label2() en el form '-------------------------------------------------------------------- ' ' Option Explicit 'Prueba para redimensionar Pictures Dim NumColumnas As Integer Dim NumFilas As Integer Dim bIniciando As Boolean #If Win32 Then Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 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 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 #Else Private Declare Function GetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Long Private Declare Function SetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As Long Private Declare Function SetWindowPos Lib "User" (ByVal hwnd%, ByVal hWndInsertAfter%, ByVal X%, ByVal Y%, ByVal cX%, ByVal cY%, ByVal wFlags%) As Integer #End If Const GWL_STYLE = (-16) Const WS_THICKFRAME = &H40000 Const WS_CHILD = &H40000000 Const SWP_DRAWFRAME = &H20 Const SWP_NOMOVE = &H2 Const SWP_NOSIZE = &H1 Const SWP_NOZORDER = &H4 Private Sub Form_Load() Dim Style as Long bIniciando = True Style = GetWindowLong(PicColum(0).hwnd, GWL_STYLE) Style = Style& Or WS_THICKFRAME Style = SetWindowLong(PicColum(0).hwnd, GWL_STYLE, Style) Style = SetWindowPos(PicColum(0).hwnd, _ Me.hwnd, 0, 0, 0, 0, SWP_NOZORDER Or _ SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME) NumFilas = 2 Load Text1(1) Set Text1(1).Container = PicColum(0) Text1(1).Visible = True Text1(1).Top = Text1(0).Top + Text1(0).Height Load Label2(1) Label2(1).Visible = True Label2(1).Top = Label2(0).Top + Label2(0).Height Label2(1) = "Fila 2" NumColumnas = 1 bIniciando = False End Sub Private Sub PicColum_Resize(Index As Integer) Dim k As Integer Dim i As Integer If bIniciando Then Exit Sub 'ajustar el ancho del Label y los texts Label1(Index).Width = PicColum(Index).Width For i = 0 To NumFilas - 1 k = i * NumColumnas + Index Text1(k).Width = PicColum(Index).Width Next PicColum(0).Left = Label2(0).Width For i = 0 To NumColumnas - 1 If i > 0 Then PicColum(i).Left = PicColum(i - 1).Left + PicColum(i - 1).Width End If PicColum(i).Top = 0 Next End Sub
4.-Métodos para usar el CommonDialog de Visual Basic
'-------------------------------------------------------------------- 'Ejemplos de los métodos para Seleccionar Impresora, Abrir, Guardar '-------------------------------------------------------------------- 'Seleccionar impresora On Local Error Resume Next CommonDialog1.CancelError = True CommonDialog1.Flags = cdlPDPrintSetup CommonDialog1.ShowPrinter Err = 0 'Abrir On Local Error Resume Next CommonDialog1.CancelError = True 'Especificar las extensiones a usar CommonDialog1.DefaultExt = "*.crd" CommonDialog1.Filter = "Cardfile (*.crd)|*.crd|Textos (*.txt)|*.txt|Todos los archivos (*.*)|*.*" CommonDialog1.ShowOpen If Err Then 'Cancelada la operación de abrir Else sArchivo = CommonDialog1.FileName End If 'Guardar On Local Error Resume Next CommonDialog1.CancelError = True 'Especificar las extensiones a usar CommonDialog1.DefaultExt = "*.crd" CommonDialog1.Filter = "Cardfile (*.crd)|*.crd|Textos (*.txt)|*.txt|Todos los archivos (*.*)|*.*" CommonDialog1.FileName = sArchivo CommonDialog1.ShowSave If Err Then 'Cancelada la operación de guardar Else sArchivo = CommonDialog1.FileName End If
5.-Crear controles que se pueden cambiar de tamaño usando el API de Windows
'-------------------------------------------------------------------- 'Convertir controles en VENTANAS. Poder cambiar el tamaño, etc. 'Funciones usadas: GetWindowLong, SetWindowLong y SetWindowPos '-------------------------------------------------------------------- ' 'Declaraciones globales a nivel de módulo ' #If Win32 Then Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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 #Else Declare Function GetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Long Declare Function SetWindowLong Lib "User" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Long) As Long Declare Function SetWindowPos Lib "User" (ByVal hwnd%, ByVal hWndInsertAfter%, ByVal X%, ByVal Y%, ByVal cX%, ByVal cY%, ByVal wFlags%) As Integer #End If Global Const GWL_STYLE = (-16) Global Const WS_THICKFRAME = &H40000 Global Const WS_CHILD = &H40000000 Global Const SWP_DRAWFRAME = &H20 Global Const SWP_NOMOVE = &H2 Global Const SWP_NOSIZE = &H1 Global Const SWP_NOZORDER = &H4 Private Sub Form_Load() Dim Style&, ret& 'Cambiar %Control% por el control a usar: (Text, Picture...) Style& = GetWindowLong(%Control%.hWnd, GWL_STYLE) Style& = Style& Or WS_THICKFRAME Style& = SetWindowLong(%Control%.hWnd, GWL_STYLE, Style&) ret& = SetWindowPos(%Control%.hWnd, _ Me.hWnd, 0, 0, 0, 0, SWP_NOZORDER Or _ SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME) End Sub
6.-Extraer iconos usando librerías del API de Windows
'-------------------------------------------------------------------- 'Extraer iconos de una aplicación o librería y dibujarlo en un picture. 'Usando librerías del Api de Windows (ExtractIcon GetClassWord DrawIcon) '-------------------------------------------------------------------- ' 'Declaraciones para extraer iconos de los programas ' 'Versión 32 bits ' 'hIcon el número de icono a extraer, el 0 es el primero. Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long Declare Function GetClassWord Lib "user32" Alias "GetClassWord" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare Function DrawIcon Lib "user32" Alias "DrawIcon" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long Const GCW_HMODULE = (-16&) Function ExtraerIcono (quePicture As Integer, sPrograma As String, queIcon As Long) As Long 'Cargar el icono del programa Dim myhInst As Long Dim hIcon As Long Dim i As Long myhInst = GetClassWord(hWnd, GCW_HMODULE) hIcon = ExtractIcon(myhInst, sPrograma, queIcon) If hIcon Then Picture1(quePicture).Picture = LoadPicture("") Picture1(quePicture).AutoRedraw = -1 i = DrawIcon(Picture1(quePicture).hDC, 0, 0, hIcon) Picture1(quePicture).Refresh End If ExtraerIcono = hIcon End Function ' 'Versión para 16 bits ' 'hIcon el número de icono a extraer, el 0 es el primero. Declare Function ExtractIcon Lib "Shell" (ByVal hInstance As Integer, ByVal pszExeName As String, ByVal hIcon As Integer) As Integer Declare Function GetClassWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer Declare Function DrawIcon Lib "User" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal hIcon As Integer) As Integer Const GCW_HMODULE = (-16) Function ExtraerIcono (quePicture As Integer, sPrograma As String, queIcon As Integer) As Integer 'Cargar el icono del programa Dim myhInst As Integer Dim hIcon As Integer Dim i As Integer myhInst = GetClassWord(hWnd, GCW_HMODULE) hIcon = ExtractIcon(myhInst, sPrograma, queIcon) If hIcon Then Picture1(quePicture).Picture = LoadPicture("") Picture1(quePicture).AutoRedraw = -1 i = DrawIcon(Picture1(quePicture).hDC, 0, 0, hIcon) Picture1(quePicture).Refresh End If ExtraerIcono = hIcon End Function
7.-Añadir a la lista de un Combo el texto escrito
'-------------------------------------------------------------------- 'Añadir a la lista de un combo, el texto escrito, si es que no está. 'Usarlo del tipo: 0-DropDown Combo '-------------------------------------------------------------------- Sub ActualizarCombo() 'Actualizar el contenido del Combo Dim sTmp As String Dim i As Integer Dim j As Integer Dim hallado As Boolean Dim k As Integer For k = 0 To 1 hallado = False sTmp = Combo1(k).Text If Len(Trim$(sTmp)) Then j = Combo1(k).ListCount - 1 For i = 0 To j If StrComp(Trim$(sTmp), Trim$(Combo1(k).List(i))) = 0 Then hallado = True Exit For End If Next If Not hallado Then Combo1(k).AddItem sTmp End If End If Next End Sub
8.-Imitar un Combo Box al estilo del de ayuda.
'-------------------------------------------------------------------- 'Para imitar un ComboBox parecido al de Buscar en Ayuda de Windows, '(va cambiando según las letras escritas). 'El form debe tener un Textbox y un Listbox. '-------------------------------------------------------------------- ' 'Código en un Módulo (.BAS): Option Explicit Global CHClickList As Integer Global CHInChange As Integer Sub CtrlTB_Change (OTB As TextBox, OLB As ListBox) Dim Pos As Integer, I As Integer, L As Integer Dim Aux As String If CHClickList Then CHClickList = False Exit Sub End If Aux = OTB.Text L = Len(Aux) For I = 0 To (OLB.ListCount - 2) If Not StrComp(Aux, Left$(OLB.List(I), L), 1) > 0 Then Exit For End If Next I OLB.TopIndex = I OLB.ListIndex = I End Sub Sub CtrlTB_KeyPress (OTB As TextBox, OLB As ListBox, KeyAscii As Integer) If KeyAscii = 13 Then OTB.Text = Left$(OLB.List(OLB.ListIndex), 60) CHInChange = False Else CHInChange = True End If End Sub Sub CtrlLB_Click (OTB As TextBox, OLB As ListBox) If Not CHInChange Then OTB.Text = Left$(OLB.List(OLB.ListIndex), 60) Else CHInChange = False End If End Sub Sub CtrlLB_MouseDown () CHClickList = True End Sub 'Código en el Form (.FRM): Sub List1_Click () CtrlLB_Click Text1, List1 End Sub Sub List1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) CtrlLB_MouseDown End Sub Sub Text1_Change () CtrlTB_Change Text1, List1 End Sub Sub Text1_KeyPress (KeyAscii As Integer) CtrlTB_KeyPress Text1, List1, KeyAscii End Sub
9.-Scroll horizontal para un List Box usando SendMessage
'-------------------------------------------------------------------- 'Como poner una barra de scroll horizontal en un List Box. '"Truco" tomado de Microsoft Knowledge Base Articles. 'How to Add a Horizontal Scroll Bar to Visual Basic List Box; Article ID: Q80190 'Función: SendMessage '-------------------------------------------------------------------- 'Declaraciones de las funciones para 16 y 32 bits 'Para 16 bits (VB3 y VB4) Declare Function SendMessage Lib "user" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&) As Integer ' 'Para 32 bits usar: 'Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long ' ' 'Poner en Form_Activate Const LB_SETHORIZONTALEXTENT = &H400 + 21 Const NULO = &O0 Dim ListhWnd As Integer 'Handle del List Box Dim ListLen As Integer 'Ancho del List Box Dim iTmp As Integer 'Para el valor devuelto por SendMessage Dim ScaleTmp As Integer 'Valor anterior de ScaleMode ScaleTmp = ScaleMode ScaleMode = 3 'wParam is in PIXEL(3) ListhWnd = List1.hWnd ListLen = 32767 'TextWidth(String$(256, "A")) iTmp = SendMessage(ListhWnd, LB_SETHORIZONTALEXTENT, ListLen, NULO) ScaleMode = ScaleTmp 'Restablecer el valor anterior de ScaleMode
10.-TextBox con 64 KB en lugar de 32 KB
'-------------------------------------------------------------------- 'Usando SendMessage del Api de Windows, poder tener text-box con 64 KB 'en lugar de los 32 que admite Visual Basic. '-------------------------------------------------------------------- 'Declaración de la función API Declare Function sendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long ' 'Para 32 bits usar: 'Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long ' 'Declaración de las constantes Global Const WM_USER = &H400 Global Const EM_LIMITTEXT = WM_USER + 21 'En el Form_Load del text-box: Dim LTmp as long LTmp=SendMessage(Text1.hWnd,EM_LIMITTEXT,0,byval 0&)
11.-Comprobar si un programa cargado con Shell está ejecutandose
'---------------------------------------------------------------------- 'Por ser extenso para un "simple" truco, los ejemplos están comprimidos 'También se muestra como asignar el icono de un programa a un picture 'Hay un fichero para VB4 (16 y 32 bits) y otro para VB3 '---------------------------------------------------------------------- La idea básica es: 1.- Cargar el programa usando Shell 2.- Comprobar si aún está activo (bucle) 3.- Continuar el programa principal una vez finalizado el programa cargado con ShellLas funciones del API de Windows utilizadas son:Para extraer el icono del programa: ExtractIcon GetClassWord DrawIcon Para comprobar las ventanas activas: GetWindow GetWindowText GetWindowTextLength IsWindowVisibleBaja los ejemplos del truco 11: Shell_t.zip (11.606 bytes)
12.- Catálogo de CD's musicales
Ejemplo para leer el volumen de un disco, esta función se puede usar para ¡catalogar los CD's musicales!
Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Dim lVSN As Long, n As Long, s1 As String, s2 As String
s1=String$(255,Chr$(0))
s2=String$(255,Chr$(0))
l= GetVolumeInformation("unidad", s1, Len(s1), lVSN, 0, 0, s2, Len(s2))
'lVSN tendrá el valor del Volume Serial Number (número de serie del volumen)
Si "unidad" es el CD-ROM y tenemos un disco de música, podemos usar el VSN para hacer un catálogo de CD's ya que cada CD tiene un número diferente.Para comprobar si es un CD-ROM (o CD-musical):
' Valores de retorno de GetDriveType Public Const DRIVE_REMOVABLE = 2 Public Const DRIVE_FIXED = 3 Public Const DRIVE_REMOTE = 4 Public Const DRIVE_CDROM = 5 Public Const DRIVE_RAMDISK = 6 Declare Function GetDriveType Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Dim lDrive As Long Dim szRoot As String szRoot="D:\" 'Poner aquí la unidad del CD-ROM o la que queramos comprobar lDrive= GetDriveType(szRoot) If lDrive = DRIVE_CDROM Then 'Es un CD-ROM/Compact-Disc End If
15.- Seleccionar el texto al entrar en un TextBox
Este truco, creo que es conocido por todos, pero lo "recuerdo" por si hay alguno no lo sabe...
'Para un control Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1) End Sub 'Para un array Private Sub Text1_GotFocus(Index As Integer) Text1(Index).SelStart = 0 Text1(Index).SelLength = Len(Text1(Index)) End Sub
16.- Mostrar la posición del cursor en un TextBox
Este truco, muestra la posición actual del cursor y la longitud total del TextBox. Por supuesto el tamaño máximo permitido, debemos asignarlo a Text1.MaxLength, yo lo uso en mis programas, para saber cuando tengo que empezar a abreviar lo que estoy escribiendo, no siempre se dispone de todo el espacio que uno quiere, sobre todo cuando no quieres que las bases de datos se hagan enormes!
'Se puede cambiar StatusBar por cualquier control que nos muestre la información... Private Sub Text1_Click() miForm!StatusBar1.Panels("Posic").Text = " Pos: " & Text1.SelStart + 1 _ & "/" & Text1.MaxLength End Sub Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) miForm!StatusBar1.Panels("Posic").Text = " Pos: " & Text1.SelStart + 1 _ & "/" & Text1.MaxLength End Sub
17.- Refrescar el contenido de un control con DoEvents
¿Cuantas veces has asignado a un Label un nuevo Caption y no lo ha mostrado?, prueba a poner DoEvents después de la asignación y verás como se muestra enseguida.
Puedes usar Sleep 0& en lugar de DoEvents. La explicación de este consejo.
18.- Mostrar el texto de un CheckBox seleccionado cuando está marcado (7/Ene/97)
Bueno, esto no es realmente un truco, pero podría serlo.
Cuando seleccionamos una opción de un CheckBox, algunas veces, nos puede interesar que el texto se quede "marcado".
Por ejemplo, si quisieramos hacer un list box al estilo del que viene con las FM 2.0 de Microsoft. Y que seguramente estará (o ya está?) en VB5El truco consiste en cambiar el color del checkbox cuando este está seleccionado.
Private Sub Check1_Click() If Check1 Then Check1.ForeColor = colForeSelect Check1.BackColor = colBackSelect Else Check1.ForeColor = colForeNormal Check1.BackColor = colBackNormal End If End SubLas variables colForeSelect, colBackSelect, colForeNormal, colBackNormal, deben estar definidas con los colores que queramos usar. Por ejemplo:
Dim colBackNormal As Long Dim colForeNormal As Long Dim colBackSelect As Long Dim colForeSelect As Long colBackNormal = Check1.BackColor colForeNormal = QBColor(0) 'Negro colBackSelect = QBColor(1) 'Azul colForeSelect = QBColor(15) 'Blanco brillanteEjemplo de chk extendido (eje_chk1.zip 1.883 bytes)
19.- Crear una lista de CheckBox, ChkList (8/Ene/97)
Este tipo de control existe en VB5 pero no en los anteriores, salvo que sea en un VBX/OCX externo.
De lo que se trata es de simular un ListBox, pero en lugar de usar sólo un texto como contenido, se usa un CheckBox. En los listados que se acompañan, hay también un ejemplo de cómo crear un panel deslizable (Picture con Scroll). Para que al mover el scroll vertical u horizontal, se desplace el contenido del CheckList, realmente esta es "la madre del cordero". También he creado un Picture dimensionable, usando el API de Windows, para poder cambiar "manualmente" el tamaño del contenedor del ChkList en tiempo de ejecución.Listado del ejemplo de ChkList (chklist.zip 2.811 bytes)
20.- Usa tu computadora para ganar dinero fácil y rápido... (14/Ene/97)
De nuevo Joe LeVasseur... La rutina es para saber si puedes ganar dinero rápido... sin hacer nada.
Public Function Dinero_Rapido() As Boolean Dim Tonto Dim No_Quiere_Trabajar If No_Quiere_Trabajar And Tonto Then Dinero_Rapido = True Else Dinero_Rapido = False Tonto = False End If End Function Private Sub Command1_Click() Print Dinero_Rapido End Sub 'Pruebalo, siempre tiene el mismo resultado.Bueno, como comprenderás, se trata de una broma. Esta "rutina" fue la respuesta de Joe a Jorge E. Mora en las news, a la propuesta de éste último para ganar $$$$$ DINERO RAPIDO $$$$$$
Te prometo que el próximo truco será de "verdad."
21.- Otra forma de usar VScroll y HScroll... (15/Ene/97)
En realidad es comentar que si al asignar los valores Mínimos y Máximos de estos controles de manera que el valor Máximo sea inferior al Mínimo, se desplazarán al revés.
Cuando se usa de la forma habitual, al pulsar en la flecha superior del VScroll, el valor disminuye.
De esta otra forma, al pulsar arriba, se incrementa.