XPからのテーマAPIには、EnableThemeDialogTextureという関数があります。文字通りダイアログの背景をテーマのテクスチャにすることを許可する関数です。実際に絵を見てみたほうが早いでしょう。

使用前 使用後
Simpatico EnableThemeDialogTexture未使用 Simpatico EnableThemeDialogTexture使用
NeowinEX Navblue EnableThemeDialogTexture未使用 NeowinEX Navblue EnableThemeDialogTexture使用
Windows XP Luna 青 EnableThemeDialogTexture未使用 Windows XP Luna 青 EnableThemeDialogTexture使用

Windows XPのLunaはタブと一緒に使うと効果を発揮します。Windows XP Luna 青 タブの例タブの外側が普通のウィンドウの色、タブとその中がEnableThemeDialogTextureによる背景となっています(他のスキンでも同じです)。標準以外のテーマを入れるにはシステムファイル保護を無効にしなければならないなど、危険性の上昇、手順の面倒くささが問題なので、誰にでもお勧めできる機能ではないのが残念です。


最後に今回使ったソースコードをここに置いておきます。EnableThemeDialogTextureをLoadLibraryせず、直接Declareして使っているので、応用しづらいと思います。

’将来的にはこの#requireは不要になる。
#require 
#require 
#require 

'comctl32.dll v6を指定するマニフェストをリソースへ。
#resource "UI_Sample.rc"

Const ETDT_ENABLE = 2
Const ETDT_USETABTEXTURE = 4
Const ETDT_ENABLETAB = (ETDT_ENABLE Or ETDT_USETABTEXTURE)

Declare Function EnableThemeDialogTexture Lib "uxtheme" (hwnd As HWND, dwFlags As DWord) As HRESULT

Imports ActiveBasic
Imports ActiveBasic.Windows.UI

Declare Function EndDialog Lib "user32" (hDlg As HWND, nResult As LONG_PTR) As BOOL

Function GetMessageBoxFont() As HFONT
    Dim ncm As NONCLIENTMETRICS
    ncm.cbSize = Len(ncm)
    SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, VarPtr(ncm), 0)
    GetMessageBoxFont = CreateFontIndirect(ncm.lfMessageFont)
End Function

Class MyForm
    Inherits Dialog
Public
    Sub MyForm()
        AddMessageEvent(WM_INITDIALOG, AddressOf(OnInitDialog))
    End Sub

Private
    Sub OnInitDialog(sender As Object, e As MessageArgs)
        Move(100, 100, 80, 100)

        Dim wpFont = GetMessageBoxFont() As WPARAM

        buttonOk = New Button
        With buttonOk
            .Create(This, BS_DEFPUSHBUTTON, 0, IDCANCEL)
            .Move(10, 10, 50, 30)
            .Text = "Close"
            .AddClick(AddressOf(OnOK))
            .SendMessage(WM_SETFONT, wpFont, 0)
        End With

        EnableThemeDialogTexture(This As HWND, ETDT_ENABLETAB)

        e.LResult = TRUE
    End Sub

    Sub OnOK(sender As Object, e As Args)
        EndDialog(This, 0)
    End Sub

    buttonOk As Button
End Class

Control.Initialize(GetModuleHandle(0))
InitCommonControls()

Dim f = New MyForm
f.DoModal(Nothing)

スポンサード リンク

この記事のカテゴリ

  • ⇒ テーマテクスチャ
  • ⇒ テーマテクスチャ