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