Esta utilidad no es nada del otro mundo, incluso puede que no sea realmente útil, ya que el Windows con el menú de inicio hace lo mismo e incluso mejor, pero... Esta utilidad la hice porque el menú de Inicio lo tengo muy "cargado" y realmente es un poco "coñazo" estar buscando las "pocas" utilidades que uso casi a diario... Seguramente te preguntarás como me las he ingeniado en todo el tiempo que no tenía esta utilidad; muy fácil: creando una carpeta con "mis" accesos directos y así tenerlos a mano.
Lo bueno del código de esta utilidad es que tiene unos truquillos que te pueden ser útiles para otras ocasiones, por ejemplo, (aunque esto realmente no tiene nada que ver con el "objetivo" final de la utilidad, pero...), enviar un mail desde VB, (realmente no se envía nada, sino que se abre el programa de mail), o acceder a una dirección de Internet... aunque esto tampoco es nada nuevo, ya que ya está publicado en otro sitio de mi Web...
Entonces ¿cual es el truco Guille? que siempre te lías con tus batallitas...
Pues... ejem... que se muestre el cursor del ratón como una mano al pasar por las etiquetas con los links...
Y como esto, algunas otras cosillas: modificar los menús en tiempo de ejecución, hacer que parte del formulario no sea accesible a pesar de no estar deshabilitados los controles... y... poco más...Veamos ahora que es lo que puede hacer el programa y algo de código y así verás las cosas que pueden serte interesantes...
Este programa se muestra en la barra de tareas, junto al reloj, cuando se pulsa con el botón derecho del ratón se despliega un menú, en el que, además de las opciones propias del programa, hay tres opciones configurables... (¿sólo tres? tanto "pa" esto...) Sí, sólo tres, son las opciones que yo llamo rápidas, ya que están accesibles al momento, pero además de estas tres opciones configurables, hay otro menú en el que se pueden insertar más comandos ejecutables... en el momento de escribir esto hay 16 (de 0 a 15); esta cantidad no es por ningún tipo de restricción, es porque así lo indico, y se puede modificar, siempre que vuelvas a compilar el programa y modifiques el valor asignado a la constante MaxExes.
Para añadir, modificar o borrar los "comandos" de los menús se usa el formulario principal del programa, con ese formulario se gestionan las diferentes opciones de los menús:
Texto a mostrar (descripción)
Orden a ejecutar (comando)
Directorio de inicio (iniciar en)
Por tanto existen tres cajas de texto para especificar cada una de estas cosas. Veamos una imagen del form principal:En los dos listbox se muestran las ordenes a ejecutar en los diferentes menús. Debo aclarar que las tres opciones del menú rápido, (el que se muestra al pulsar con el botón derecho en el icono de la barra de tareas), no se pueden borrar, si se borra, se ponen las que "yo" he indicado como valores por defecto. Se podía hacer que no se mostraran, pero... no lo he hecho.
El otro listbox, (el de la derecha), nos muestra las opciones que estarán disponibles en el submenú de Ejecutables, de este otro menú si se pueden borrar, aunque como mínimo habrá una opción, que si tú no la indicas, será la que "yo" he puesto por defecto. Fíjate que los "yo" los he resaltado, no por nada especial, sino para que sepas, cuando lo leas, que se refieren a mi, el que escribe, no al "mi" que lo lee... je, je... desvaríos que tiene uno de vez en cuando...Sigamos, los elementos de los listbox se pueden cambiar de posición, subirlos y bajarlos... para ello uso un truquillo que me encontré en la Knowledge Base de Microsoft y que he adaptado para esta utilidad.
Para seleccionar el programa, acceso directo o lo que quieras "ejecutar", hay un botón con los típicos tres puntos que te permiten "browsear" por los diferentes discos y carpetas, para ello he usado un sustituto del control CommonDialog: una clase que usa el API y que muestra, (en esta implementación de la clase), el diálogo de abrir.En esta clase hay otras cosillas que te pueden ser útiles, por ejemplo leer y guardar en ficheros INIs, un par de funciones para tratar los nombres de directorios: añadir y quitar la última barra de directorios, trocear un nombre de fichero en los distintos elementos: path, nombre, extensión y alguna otra cosa más.
Para añadir, borrar y modificar los distintos "campos" de cada opción, existen tres botones, cuando estamos manipulando las opciones del "menú rápido", se deshabilita el botón Añadir.
Para saber cual de los dos menús estamos manipulando, hay dos options, los cuales no se pueden manipular directamente... por mucho que pulses en ellos no hacen nada, ya que se cambian automáticamente al seleccionar una opción de cualquiera de los dos listbox.
Para conseguir esto de que no se puedan cambiar los options, lo que he hecho es incluirlos en un Frame que he deshabilitado, además al quitarle el borde parece que no hay frame... lo mismo se podía haber hecho con otro tipo de contenedor, pero los frames consumen menos recursos...Para que se guarden los cambios, y se actualicen los menús, hay que pulsar en el botón guardar, se hace una comprobación para saber si se han manipulado las opciones y de ser así ese botón estaría disponible, si no se ha realizado ningún cambio, estará deshabilitado.
En este formulario no hay nada más, salvo las lineas 3D, las cuales están hechas con un control de usuario que tengo para ello, pero ese control está incluido directamente en el proyecto en lugar de tener que insertarlo desde un control compilado... ¿ventajas? no tener que instalarlo y registrarlo... además es que a mi particularmente, eso de usar OCXs externos no es algo que me guste demasiado...
Además de este formulario, hay otro que se usa para mostrar tanto los Tips del día como para mostrar el Acerca De.
Lo de los tips o sugerencias del día, lo he sacado del formulario de ejemplo que incluye el VB en los "templates", pero adaptado para esta utilidad.
Para poder usar este formulario para propósitos diferentes se hacen una serie de comprobaciones de que es lo que hay que mostrar... bueno, realmente no se comprueba nada, sino lo que hay es un método al que hay que llamar cuando queramos mostrar el AcercaDe y si no se ejecuta ese método se muestran los tips del día.
Cuando muestres el Acerca De, verás que hay dos etiquetas con links, una para enviarme un mensaje (si usas el programa, prueba a enviarme un mensaje y así sabré que los has probado, gracias), y otro link para entrar en mis páginas, además el cursor del ratón cambia a la "típica" mano señaladora de links habitual en el Internet Explorer.
Como puedes comprobar son cosillas simples... je... aunque me ha dado algún que otro quebradero de cabeza.
Ahora vamos a ver parte del código, el cual no necesita explicación adicional, ya que está más o menos bien comentado... alguna vez tendría que seguir los consejos que doy...
Espero que lo disfrutes y que a partir de ahora tengas al Guille en la barra de tareas para que "te vea".
Nos vemos.
Guillermo
P.S.
Espero que los comentarios me los envíes desde el menú Acerca De.
Si quieres el código y el ejecutable para el VB5 SP3, pulsa este link (elGuilleTB.zip 43.3 KB)
24/Feb/2005: Revisado y compilado con Visual Basic 6.0 SP5
El código:
El form principal:
'---------------------------------------------------------------------------------- 'elGuilleTB ( 1/Feb/99) 'Leerlo: el guille te ve, aunque realmente sería: ' el Guille en la barra de tarea (Task Bar) ' 'Utilidad para ejecutar programas desde la barra de tareas ' '©Guillermo 'guille' Som, 1999 <mensaje@elguille.info> ' '---------------------------------------------------------------------------------- 'La revisión es el día y mes 'Versión 01.00.0102 ( 1/Feb/99) Primera versión completamente operativa ' 'Versión 01.00.0202 ( 2/Feb/99) AcercaDe con links al mail y Url ' Uso de ShellExecute para ejecutar los programas, ' ya que de esta forma se pueden ejecutar links, etc. ' Se aceptan ficheros con Drag&Drop. ' Si es un acceso directo (.lnk) se desglosa ' el nombre y el path. ' 'Truco: ' Se usa un Frame con la propiedad Enabled=False para contener los Options ' y no permitir modificarlos, pero mostrándolos normales. ' '---------------------------------------------------------------------------------- Option Explicit ' Para comprobar si se han modificado las opciones Private Modificado As Boolean ' Para mover los elementos de los ListBox Private DragIndex As Integer ' Para indicar que se está cargando el form Private m_Iniciando As Boolean ' Constantes para el tipo de ejecutable Private Enum eQueMenu cRapidos cExes End Enum ' Constantes para el menú mnuExe Private Enum emnuExe cPersonalizar = 0& cSep1 cEjecutables cSep2 cRapido1 cRapido2 cRapido3 cSep3 cTips cAcercaDe cSep5 cSalir End Enum ' Tipo para los ejecutables Private Type tEjecutables Descripcion As String Comando As String IniciarEn As String End Type ' Número máximo de menús Const MaxExes As Long = 15& ' Los ejecutables rápidos Private sRaps(cRapido1 To cRapido3) As tEjecutables ' El resto de ejecutables Private sExes(0 To MaxExes) As tEjecutables ' Para cuando se borra o añade Private tExes(0 To MaxExes) As tEjecutables ' Los ejecutables del menú rápido no se pueden borrar Private sRapsDef(cRapido1 To cRapido3) As tEjecutables ' En los Ejecutables sólo hay un valor por defecto Private sExeDef As tEjecutables ' Fichero de configuración Private sFicIni As String ' Diálogos comunes, etc Private CD As cgsFileOpR '------------------------------------------------------ 'Declaraciones para la barra de tareas de Windows '------------------------------------------------------ ' Código según el ejemplo de Joe LeVasseur '------------------------------------------------------ ' 1997 J.LeVasseur lvasseur@tiac.net a0@null.net ' Un ejemplo de Usar la barra de tareas en Win95/NT4 ' El PictureBox picGancho sirve como gancho de los ' mensajes CallBack del API Shell_NotifyIcon. Tiene ' que ser un control con un hWnd. Todo lo interesante ' esta en el picGancho_MouseMove . Como pueden ver, un ' control MsgHook o MsgBlaster aqui sobra... '------------------------------------------------------ Private Type TIPONOTIFICARICONO cbSize As Long hWnd As Long uId As Long uFlags As Long ucallbackMessage As Long hIcon As Long szTip As String * 64 End Type '------------------ Private Const NIM_ADD = &H0 Private Const NIM_MODIFY = &H1 Private Const NIM_DELETE = &H2 Private Const WM_MOUSEMOVE = &H200 Private Const NIF_MESSAGE = &H1 Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 '-------------------- Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _ Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _ pnid As TIPONOTIFICARICONO) As Boolean '-------------------- Dim t As TIPONOTIFICARICONO ' SendMessage se usa para calcular el alto de los items del listbox 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 ' Función del API para ejecutar cualquier programa, acceso directo o documento Private 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 Private Function ListRowCalc(lstTemp As Control, ByVal Y As Single) As Long Const LB_GETITEMHEIGHT = &H1A1 ' ' Determines the height of each item in ListBox control in pixels Dim ItemHeight As Long ItemHeight = SendMessage(lstTemp.hWnd, LB_GETITEMHEIGHT, 0, 0) ListRowCalc = min(((Y / Screen.TwipsPerPixelY) \ ItemHeight) + _ lstTemp.TopIndex, lstTemp.ListCount - 1) 'Seleccionar el elemento a mover lstTemp.ListIndex = ListRowCalc End Function Private Function min(ByVal X As Long, ByVal Y As Long) As Long ' Devuelve el valor menor de los dos pasados If X > Y Then min = Y Else min = X End Function Private Sub ListRowMove(lstTemp As ListBox, ByVal OldRow As Long, ByVal NewRow As Long) ' Mueve el elemento indicado del listbox pasado por parámetro ' ' Parámetros: ' lstTemp Nombre del listBox a manipular ' OldRow es la fila original ' NewRow es la fila en la que se suelta el elemento ' Dim SaveList As String Dim i As Long Dim tExe As tEjecutables ' Si es la misma línea, no hay nada que hacer If OldRow = NewRow Then Exit Sub ' Guardar el elemento que se quiere mover SaveList = lstTemp.List(OldRow) If lstTemp.Index = cRapidos Then LSet tExe = sRaps(OldRow + cRapido1) Else LSet tExe = sExes(OldRow) End If ' Si la fila actual es mayor que la nueva If OldRow > NewRow Then For i = OldRow To NewRow + 1 Step -1 lstTemp.List(i) = lstTemp.List(i - 1) If lstTemp.Index = cRapidos Then LSet sRaps(i + cRapido1) = sRaps(i - 1 + cRapido1) Else LSet sExes(i) = sExes(i - 1) End If Next i Else ' En caso contrario For i = OldRow To NewRow - 1 lstTemp.List(i) = lstTemp.List(i + 1) If lstTemp.Index = cRapidos Then LSet sRaps(i + cRapido1) = sRaps(i + 1 + cRapido1) Else LSet sExes(i) = sExes(i + 1) End If Next i End If ' Asignar el elemento anterior a la nueva posición lstTemp.List(NewRow) = SaveList ' Asignar los nuevos valores a los menús correspondientes ' El Index del listbox nos indicará cual es el que se está modificando ' Nota: esto sólo servirá para el caso de que el listbox sea un array, ' y en este caso particular con sólo dos elementos. If lstTemp.Index = cRapidos Then LSet sRaps(NewRow + cRapido1) = tExe For i = cRapido1 To cRapido3 mnuExe(i).Caption = sRaps(i).Descripcion Next Else LSet sExes(NewRow) = tExe AsignarExe1 End If 'Seleccionar el elemento dejado lstTemp.ListIndex = NewRow End Sub Private Sub cmdAdd_Click(Index As Integer) ' Añadir, Modificar o Borrar el comando indicado de la lista ' y rambién del array y del menú correspondiente. ' Nota: Este evento se ejecutará siempre que se modifiquen los menús Dim queLista As eQueMenu Dim i As Long Dim j As Long On Local Error Resume Next ' Según la opción marcada será el tipo de menú que se está editando Select Case True Case optExes(cRapidos) queLista = cRapidos Case optExes(cExes) queLista = cExes End Select Select Case Index Case 0 ' Añadir If queLista = cRapidos Then ' En los menús rápidos simplemente se sustituye, ' por tanto llamamos a este mismo evento, pero para Modificar cmdAdd_Click 1 Else ' En los menús de ejecutables se añade (hasta un máximo de MaxExes) ' Cuando estén todos, el ListCount devolverá uno más que MaxExes, ' ya que en realidad se pueden tener de 0 a MaxExes opciones. If lstExes(cExes).ListCount > MaxExes Then MsgBox "No se pueden añadir más ejecutables, tendrás que borrar alguno o modificarlo", vbInformation ' Salir del evento, para dejar como estaba el estado de Modificado Exit Sub Else ' Buscar uno vacío j = -1 For i = 0 To MaxExes If Len(sExes(i).Comando) = 0 Then j = i Exit For End If Next ' Si hay alguno libre, añadirlo If j > -1 Then sExes(j).Descripcion = Trim$(txtExes(0)) sExes(j).Comando = Trim$(txtExes(1)) sExes(j).IniciarEn = Trim$(txtExes(2)) End If ' Ajustar las entradas del menú y el array de los ejecutables AsignarExe1 End If End If Case 1 ' Modificar ' Saber el índice actual del listbox correspondiente i = lstExes(queLista).ListIndex ' Asignar la nueva descripción lstExes(queLista).List(i) = txtExes(0) If queLista = cRapidos Then ' En los menús rápidos simplemente se sustituye i = i + cRapido1 sRaps(i).Descripcion = Trim$(txtExes(0)) sRaps(i).Comando = Trim$(txtExes(1)) sRaps(i).IniciarEn = Trim$(txtExes(2)) mnuExe(i).Caption = sRaps(i).Descripcion Else ' Modificar el seleccionado sExes(i).Descripcion = Trim$(txtExes(0)) sExes(i).Comando = Trim$(txtExes(1)) sExes(i).IniciarEn = Trim$(txtExes(2)) mnuExe1(i).Caption = sExes(i).Descripcion End If Case 2 ' Borrar ' Borrar el item seleccionado de la lista que se está editando i = lstExes(queLista).ListIndex If queLista = cRapidos Then i = i + cRapido1 lstExes(cRapidos).List(i - cRapido1) = sRapsDef(i).Descripcion sRaps(i).Comando = sRapsDef(i).Comando sRaps(i).Descripcion = sRapsDef(i).Descripcion sRaps(i).IniciarEn = sRapsDef(i).IniciarEn mnuExe(i).Caption = sRapsDef(i).Descripcion Else sExes(i).Comando = "" sExes(i).Descripcion = "" sExes(i).IniciarEn = "" ' Ajustar las entradas de los ejecutables AsignarExe1 End If End Select Modificado = True cmdGuardar.Enabled = True End Sub Private Sub cmdCerrar_Click() frmTip.Hide Hide End Sub Private Sub cmdExaminar_Click() ' Buscar el ejecutable Set CD = Nothing Set CD = New cgsFileOpR ' Si se pulsa en cancelar se producirá un error On Local Error Resume Next ' Mostrar el diálogo de abrir With CD .hWnd = Me.hWnd .CancelError = True .DialogTitle = "Seleccionar ejecutable" .Filter = "Ejecutables (*.exe;*.com;*.lnk;*.bat;*.cmd)|*.exe;*.com;*.lnk;*.bat;*.cmd|Todos los archivos (*.*)|*.*" .ShowOpen ' Si no hay error es que se ha pulsado en Aceptar If Err = 0 Then ' Asignar el nombre del fichero seleccionado txtExes(1) = .FileName End If End With End Sub Private Sub cmdGuardar_Click() ' Guardar los datos de configuración Dim i As Long Dim j As Long Dim sTmp As String CD.GuardarIni sFicIni, "Rapidos", "Cantidad", "3" For i = cRapido1 To cRapido3 CD.GuardarIni sFicIni, "Rapidos", "Descripcion" & CStr(i), sRaps(i).Descripcion CD.GuardarIni sFicIni, "Rapidos", "Comando" & CStr(i), sRaps(i).Comando CD.GuardarIni sFicIni, "Rapidos", "IniciarEn" & CStr(i), sRaps(i).IniciarEn Next j = -1 For i = 0 To MaxExes If Len(sExes(i).Descripcion) Then j = j + 1 CD.GuardarIni sFicIni, "Ejecutables", "Descripcion" & CStr(j), sExes(i).Descripcion CD.GuardarIni sFicIni, "Ejecutables", "Comando" & CStr(j), sExes(i).Comando CD.GuardarIni sFicIni, "Ejecutables", "IniciarEn" & CStr(j), sExes(i).IniciarEn End If Next CD.GuardarIni sFicIni, "Ejecutables", "Cantidad", CStr(j) ' Actualizar el flag que indica que no se ha modificado Modificado = False cmdGuardar.Enabled = False End Sub Private Sub Form_Load() ' Sólo permitir una copia del programa If App.PrevInstance Then End End If Dim sTmp As String Dim i As Long Dim j As Long Dim sCopyR As String ' Indicador o flag de que estamos inciando el form m_Iniciando = True Set CD = New cgsFileOpR ' Borrar el contenido de los controles For i = 0 To 2 txtExes(i) = "" Next lstExes(0).Clear lstExes(1).Clear ' Ajustar el caption del form sTmp = App.Major & "." & Format$(App.Minor, "00") & "." & Format$(App.Revision, "0000") sCopyR = " (c)Guillermo 'guille' Som, 1999" If Year(Now) > 1999 Then sCopyR = sCopyR & "-" & Year(Now) End If Caption = App.Title & " v" & sTmp & sCopyR ' Cargar los comandos/ejecutables personalizados ' Fichero de configuración sFicIni = CD.AddBackSlash(App.Path) & "elGuilleTB.ini" ' Leer los ejecutables rápidos (máximo 3) j = Val(CD.LeerIni(sFicIni, "Rapidos", "Cantidad", "0")) ' No permitir más de 3 ejecutables rápidos If j > 3 Then j = 3 ' Asignar los valores por defecto para los Rápidos sRaps(cRapido1).Descripcion = "Bloc de ¬as" sRaps(cRapido1).Comando = "Notepad.exe" sRaps(cRapido1).IniciarEn = "" sRaps(cRapido2).Descripcion = "&Windows Explorer" sRaps(cRapido2).Comando = "EXPLORER.EXE /n,/e,/select,C:\" sRaps(cRapido2).IniciarEn = "" sRaps(cRapido3).Descripcion = "&RegEdit" sRaps(cRapido3).Comando = "REGEDIT.EXE" sRaps(cRapido3).IniciarEn = "" ' Asignar al array de los Rápidos por defecto For i = cRapido1 To cRapido3 sRapsDef(i).Comando = sRaps(i).Comando sRapsDef(i).Descripcion = sRaps(i).Descripcion sRapsDef(i).IniciarEn = sRaps(i).IniciarEn Next ' Leer los valores For i = cRapido1 To cRapido1 + j - 1 sTmp = Trim$(CD.LeerIni(sFicIni, "Rapidos", "Descripcion" & CStr(i), "")) If Len(sTmp) Then sRaps(i).Descripcion = sTmp End If sTmp = Trim$(CD.LeerIni(sFicIni, "Rapidos", "Comando" & CStr(i), "")) If Len(sTmp) Then sRaps(i).Comando = sTmp End If sTmp = Trim$(CD.LeerIni(sFicIni, "Rapidos", "IniciarEn" & CStr(i), "")) If Len(sTmp) Then sRaps(i).IniciarEn = sTmp End If Next ' Leer el resto de los ejecutables (máximo 16= 0 a 15) ' Nota: El valor máximo está en la constante MaxExes ' j = Val(CD.LeerIni(sFicIni, "Ejecutables", "Cantidad", "-1")) ' No permitir más de MaxExes ejecutables If j > MaxExes Then j = MaxExes ' Asignar el valor por defecto para el que ya está creado sExes(0).Descripcion = "&MS-DOS" sExes(0).Comando = "COMMAND.COM" sExes(0).IniciarEn = "C:\" ' Asignar al Ejecutable por defecto sExeDef.Comando = sExes(0).Descripcion sExeDef.Descripcion = sExes(0).Comando sExeDef.IniciarEn = sExes(0).IniciarEn ' Leer los valores For i = 0 To j sTmp = Trim$(CD.LeerIni(sFicIni, "Ejecutables", "Descripcion" & CStr(i), "")) If Len(sTmp) Then sExes(i).Descripcion = sTmp End If sTmp = Trim$(CD.LeerIni(sFicIni, "Ejecutables", "Comando" & CStr(i), "")) If Len(sTmp) Then sExes(i).Comando = sTmp End If sTmp = Trim$(CD.LeerIni(sFicIni, "Ejecutables", "IniciarEn" & CStr(i), "")) If Len(sTmp) Then sExes(i).IniciarEn = sTmp End If Next ' Añadir las descripciones a los menús For i = cRapido1 To cRapido3 mnuExe(i).Caption = sRaps(i).Descripcion lstExes(cRapidos).AddItem sRaps(i).Descripcion Next j = -1 For i = 0 To MaxExes If Len(sExes(i).Descripcion) Then j = j + 1 If j > 0 Then Load mnuExe1(j) End If mnuExe1(j).Caption = sExes(i).Descripcion mnuExe1(j).Visible = True lstExes(cExes).AddItem sExes(i).Descripcion End If Next ' Seleccionar el listBox de los menús rápidos lstExes(cRapidos).ListIndex = 0 ' Inicializar el icono de la barra de Tarea With t .cbSize = Len(t) ' Usar el picture para interceptar los mensajes de Windows .hWnd = picTaskBar.hWnd .uId = 1& .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE .ucallbackMessage = WM_MOUSEMOVE .hIcon = Icon ' Es un string de "C" ( \0 ) .szTip = " " & App.Title & "," & sCopyR & " " & Chr$(0) End With Shell_NotifyIcon NIM_ADD, t ' Leer la posición guardada Left = CD.LeerIni(sFicIni, "Posicion", "Left", Left) Top = CD.LeerIni(sFicIni, "Posicion", "Top", Top) ' Comprobar que esté visible If Top < 120 Then Top = 0 If Left < 120 Then Left = 0 If Left + Width > Screen.Width Then Left = 0 If Top + Height > Screen.Height Then Top = 0 '///////////////////// ' Tamaño mínimo '///////////////////// If Height < 5805 Then Height = 5805 If Width < 8790 Then Width = 8790 ' Ocultar el picture que interceptará las pulsaciones de la barra de tareas picTaskBar.Top = Height + 240 ' Inicialmente deshabilitar la opción de guardar Modificado = False cmdGuardar.Enabled = False ' Ocultar el form principal Hide ' Comprobar si hay que mostrar los tips If CD.GetSetting(sFicIni, "Tips", "ShowTips", 1) Then frmTip.Show vbModal, Me End If m_Iniciando = False End Sub Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) ' Asignar el fichero dejado al TextBox de los comandos (02/Feb/99) Dim sFile As String Dim sPath As String Dim sNombre As String Dim i As Long ' Tomar el primer fichero soltado sFile = Data.Files(1) ' Averiguar si es un acceso directo, la extensión será .lnk If InStr(LCase(sFile), ".lnk") Then ' Tomar el Path y el nombre del fichero CD.SplitPath sFile, sPath, sNombre ' El nombre devuelto contiene también la extensión i = InStr(LCase(sNombre), ".lnk") sNombre = Left$(sNombre, i - 1) ' Asignar el nombre del fichero dejado txtExes(0) = sNombre ' Asignar el path por defecto txtExes(2) = sPath End If txtExes(1) = sFile End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If WindowState <> vbMinimized Then ' Guardar la posición actual, si no se está inicializando el form If Not m_Iniciando Then CD.GuardarIni sFicIni, "Posicion", "Left", Left CD.GuardarIni sFicIni, "Posicion", "Top", Top End If End If ' Quitar el icono de la barra de tareas t.cbSize = Len(t) t.hWnd = picTaskBar.hWnd t.uId = 1& Shell_NotifyIcon NIM_DELETE, t End Sub Private Sub Form_Resize() If WindowState <> vbMinimized Then Line3DEx1(0).Resize Line3DEx1(1).Resize ' Guardar la posición actual, si no se está iniciando el formulario If Not m_Iniciando Then CD.GuardarIni sFicIni, "Posicion", "Left", Left CD.GuardarIni sFicIni, "Posicion", "Top", Top End If End If End Sub Private Sub Form_Unload(Cancel As Integer) ' Descargar el formulario de Tips Unload frmTip ' Un poco de limpieza de memoria Set CD = Nothing Set frmElGuilleTB = Nothing End Sub Private Sub lstExes_Click(Index As Integer) ' Mostrar los datos de este ejecutable Dim i As Long Static Estoy As Boolean ' Para no re-entrar If Not Estoy Then Estoy = True ' El item seleccionado i = lstExes(Index).ListIndex If i > -1 Then If Index = cExes Then cmdAdd(0).Enabled = True txtExes(0) = sExes(i).Descripcion txtExes(1) = sExes(i).Comando txtExes(2) = sExes(i).IniciarEn Else cmdAdd(0).Enabled = False i = i + cRapido1 txtExes(0) = sRaps(i).Descripcion txtExes(1) = sRaps(i).Comando txtExes(2) = sRaps(i).IniciarEn End If optExes(Index).Value = True ' Resaltar los captions correspondientes Label1(Index + 5).FontBold = True Label1(Index + 3).FontBold = True ' Quitar la selección del otro list i = 1 If Index = 1 Then i = 0 End If lstExes(i).ListIndex = -1 ' Restaurar el caption del otro list Label1(i + 5).FontBold = False Label1(i + 3).FontBold = False End If Estoy = False End If End Sub Private Sub lstExes_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single) ' Si se "coge y suelta" (Drag&Drop) un elemento del listbox... ListRowMove Source, DragIndex, ListRowCalc(Source, Y) End Sub Private Sub lstExes_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) 'Si se pulsa la tecla de suprimir If KeyCode = vbKeyDelete Then ' Borrar el elemento cmdAdd_Click 2 End If End Sub Private Sub lstExes_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) ' Si se pulsa el botón del ratón, empezar la operación de Drag&Drop DragIndex = ListRowCalc(lstExes(Index), Y) lstExes(Index).Drag End Sub Private Sub mnuExe_Click(Index As Integer) Dim i As Long ' Opciones del menú mnuExe Select Case Index Case cSalir ' salir del programa Unload Me Case cPersonalizar ' Mostrar el formulario principal, osea este Show Case cTips ' Mostrar la pantalla de tips frmTip.Show vbModal, Me Case cAcercaDe ' Mostrar la pantalla de Acerca de frmTip.AcercaDe frmTip.Show vbModal, Me Case cRapido1, cRapido2, cRapido3 ' Ejecutar los programas indicados en los menús rápidos Ejecutar Index, cRapidos End Select End Sub Private Sub mnuExe1_Click(Index As Integer) ' Opciones del menú mnuExe1 Ejecutar Index, cExes End Sub Private Sub Ejecutar(ByVal Index As Long, Optional ByVal queMenu As eQueMenu = cRapidos) ' Ejecutar los programas indicados en Rápido Dim sCmd As String Dim sIniciar As String ' Dim sEsteDir As String ' ' Interceptar los posibles errores On Local Error Resume Next If queMenu = cExes Then sCmd = sExes(Index).Comando sIniciar = Trim$(sExes(Index).IniciarEn) Else sCmd = sRaps(Index).Comando sIniciar = Trim$(sRaps(Index).IniciarEn) End If ' Guardar el path actual, aunque con ShellExecute no es necesario... sEsteDir = CurDir$ ' Cambiar al directorio indicado If Len(sIniciar) Then ChDrive sIniciar ChDir sIniciar End If ' Ejecutar la orden 'Shell sCmd, vbNormalFocus ' Usando ShellExecute, lo cual nos permite incluso ejecutar accesos directos, ' o cualquier cosa que se pueda ejecutar en el explorador de Windows Call ShellExecute(hWnd, "Open", sCmd, "", sIniciar, vbNormalFocus) DoEvents ' Volver al path actual ChDrive sEsteDir ChDir sEsteDir Err = 0 End Sub Private Sub picTaskBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Este evento se producirá cuando se pulse en el icono de la barra de tareas Static rec As Boolean, Msg As Long ' Averiguar el mensaje que se envía Msg = X / Screen.TwipsPerPixelX ' Para que no se entre si aún se está dentro If rec = False Then rec = True Select Case Msg Case WM_LBUTTONDBLCLK: ' Si se hace dobleclick mostrar el form Show Case WM_LBUTTONDOWN: Case WM_LBUTTONUP: Case WM_RBUTTONDBLCLK: Case WM_RBUTTONDOWN: Case WM_RBUTTONUP: ' Mostrar el menú ' PopUp menu,2 significa Izq/Der botones en el menu, Personalizar en Negrita Me.PopupMenu mnuExecuter, vbPopupMenuRightButton, , , mnuExe(0) End Select rec = False End If End Sub Private Sub AsignarExe1() Dim i As Long Dim j As Long On Local Error Resume Next ' Reorganizar los ejecutables Erase tExes j = -1 For i = 0 To MaxExes If Len(sExes(i).Descripcion) Then j = j + 1 tExes(j).Comando = sExes(i).Comando tExes(j).Descripcion = sExes(i).Descripcion tExes(j).IniciarEn = sExes(i).IniciarEn End If Next For i = MaxExes To 1 Step -1 Unload mnuExe1(i) Next Err = 0 ' ' Volver a asignar el array y el listBox ' Se usa Erase sin un Redim ya que es un array estático Erase sExes j = -1 For i = 0 To MaxExes If Len(tExes(i).Descripcion) Then j = j + 1 sExes(j).Comando = tExes(i).Comando sExes(j).Descripcion = tExes(i).Descripcion sExes(j).IniciarEn = tExes(i).IniciarEn End If Next If j = -1 Then sExes(0).Comando = sExeDef.Comando sExes(0).Descripcion = sExeDef.Descripcion sExes(0).IniciarEn = sExeDef.IniciarEn End If ' Añadir los comandos al menú lstExes(cExes).Clear j = -1 For i = 0 To MaxExes If Len(sExes(i).Descripcion) Then j = j + 1 If j > 0 Then Load mnuExe1(j) End If mnuExe1(j).Caption = sExes(i).Descripcion mnuExe1(j).Visible = True lstExes(cExes).AddItem sExes(i).Descripcion End If Next Err = 0 End Sub Private Sub txtExes_GotFocus(Index As Integer) ' Seleccionar todo el contenido (02/Feb/99) With txtExes(Index) .SelStart = 0 .SelLength = Len(.Text) End With End Sub Private Sub txtExes_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) ' Llamar al método del form que es el que hace el trabajo Form_OLEDragDrop Data, Effect, Button, Shift, X, Y End SubAhora vamos a ver el código del formulario de los tips o sugerencias diarias y el Acerca De:
Las propiedades MousePointer de las etiquetas que se usarán para los links, tendrán el valor 99-Custom para que se use el puntero indicado.
El color de las letras será azul subrayado, para que parezca un link normal y corriente.' '---------------------------------------------------------------------------------- 'Tips para elGuilleTB ( 1/Feb/99) ' '©Guillermo 'guille' Som, 1999 '---------------------------------------------------------------------------------- Option Explicit Private CD As cgsFileOpR ' Nombre del fichero de configuración (INI) Private sFicIni As String ' La base de datos de sugerencias. Private Tips As Collection ' Índice de la colección con la sugerencia visualizada actualmente. Private CurrentTip As Long Private 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 Private Sub LoadTips() Dim sTmp As String ' ' Borrar cualquier contenido anterior de la colección Set Tips = Nothing Set Tips = New Collection ' Añadir siempre esto como primer tip sTmp = App.Title & " - " & "v" & App.Major & "." & Format$(App.Minor, "00") & "." & Format$(App.Revision, "0000") & vbCrLf & vbCrLf & _ App.Comments & vbCrLf & vbCrLf & _ "©Guillermo 'guille' Som, 1999" ' Ajustar el año... If Year(Now) > 1999 Then sTmp = sTmp & "-" & Year(Now) End If ' Tips.Add sTmp ' ' Añadir el resto de los tips y no leerlos del disco Tips.Add "Con esta utilidad puedes personalizar los menús y seleccionar los programas a ejecutar." Tips.Add "Para mostrar la pantalla de configuración, selecciona 'Personalizar...' del menú emergente." Tips.Add "Para guardar los comandos añadidos a los menús configurables deberás pulsar en el botón 'Guardar'" Tips.Add "Existen dos secciones de menús configurables: los Rápidos son los que se muestran inicialmente y los Ejecutables que están en el submenú 'Ejecutables'" Tips.Add "Los menús de la sección Rápidos no se pueden borrar ni añadir nuevos, siempre hay tres; pero puedes personalizarlos." Tips.Add "Los menús de la sección Ejecutables se pueden borrar, (aunque siempre habrá uno), también se pueden añadir nuevos y modificarlos." Tips.Add "Por defecto el menú 'Rápidos' tiene una serie de programas y en el de 'Ejecutables' estará 'MS-DOS', aunque puedes modificarlas y añadir las que quieras." Tips.Add "Para añadir una nueva opción, selecciona el listbox de la sección en la que quieres añadirlo y escribe la descripción, comando y el directorio de inicio." Tips.Add "en el 'Comando' puedes especificar los parámetros necesarios para ejecutar el programa y sobre todo debes especificar el path en el que se encuentra." Tips.Add "'Iniciar En' es el path de inicio en el que se ejecutará el programa indicado en 'Comando'." Tips.Add "Para seleccionar el programa a ejecutar, pulsa en el botón '...' y busca la carpeta en la que se encuentra, también puedes seleccionar un Acceso directo." Tips.Add "Debes saber que no se hace ningún tipo de comprobación en los parámetros indicados en 'Comando', así que ojito con lo que haces..." Tips.Add "Pulsando en el botón 'Cerrar' se oculta la pantalla de configuración (Personalización) y se deja el programa en la barra de tareas." Tips.Add "Se puede ejecutar cualquier cosa que se quiera: o que pueda ejecutarse en el explorador de Windows." Tips.Add "Si añades o modificas algún elemento, deberás guardarlo antes de modificar, borrar o añadir otro, ya que si no lo haces perderás lo que hayas hecho antes." ' Muestra la primera sugerencia cmdNextTip_Click End Sub Private Sub chkLoadTipsAtStartup_Click() ' guarda si se debe o no mostrar el formulario al iniciar Static YaEstoy As Boolean If Not YaEstoy Then YaEstoy = True chkLoadTipsAtStartup.Value = -1 * (chkLoadTipsAtStartup.Value = vbChecked) CD.SaveSetting sFicIni, "Tips", "ShowTips", chkLoadTipsAtStartup.Value YaEstoy = False End If End Sub Private Sub cmdNextTip_Click() ' Recorre las sugerencias por orden CurrentTip = CurrentTip + 1 ' Si nos pasamos, volver al principio If Tips.Count < CurrentTip Then CurrentTip = 1 End If ' Muestra la sugerencia actual. DisplayCurrentTip End Sub Private Sub cmdPrevTip_Click() ' Muestra la sugerencia anterior (26/Mar/98) CurrentTip = CurrentTip - 1 If CurrentTip < 1 Then CurrentTip = Tips.Count End If ' Muestra la sugerencia. DisplayCurrentTip End Sub Private Sub cmdTipOK_Click() Unload Me End Sub Private Sub Form_KeyPress(KeyAscii As Integer) ' Detectar la tecla pulsada Dim c As String c = UCase$(Chr$(KeyAscii)) If c = "A" Then cmdTipOK_Click ElseIf c = "M" Then chkLoadTipsAtStartup_Click ElseIf c = "S" Then cmdNextTip_Click ElseIf c = "R" Then cmdPrevTip_Click End If End Sub Private Sub Form_Load() ' Crear los objetos y colección usados en este formulario Set CD = New cgsFileOpR Set Tips = New Collection sFicIni = CD.AddBackSlash(App.Path) & "elGuilleTB.ini" Me.chkLoadTipsAtStartup.Value = CD.GetSetting(sFicIni, "Tips", "ShowTips", 1) CurrentTip = CD.GetSetting(sFicIni, "Tips", "CurrentTip", 0) ' Lee el archivo de sugerencias y muestra una de forma aleatoria LoadTips End Sub Private Sub DisplayCurrentTip() If Tips.Count > 0 Then lblTipText.Caption = Tips.Item(CurrentTip) End If End Sub Private Sub Form_Unload(Cancel As Integer) 'Guardar el tip que se acaba de mostrar CD.SaveSetting sFicIni, "Tips", "CurrentTip", CurrentTip ' Liberamos la memoria Set CD = Nothing Set Tips = Nothing Set frmTip = Nothing End Sub Public Sub AcercaDe() ' Mostrar la información sobre el autor... (02/Feb/99) Dim sTmp As String Caption = "Acerca de... " & App.Title sTmp = _ App.Title & " - " & "v" & App.Major & "." & Format$(App.Minor, "00") & "." & Format$(App.Revision, "0000") & vbCrLf & vbCrLf & _ App.Comments & vbCrLf & vbCrLf & _ App.LegalCopyright lblAcercaDe(0) = sTmp Set Icon = frmElGuilleTB.Icon ' Colocar en un sitio visible el frame con la información de AcercaDe With frameTip(0) .Move 180, 180 .ZOrder .Visible = True End With ' Posicionar el botón Aceptar With cmdTipOK .Top = ScaleHeight - .Height - 210 .ZOrder End With End Sub Private Sub lblLink_Click(Index As Integer) If Index = 0 Then ' email Call ShellExecute(hWnd, "Open", "mailto:mensaje@elguille.info?Subject=AcercaDe_guilleTB", "", "", vbNormalFocus) Else ' URL Call ShellExecute(hWnd, "Open", "http://www.elguille.info/", "", "", vbNormalFocus) End If End SubBueno, esto es todo el código que te voy a mostrar, el de la clase y el control de líneas 3D está incluido en el zip, pero no lo muestro para no alargar más de lo que ya se ha alargado el contenido de esta página.
Lo dicho, a disfrutarlo, a tener al Guille en la barra de tareas y a enviarme un mensajillo usando el programa... ¿vale?