Compri tre e paghi uno? No, non siamo al supermercato, però questa volta voglio farvi, cari lettori, un regalo speciale. Con questo breve articolo (mi sono ispirato ancora una volta ai “trucchi” di Francesco Balena) vi spiegherò come rendere un po’ più originali e particolari i vostri Userform di Excel; il discorso però vale anche per quelli di Word e di Access.

Stavo cercando un modo per abbellire una maschera di apertura e una di informazioni (about) di un piccolo progettino Access appena realizzato. Ho pensato: le maschere standard sono noiose, sempre uguali, rettangolari, al massimo si può togliere la barra del titolo, si possono eliminare i pulsanti di chiusura e riduzione/massimizzazione, si può togliere il bordo… ma sempre rettangolari rimangono! Allora cerca e cerca, ho trovato nel mio magico libro di riferimento una routine curiosa e inusuale, che permette di realizzare maschere di forma diversa, del tutto funzionali ma per esempio ovali, dai bordi arrotondati oppure a diamante. Questo solo per dare un’idea delle potenzialità. Non mi sono fermato e ho riciclato anche del buon vecchio codice utilizzato per gestire la trasparenza, che unito a una semplice routine di gestione del timer mi ha permesso di creare un gradevole effetto di dissolvenza, così il mio form di apertura ha lasciato tutti a bocca aperta 🙂 .  Quando ho provato a replicare la stessa tecnica su uno Userform di Excel, mi sono accorto che funzionava tutto, ma avevo bisogno di un piccolo particolare: le maschere di Excel non possiedono un numero identificativo globale dell’applicazione (un “handle”, generalmente indicato come hWnd), che invece le maschere di Access possiedono in modo nativo. Quindi altra ricerca e altro regalo: due alternative per calcolare un handle univoco di un Userform Excel, una più rapida con l’API FindWindow e una con un semplice routine (nel caso il primo metodo non funzionasse)

Questa la premessa… passiamo al codice!

1) Creare e gestire un handle (hWnd) – solo per Excel e Word

Il codice che segue è funzionale solo ad Excel e Word, mentre in Access l’handle di una maschera  è fornito di serie.

a) alternativa con FindWindow

Dobbiamo dichiarare l’API in testa a un modulo, renderla pubblica e quindi richiamarla quando opportuno:

'per ottenere l'handle del form
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

b) alternativa con poche righe di codice

Ho recuperato il codice googlando e cercando attentamente ; mi sono imbattuto in un bell’articolo di “colinlegg” di un paio di anni fa e ho scelto di adottare la tecnica descritta.
In un modulo pubblico scriviamo:

Option Explicit

#If Win64 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib _
    "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function IUnknown_GetWindow Lib _
    "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long
#End If

Public Function GetHwnd(ByVal ufmTarget As MSForms.UserForm) As Long
    IUnknown_GetWindow ufmTarget, VarPtr(GetHwnd)
End Function

Adesso il numero che ci serve lo ricaviamo passando a GetHwnd un riferimento al nostro userform, per esempio con GetHwnd(UserForms(index)) oppure, se siamo già dentro il form, con GetHwnd(Me).

2) Creare una maschera dalla forma personalizzata

Ecco qui finalmente la proposta del giorno: creiamo un nuovo modulo e incolliamo il codice seguente, che serve a inizializzare le varie API che ci servono per mutare la forma alla maschera che verrà identificata dal suo handle (hWnd).

Option Explicit

Type POINTAPI
    x As Long
    y As Long
End Type

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If Win64 Then
    Declare PtrSafe Function CreateEllipticRgn Lib "gdi32" _ 
    (ByVal x1 As LongPtr, ByVal y1 As LongPtr, ByVal x2 As LongPtr, ByVal y2 As LongPtr) As LongPtr
    Declare PtrSafe Function CreatePolygonRgn Lib "gdi32" _
    (lpPoint As POINTAPI, ByVal nCount As LongPtr, ByVal nPolyFillMode As LongPtr) As LongPtr
    Declare PtrSafe Function CreateRoundRectRgn Lib "gdi32" _
    (ByVal x1 As LongPtr, ByVal y1 As LongPtr, ByVal x2 As LongPtr, ByVal y2 As LongPtr, _
    ByVal x3 As LongPtr, ByVal y3 As LongPtr) As LongPtr
    Declare PtrSafe Function GetWindowRect Lib "user32" _
    (ByVal hwnd As LongPtr, lpRect As RECT) As LongPtr
    Declare PtrSafe Function SetWindowRgn Lib "user32" _
    (ByVal hwnd As LongPtr, ByVal hRgn As LongPtr, ByVal bRedraw As LongPtr) As LongPtr
    Declare PtrSafe Function DeleteObject Lib "gdi32" _
    (ByVal hObject As LongPtr) As LongPtr
#Else
    Declare Function CreateEllipticRgn Lib "gdi32" _
    (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
    Declare Function CreatePolygonRgn Lib "gdi32" _
    (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
    Declare Function CreateRoundRectRgn Lib "gdi32" _
    (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, _
    ByVal x3 As Long, ByVal y3 As Long) As Long
    Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function SetWindowRgn Lib "user32" _
    (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
    Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
#End If

Sub SetWindowShape(ByVal hwnd As Long, ByVal lShape As Long)
Dim lpRect As RECT
Dim wi As Long, he As Long
Dim hRgn As Long
    
    GetWindowRect hwnd, lpRect
    wi = lpRect.Right - lpRect.Left
    he = lpRect.Bottom - lpRect.Top
    
    Select Case lShape
    Case 0
        hRgn = CreateEllipticRgn(0, 0, wi, he)
    Case 1
        hRgn = CreateRoundRectRgn(0, 0, wi, he, 20, 20)
    Case 2
        Dim lpPoints(3) As POINTAPI
        lpPoints(0).x = wi \ 2
        lpPoints(0).y = 0
        lpPoints(1).x = 0
        lpPoints(1).y = he \ 2
        lpPoints(2).x = wi \ 2
        lpPoints(2).y = he
        lpPoints(3).x = wi
        lpPoints(3).y = he \ 2
        hRgn = CreatePolygonRgn(lpPoints(0), 4, 1)
    End Select
    
    SetWindowRgn hwnd, hRgn, True
    DeleteObject hRgn
End Sub

La forma della maschera è governata nella sub SetWindowShape, una procedura che si serve delle API di sistema per gestire la forma personalizzata; alla procedura dobbiamo passare l’handel della form e un numero (da 0 a 2) che indica alla routine quale forma vogliamo dare alla maschera: zero (forma ovale), uno (angoli arrotondati), due (a diamante). Si può provare a giocare con i parametri wi ed he all’interno della procedura, che identificano larghezza (width) e altezza (height) del form, per ottenere forme diverse. Nota che gli angoli arrotondati (caso 1) sono preimpostati a 20 pixel, ma questo valore può essere aumentato. Anzi, provate pure 🙂

La procedura si può chiamare, ad esempio, in questo modo (riporto le alternative con FindWindow e col codice dell’opzione b del punto 1): 

a) SetWindowShape FindWindow(vbNullString, Me.Caption), 1

b) SetWindowShape GetHwnd(Me), 1

3) Trasparenza

L’ultimo effetto che possiamo impostare per un form è quello della trasparenza. La tecnica descritta di seguito funziona bene per le maschere popup di Access, mentre non c’è modo di impostare la trasparenza per le maschere normali. La trasparenza è impostata come percentuale del canale alfa e quindi può essere impostata in un range da zero (opaco: nessuna trasparenza) a 100 (massima trasparenza).

Al solito dobbiamo dichiarare alcune API pubbliche e la routine che imposta la trasparenza in un modulo:

'per la trasparenza delle form
Public Const GWL_EXSTYLE = -20
Public Const LWA_COLORKEY = 1
Public Const LWA_ALPHA = 2
Public Const WS_EX_LAYERED = &H80000

'per la trasparenza delle form
Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "User32" _
(ByVal hWnd As Long, ByVal cKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long

Sub set_transparent(hWnd As Long, tVal As Integer)
'tVal --> 0..100 (trasparente..opaco)
    Call SetWindowLong(hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(hWnd, 0, (255 * tVal) / 100, LWA_ALPHA)
    DoEvents
End Sub

E poi possiamo invocare l’effetto trasparenza sulla form con l’istruzione set_transparent alla quale passiamo l’hWnd della maschera e un valore da zero a cento (cioè da completamente trasparente a completamente opaco, o se volete la percentuale di trasparenza):

Private Sub UserForm_Initialize()
    
    set_transparent FindWindow(vbNullString, Me.Caption), 50

End Sub

Allego un piccolo file di esempio da provare: scarica l’esempio.

 

Personalizzare le Maschere
Tag:                         

Personalizzare le Maschere

Login Registrati
Stai vedendo 1 articolo (di 1 totali)
  • Autore
    Articoli
  • #8550 Risposta

    vecchio frac
    Moderatore
      23 pts

      Compri tre e paghi uno? No, non siamo al supermercato, però questa volta voglio farvi, cari lettori, un regalo speciale. Con questo breve articolo (mi sono ispirato ancora una volta ai "trucchi" di Francesco Balena) vi spiegherò come rendere un po' più originali e particolari i vostri Userform di Excel; il discorso però vale anche per quelli di Word e di Access.
      [Leggi tutto al seguente link: https://www.excelvba.it/forumexcel/personalizzare-le-maschere/]

    Login Registrati
    Stai vedendo 1 articolo (di 1 totali)
    Rispondi a: Personalizzare le Maschere
    Gli allegati sono permessi solo ad utenti REGISTRATI
    Le tue informazioni:



    vecchio frac - 830 risposte

    albatros54
    albatros54 - 516 risposte

    Marius44
    Marius44 - 282 risposte

    patel
    patel - 264 risposte

    Luca73
    Luca73 - 235 risposte