- Код: Выделить всё
'Импортируем функию из DLL
<DllImport("DwmApi.dll")> Private Shared Function DwmExtendFrameIntoClientArea(ByVal hwnd As IntPtr, ByRef pMarInset As Margins) As Integer
End Function
'Обьявляем структуру, описывающую размер полей Glass
<StructLayout(LayoutKind.Sequential)> Private Structure Margins
Public cxLeftWidth As Integer
Public cxRightWidth As Integer
Public cyTopHeight As Integer
Public cyBottomHeight As Integer
End Structure
Private Sub PaintGlass()
'Определяем Handle формы
Dim theHandle As Long = Me.Handle.ToInt64
'Задаём размер областей Glass
Dim margins As New Margins()
margins.cxLeftWidth = (Me.Width / (Bord1))
margins.cxRightWidth = (Me.Width / (Bord1))
margins.cyTopHeight = (Me.Height / Bord)
margins.cyBottomHeight = (Me.Height / Bord)
'необходимо предварительно закрасить чёрным цветом соотв. области формы
'Вызываем функцию Glass из библиотеки DwmApi.dll
Try
DwmExtendFrameIntoClientArea(theHandle, margins)
Catch
'не включен Aero или не Vista
End Try
Но если включена цветовая схема "Windows Vista - упрощённый стиль", а не "Windows Aero", то хотелось бы узнать об этом и не пытаться вызывать эффект Aero Glass. Иначе вместо "стеклянных" поверхностей получаю чёрные.
Пробовал так:
- Код: Выделить всё
Public Structure ThemeInfo
Private Declare Unicode Function GetCurrentThemeName _
Lib "uxtheme.dll" _
( _
ByVal pszThemeFileName As String, _
ByVal dwMaxNameChars As Int32, _
ByVal pszColorBuff As String, _
ByVal cchMaxColorChars As Int32, _
ByVal pszSizeBuff As String, _
ByVal cchMaxSizeChars As Int32 _
) As Int32
Private Const S_OK As Int32 = &H0
Private m_FileName As String
Private m_ColorSchemeName As String
Private m_SizeName As String
Public Property FileName() As String
Get
Return m_FileName
End Get
Set(ByVal Value As String)
m_FileName = Value
End Set
End Property
Public Property ColorSchemeName() As String
Get
Return m_ColorSchemeName
End Get
Set(ByVal Value As String)
m_ColorSchemeName = Value
End Set
End Property
Public Property SizeName() As String
Get
Return m_SizeName
End Get
Set(ByVal Value As String)
m_SizeName = Value
End Set
End Property
Public Overrides Function ToString() As String
Return _
"FileName={" & Me.FileName & _
"} ColorSchemeName={" & Me.ColorSchemeName & _
"} SizeName={" & Me.SizeName & "}"
End Function
Public Shared ReadOnly Property CurrentTheme() As ThemeInfo
Get
Dim ti As New ThemeInfo()
Const BufferLength As Int32 = 256
ti.FileName = Strings.Space(BufferLength)
ti.ColorSchemeName = ti.FileName
ti.SizeName = ti.FileName
If _
GetCurrentThemeName( _
ti.FileName, _
BufferLength, _
ti.ColorSchemeName, _
BufferLength, _
ti.SizeName, _
BufferLength _
) = S_OK _
Then
ti.FileName = NullTrim(ti.FileName)
ti.ColorSchemeName = NullTrim(ti.ColorSchemeName)
ti.SizeName = NullTrim(ti.SizeName)
Return ti
Else
Const Message As String = _
"An error occured when attempting to get theme info."
Throw New Exception(Message)
End If
End Get
End Property
Private Shared Function NullTrim(ByVal Text As String) As String
Return _
Strings.Left( _
Text, _
Strings.InStr(Text, ControlChars.NullChar) - 1 _
)
End Function
End Structure
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
MsgBox(ThemeInfo.CurrentTheme.ToString())
End Sub
Но увы, если схема "Windows Vista - упрощённый стиль" или если схема "Windows Aero", то всё равно выдаёт это:
"File Name={ C:\Windows\resources\Themes\Aero\Aero.msstyles}
ColorSchemeName={NormalColor} SizeName={NormalSize}"
Как узнать, текущую цветовую схему, подскажите пожалуйста! В MSDN то ли плохо искал, то ли нет ничего по этому вопросу. Причём использую Windows Forms, переписывать заново под WPF пока нет возможности.
А
- Код: Выделить всё
Catch
'не включен Aero или не Vista
End Try
почему-то не срабатывает.