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 <[email protected]>
'
'----------------------------------------------------------------------------------
'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 [email protected] [email protected]
' 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:[email protected]?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?
