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 Sub
Ahora 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 Sub
Bueno, 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?
