XPからのテーマAPIには、EnableThemeDialogTextureという関数があります。文字通りダイアログの背景をテーマのテクスチャにすることを許可する関数です。実際に絵を見てみたほうが早いでしょう。
使用前 | 使用後 |
---|---|
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)
スポンサード リンク |