Mensajes

[SetLayeredWindowAttributes]

Hola amigos,

Llevaba no se ya ni cuanto tiempo, buscando una forma de colocar un formulario en el fondo del escritor y que permaneciera ahí como si formara parte del mismo, como un gadget.

Ayer me puse a experimentar con la declaración API, SetLayeredWindowAttributes y modificando el valor dwNewLong  de SetWindowLong y ¡Sorpresa! El formulario permanece siempre en el escritorio y no se puede tocar, ni mover, ni cerrar, ni nada, pero si que se puede ver. Tampoco aparece al pulsar Alt+Tab. Y cuando haces clic en él con el ratón, es como si no existiera. En definitiva, un formulario fantasma. No se cual será el término correcto.

Funciona con el Handle (HWND), de modo que se puede aplicar a cualquier ventana.


He hecho un ejemplo. Es un gigantesco reloj del sistema que se muestra en el escritorio.

Se necesita:
- Un formulario
- Un control PictureBox (para mostra el reloj)
- Un control Timer    (para actualizar reloj)

Modifica las propiedades del form a:
BorderStyle = 0
ShowInTaskbar =False

Esto es para un MÓDULO:

Código (vb) [Seleccionar] Expandir

'//////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////
'/////Establece el estilo de un formulario a modo fantastasma./////
'/////Características:                                        /////
'/////-Permenece siempre en el fondo del escritorio.          /////
'/////-Es visible.                                            /////
'/////-No se activa mediante el puntero del ratón.            /////
'/////-No se puede mover.                                     /////
'/////-No se puede colocar encima de otro formulario.         /////
'/////-No se puede activar mediante  ALT + TAB.               /////
'/////-Cuando haces clic con el ratón sobre él, se comporta   /////
'///// como si el formulario no existiera. De modo que en el  /////
'///// escritorio aparecerán los menús flotantes o el cuadro  /////
'///// de selección tal y como si no estuviera.               /////
'//////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////
'/////////////////////Creado por OKIK//////////////////////////////
'//////////////////////////////////////////////////////////////////

Option Explicit
Private Declare Function SetWindowPos Lib "user32" _
(ByVal Hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Const HWND_TOP = 0
Const HWND_BOTTOM = 1
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2

'Declaración del Api SetLayeredWindowAttributes _
que establece la transparencia al form
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal Hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long

'Recupera el estilo de la ventana
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long) As Long

'Establece un valor del 32bits para una compensación especificada en la memoria de la ventana extra
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Const LWA_ALPHA = &H2               'Crea una capa alfa (transparencia)
Public Const LWA_NULLCOLOR = &H1           'Anula un color especificado
Public Const LWA_ALPHA_NULLCOLOR = &H3     'Crea una capa alfa y anula un color especificado
Public Const LWA_NORMAL = &H0              'Normal, sin trasnparencia y sin anulación color
Public Const RMV_COLOR_BLACK = &H0         'Color para anular (negro)
Public Const RMV_COLOR_MAGENTA = &HFF00FF  'Color para anular (magenta)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000       'Estilo de capa
Private Const WS_EX_GHOSTFORM = &H64        'Estilo fantasma

Private Function SendFormBottom(ByVal Hwnd As Long)
'Envia el formulario al fondo la primera vez que se ejecuta
SetWindowPos Hwnd, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
End Function
Public Function SetGhostForm(ByVal Hwnd As Long, _
ByVal NivelTransparencia As Integer, _
ByVal NullColor As Long, _
ByVal TypeLayer As Long) As Long
Dim X As Long
Dim lpPrevWndProc As Long
On Error Resume Next
      X = GetWindowLong(Hwnd, GWL_EXSTYLE)
      X = X Or WS_EX_LAYERED Or WS_EX_GHOSTFORM
      SetWindowLong Hwnd, GWL_EXSTYLE, X
      NivelTransparencia = Int(((NivelTransparencia * 255) / 100) + 0.5)
      SetLayeredWindowAttributes Hwnd, NullColor, NivelTransparencia, TypeLayer
      SetGhostForm = 0
      SendFormBottom Hwnd
If Err Then
SetGhostForm = 2
End If
End Function



Y esto para el FORMULARIO

Código (vb) [Seleccionar] Expandir

Private Sub Form_Activate()
'SetGhostForm (Handle, Trasnparencia, Color para anular, Tipo de capa)
'Mantiene el formulario siempre abajo
Call SetGhostForm(Me.Hwnd, 45, RMV_COLOR_BLACK, LWA_ALPHA_NULLCOLOR)
End Sub

Private Sub Form_Load()
   With Picture1
       .Font = "Arial"
       .ForeColor = vbGreen
       .BackColor = vbBlack
       .FontSize = 100
       .AutoRedraw = True
       .Move 0, 0, 8000, 2000
       .BorderStyle = 0
   End With
   Timer1.Enabled = True
   Timer1.Interval = 1
End Sub
Private Sub Form_Resize()
   Me.Move Screen.Width - Me.Width - 100, 0, _
   Picture1.Width, Picture1.Height
End Sub

Private Sub Timer1_Timer()
   With Picture1
       Picture1.Cls
       Picture1.CurrentX = 150
       Picture1.CurrentY = 15
       Picture1.Print Time
   End With
End Sub


Lo malo es que los accesos directos no se superponen sobre el formulario, sino que se quedan debajo. Pero lo curioso es que aunque estén debajo, si haces doble clic sobre ellos (con el form encima), se pueden mover o ejecutar igualmente.

He hecho lo del reloj sólo como un ejemplo de utilidad, pero para crear un formulario fantasma basta con hacer la llamada a SetGhostForm que se encuentra en el módulo.  No funciona desde Form_Load, solo en Form_Resize y Form_Activate


Si no quieres transparencia, ni remover ningún color, usa LWA_NORMAL:

Call SetGhostForm(Me.Hwnd, 0, 0, LWA_NORMAL)


Si solo quieres transparencia usa LWA_ALPHA y estableces un valor entre 0 y 100, cuanto menor sea el valor más transparente se volverá el formulario:

Call SetGhostForm(Me.Hwnd, 100, 0, LWA_ALPHA)


LWA_ALPHA_NULLCOLOR, permite hacer las dos cosas:

Call SetGhostForm(Me.Hwnd, 50, RMV_COLOR_BLACK, LWA_ALPHA_NULLCOLOR)

[Código completo y definitivo para refrescar el escritorio, el explorador de carpetas y ACTUALIZAR LOS ICONOS en XP/Vista/¿Windows 7/8?]

Hola,
He buscado y rebuscado en la red y finalmente encontré la forma de refrescar el escritorio de windows y el Explorador de carpetas (Explorer)

Esto sirve para cuando cambias valores en el registro directamente desde tu programa, en lugar de usar Opciones de Carpeta. Por ejemplo, ocultar las extensiones de archivo, mostrar archivos ocultos o  mostrar vistas en miniaturas en lugar de iconos. Al refrescar automáticamente se muestran los cambios; si deshabilitas las extensiones de archivo, al refrescar (actualizar) se ocultan las extensiones.

Yo intuía que debía usar PostMessage o SendMessage, lo que no sabía era que comando usar. Finalmente los encontré pero referido a otros tipos de lenguaje, no para VB. He encontrado otras formas con VB pero no funcionaban o solamente funcionaban para el escritorio. Como explico más abajo, todo se tiene que hacer por separado: escritorio, explorador de windows y actualizar iconos.


Código completo y definitivo para refrescar el escritorio, el explorador de carpetas y ACTUALIZAR LOS ICONOS en XP/Vista/¿Windows 7/8?:

Código (vb) [Seleccionar] Expandir

Option Explicit
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Const WM_COMMAND = &H111
Private Const SC_REFRESH_DESKTOP = &H7103
Private Const SC_REFRESH_EXPLORER_VISTA = &HA220
Private Const SC_REFRESH_EXPLORER_XP = &H7FEF

'Función para actualizar los iconos
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, ByVal msg As Long, _
ByVal wParam As Long, ByVal lParam As Long, _
ByVal fuFlags As Long, ByVal uTimeout As Long, _
lpdwResult As Long) As Long

Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF&
Private Const SPI_SETNONCLIENTMETRICS = 42
Private Const SMTO_ABORTIFHUNG = &H2


Public Function RefreshDesktop()
Dim hwProgMan As Long, hwDesktop As Long, hwExplorer As Long

'Refresca el escritorio
hwProgMan = FindWindow("Progman", "Program Manager")
hwDesktop = FindWindowEx(hwProgMan, &H0, "SHELLDLL_DefView", vbNullString)
PostMessage hwDesktop, WM_COMMAND, SC_REFRESH_DESKTOP, &H0

'Refresca explorer
'VISTA/¿Windows 7/8?
hwExplorer = FindWindow("CabinetWClass", vbNullString)
PostMessage hwExplorer, WM_COMMAND, SC_REFRESH_EXPLORER_VISTA, &H0
'XP
hwExplorer = FindWindow("ExploreWClass", vbNullString)
PostMessage hwExplorer, WM_COMMAND, SC_REFRESH_EXPLORER_XP, &H0

'Actualiza los iconos
Call SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, SPI_SETNONCLIENTMETRICS, &H0, SMTO_ABORTIFHUNG, &H1, &H0)
End Function

Private Sub Command1_Click()
RefreshDesktop
End Sub

'//////////////////
Tuve una errata ayer con el nombre de clase del explorador de windows para Windows XP; le añadí una R de más. La culpa es de google Como no estaba seguro busqué ahí y encontre referencias escrito así y bueno, esa es la escusa. Lo he corregido .

El nombre de clase de Explorer para XP es: "ExploreWClass". Con toda seguridad, lo he comprobado personalmente.

De todos modos el código o comando para refrescar Explorer en XP es diferente que en Vista o Windows 7. De modo que tampoco iba a funcionar aunque hubiera escrito bien el nombre de clase. Ayer comprobé cual era el comando a usar con spy++ y lo he añadido.

He añadido además el código para actualizar los iconos porque no se actualizaban los iconos. Esto es, cuando cambias el icono por defecto de una determinada extensión de archivo directamente en el registro de windows y quieres ver los cambios sin tener que cerrar sesión o simular un cambio en Opciones de carpeta.

No me extraña que no encontrara la forma de refrescar windows. Parece ser que hay que hacerlo todo por separado, por un lado el escritorio, por el otro Explorer y por el otro actualizar los iconos.


Como se puede ver, en XP el código wParam es &H7FEF=32751. Lo he testado y ¡funciona!.

Ahora estoy muy liado... pero gracias

Ya se porqué se produce el error:

Porque primer tiene que estar cargada la página. Como no encuentra la colección de controles se produce un error.

Pare evitar el error puede ponerse la condición:

Código (vbnet) [Seleccionar] Expandir

If (WebBrowser1.Document IsNot Nothing) Then
...
end if


Y por supuesto esperar a que cargue la página.

[("Input")]

Hola,

Se trata de un código para loggear. Rellena de forma automático al login de una página.

Código (vbnet) [Seleccionar] Expandir

Dim theElementCollection As HtmlElementCollection = WebBrowser1.Document.GetElementsByTagName("Input")
           For Each curElement As HtmlElement In theElementCollection
               Dim controlName As String = curElement.GetAttribute("id").ToString
               If controlName = idUser Then
                   curElement.SetAttribute("Value", UserName)
               End If
           Next


El error se produce en ("Input").y es "NullReferenceException"---> "Referencia a objeto no establecida como instancia de objeto"

Si coloco el código en el evento WebBrowser1_DocumentCompleted entonces no se produce ningún error pero me interesa introducirlo en un evento Click de un botón.


Nota:

idUser  es una variable string con el id del control de la página donde hay que introducir el nombre de usuario

UserName es una variable string para el nombre del usuario

Pues como te han respondido más arriba con un OCR. El sofware de los escáneres disponen de OCR. Creo que todos o casi todos.

Hay programas muy buenos completos diseñados especialmente para ello como el Omnipage.

Pero es importante que la imagen fotografiada sea clara sin zonas borrosas. Además debe ser letra de máquina, no manual. Porque cada persona tiene una letra particular y reconocer eso es muy complicado.

Pues como sugerencia, en un juego así a mi me gustaría que el juego no se limitara a preguntar o que el jugador muestre su conocimiento sino que también orientase al jugador explicando echos históricos a modo de introducción y en tiempo  de juego a modo de historia y con escritos, para que uno pueda buscar una determinada información y motivar al jugador a buscar la información para poder superar determinas pruebas. Pero esto nunca de forma forzada, porque resulta muy engorroso tener que esperar a un vídeo o lo que sea y no poder salir hasta que termine. Es mejor que el propio usuario lo quiera visualizar o leer determinada información por voluntad propia.

En cuanto a algo científico pues igual.

Pero la ciencia y la historia son pesos pesados del conocimiento y haría falta la supresión de un experto o expertos para no fastidiarla con datos e información errónea.



yo soy programador aficionado, no 'capacitado' así que en eso, no te puedo ayudar.

"los jugadores puedan demostrar sus conocimientos en amplios temas, ya sean Historia, Cine, Literatura, Etc,"

En el mundo de los videojuegos, esto no funciona. A no ser que sea por encargo para alguna un centro educativo específico o algo así.

Saludos

La verdad es que Visual Studio 6.0 resulta muy práctico para hacer programas sencillos, rápidos y sin necesidad de ser un genio de la programación.

Estaría bien que Microsoft sacara una versión "Classic" actualizada para aquellos usuarios que antes usaban VB6 o siguen usándolo por su sencillez, facilidad de uso y lo rápido que se puede hacer programas. También iría muy bien para aquellos que se inician en la programación.

La verdad es que todavía se pueden hacer programas con un aspecto actualizado y funcionales en cualquier SO de Microsoft, utilizando funciones API, clases, ocx integrados y archivos de recurso.

El problema es que odio Linux