Texte en sur-impression (Résolu)

Codes specifiques à Windows
tatanas
Messages : 39
Inscription : mar. 05/nov./2019 18:40

Texte en sur-impression (Résolu)

Message par tatanas »

Bonjour à tous,

Afin de prévenir les utilisateurs de postes Windows que j'ai pris la main sur leur machine, je souhaiterais afficher un message du style "Maintenance en cours" qui resterait en permanence par dessus toutes les autres fenêtres. Mais ce message ne doit pas m'empêcher d'interagir avec les fenêtres qui se trouvent derrière.
J'ai pas mal fouiné sur le forum Purebasic et j'ai trouvé quelque chose qui s'en approche bien que je n'ai pas un accès aux éléments "cachés" par le texte du message :

Code : Tout sélectionner

; OpenTextWindow(ID,Height,Thickness,Flag,Font$,Text$)

; Height = Font Height
; Thickness = Font Weight entre 0 et 1000
; Flag can be: #RGN_AND or #RGN_XOR

Procedure OpenTextWindow(ID, Height, Thickness, Flag, Font$, Text$)
	Protected RectRegion.Rect
	Protected verticalOffset = 15 ; pour décaler le texte de 15 pixels vers le bas sinon il chevauche la barre de titre de la GUI et l'affichage est foireux
	
	If OpenWindow(ID, 0, 0, 500, 500, Text$, #PB_Window_SystemMenu|#WS_POPUP) ; largeur et hauteur définies arbitrairement puisque calculées précisément par la suite
		SetForegroundWindow_(WindowID(ID)) ; semble inutile ?
		WindowDC= GetDC_(WindowID(ID))

		SetWindowColor(ID, #Red) ; couleur du texte

		; cette portion de code semble modifier la taille du hDC...
		hFont = CreateFont_(Height, 0, 0, 0, Thickness, 0, 0, 0, #DEFAULT_CHARSET, #OUT_CHARACTER_PRECIS, #CLIP_DEFAULT_PRECIS, #PROOF_QUALITY, 0, Font$)
		Font = SelectObject_(WindowDC, hFont)
		BeginPath_(WindowDC)
		TextOut_(WindowDC, 0, verticalOffset, Text$, Len(Text$)) 
		EndPath_(WindowDC)

		GetTextExtentPoint32_(WindowDC, Text$, Len(Text$), sz.SIZE) ; sz\cx contient la largeur en pixel du texte et sz\cy sa hauteur

		Region1 = PathToRegion_(WindowDC)
		GetRgnBox_(Region1, RectRegion)
		Region2 = CreateRectRgnIndirect_(RectRegion)
		CombineRgn_(Region2, Region2, Region1, Flag) 
		DeleteObject_(Region1)
		ReleaseDC_(WindowID(ID), WindowDC)
		SetWindowRgn_(WindowID(ID), Region2, 1)
; 		SelectObject_(WindowDC, Font) ; semble inutile ?

		; pour mettre au premier plan, centrer le texte et ajuster la GUI à la taille du texte
		SetWindowPos_(WindowID(ID), #HWND_TOPMOST, (GetSystemMetrics_(#SM_CXSCREEN)/2) - (sz\cx)/2, 0, sz\cx, sz\cy + verticalOffset, 0)

	Else
		ProcedureReturn 0
	EndIf
	ProcedureReturn 1
EndProcedure

If OpenTextWindow(0, 70, 300, #RGN_XOR, "Verdana", "Maintenance en cours")
	Repeat
		EventID = WaitWindowEvent()
	Until EventID = #PB_Event_CloseWindow
EndIf
Pensez-vous qu'il existe un moyen pour rendre ce texte complètement "traversable" et qu'il ne gêne en rien l'utilisation de l'ordinateur ?

Merci par avance.
Dernière modification par tatanas le mer. 09/mars/2022 8:05, modifié 1 fois.
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Texte en sur-impression

Message par Ar-S »

Je ne vois pas comment tu pourrais cliquer sur un truc se trouvant derrière ton texte.
Je serai toi, je placerai un fond d'ecran avec mon message (après avoir sauvé son fond d'ecran) lorsque j'interviens.
Ce serai surement moins "acadabrantesque" :D
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
tatanas
Messages : 39
Inscription : mar. 05/nov./2019 18:40

Re: Texte en sur-impression

Message par tatanas »

Le problème du fond d'écran, c'est qu'il n'est plus visible dès lors qu'on ouvre d'autres fenêtres. Et donc plus de message...
tatanas
Messages : 39
Inscription : mar. 05/nov./2019 18:40

Re: Texte en sur-impression

Message par tatanas »

J'ai finalement trouvé ! Il suffit de jouer avec le style de la Gui. Une ligne de code supplémentaire :

Code : Tout sélectionner

; OpenTextWindow(ID,Height,Thickness,Flag,Font$,Text$)

; Height = Font Height
; Thickness = Font Weight entre 0 et 1000
; Flag can be: #RGN_AND or #RGN_XOR

Procedure OpenTextWindow(ID, Height, Thickness, Flag, Font$, Text$)
	Protected RectRegion.Rect
	Protected verticalOffset = 15 ; pour décaler le texte de 15 pixels vers le bas sinon il chevauche la barre de titre de la GUI et l'affichage est foireux
	
	If OpenWindow(ID, 0, 0, 500, 500, Text$, #PB_Window_SystemMenu|#WS_POPUP) ; largeur et hauteur définies arbitrairement puisque calculées précisément par la suite
		SetForegroundWindow_(WindowID(ID)) ; semble inutile ?
		WindowDC= GetDC_(WindowID(ID))

		SetWindowColor(ID, #Red) ; couleur du texte

		; cette portion de code semble modifier la taille du hDC...
		hFont = CreateFont_(Height, 0, 0, 0, Thickness, 0, 0, 0, #DEFAULT_CHARSET, #OUT_CHARACTER_PRECIS, #CLIP_DEFAULT_PRECIS, #PROOF_QUALITY, 0, Font$)
		Font = SelectObject_(WindowDC, hFont)
		BeginPath_(WindowDC)
		TextOut_(WindowDC, 0, verticalOffset, Text$, Len(Text$)) 
		EndPath_(WindowDC)

		GetTextExtentPoint32_(WindowDC, Text$, Len(Text$), sz.SIZE) ; sz\cx contient la largeur en pixel du texte et sz\cy sa hauteur

		Region1 = PathToRegion_(WindowDC)
		GetRgnBox_(Region1, RectRegion)
		Region2 = CreateRectRgnIndirect_(RectRegion)
		CombineRgn_(Region2, Region2, Region1, Flag) 
		DeleteObject_(Region1)
		ReleaseDC_(WindowID(ID), WindowDC)
		SetWindowRgn_(WindowID(ID), Region2, 1)
; 		SelectObject_(WindowDC, Font) ; semble inutile ?

		; pour mettre au premier plan, centrer le texte et ajuster la GUI à la taille du texte
		SetWindowPos_(WindowID(ID), #HWND_TOPMOST, (GetSystemMetrics_(#SM_CXSCREEN)/2) - (sz\cx)/2, 0, sz\cx, sz\cy + verticalOffset, 0)

		; modifie le style de la fenête ce qui permet au clic de "passer au travers"
		SetWindowLongPtr_(WindowID(ID), #GWL_EXSTYLE, GetWindowLongPtr_(WindowID(ID), #GWL_EXSTYLE) | #WS_EX_LAYERED | #WS_EX_TRANSPARENT)
		; Hit testing of a layered window is based on the shape And transparency of the window. This means that the areas of the window that are color-keyed Or whose alpha value is zero will let the mouse messages through.
		; However, If the layered window has the WS_EX_TRANSPARENT extended window style, the shape of the layered window will be ignored And the mouse events will be passed To other windows underneath the layered window

	Else
		ProcedureReturn 0
	EndIf
	ProcedureReturn 1
EndProcedure

If OpenTextWindow(0, 70, 300, #RGN_XOR, "Verdana", "Maintenance en cours")
	Repeat
		EventID = WaitWindowEvent()
	Until EventID = #PB_Event_CloseWindow
EndIf

Autre version possible (plus simple) :

Code : Tout sélectionner

height = 100
width = GetSystemMetrics_(#SM_CXSCREEN)
message.s = "Maintenance en cours..."

OpenWindow(0, 0, 0, width, height, "TestWindow", #WS_POPUP)
SetWindowColor(0, RGB(0,0,1)) ; Set the background futur "transparent" color

; make the Window "transparent"
SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE, #WS_EX_LAYERED | #WS_EX_TOPMOST)
SetLayeredWindowAttributes_(WindowID(0), RGB(0,0,1), 0, #LWA_COLORKEY) ; Set the transparent color
SetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE, GetWindowLongPtr_(WindowID(0), #GWL_EXSTYLE) | #WS_EX_LAYERED | #WS_EX_TRANSPARENT) ; make the window "pass through"

StickyWindow(0, 1)

LoadFont(0, "Verdana", 50)

; Create Canvas
CanvasGadget(0, 0, 0, width, height)
StartDrawing(CanvasOutput(0))
DrawingFont(FontID(0)) 
Box(0, 0, width, height, RGB(0,0,1)) ; Draw a "transparent" block

Textlength = TextWidth(message)
DrawText(width / 2 - Textlength / 2, 10, message, #Red, RGB(0,0,1))
StopDrawing()


Repeat
  Event = WaitWindowEvent()  
Until Event = #PB_Event_CloseWindow
Dernière modification par tatanas le jeu. 10/mars/2022 13:21, modifié 1 fois.
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Texte en sur-impression (Résolu)

Message par Ar-S »

C'est excellent. 8)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Répondre