ab.com コミュニティ

'===========================================================
'
'	Windows　OSバージョン取得用関数
'
'===========================================================
#ifndef _INC_GETWINVER
#define _INC_GETWINVER

'---------
'定数宣言
'---------
'戻り値　－　Windowsのバージョン
Const WIN_VER_95				= &H01				'Windows95
Const WIN_VER_95_OSR2			= &H02				'Windows95 OSR2
Const WIN_VER_98				= &H03				'Windows98
Const WIN_VER_98_SE				= &H04				'Windows98 Second Edition
Const WIN_VER_ME				= &H05				'Windows Millenium Edition
Const WIN_VER_NT				= &H06				'Windows NT
Const WIN_VER_NT_2000			= &H07				'Windows 2000
Const WIN_VER_NT_XP				= &H08				'Windows XP
Const WIN_VER_NT_SERVER_2003	= &H09				'Windows Server 2003
Const WIN_VER_VISTA				= &H0A				'Windows Vista

'Windowsのバージョンを返す関数
Function GetWinVersion() As DWord
	Dim OsVerInfo As OSVERSIONINFO					'OSに関する情報を格納

	OsVerInfo.dwOSVersionInfoSize = SizeOf(OSVERSIONINFO)

	'OSのバージョンを変更
	GetVersionEx(OsVerInfo)

	IF OsVerInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
		'98系のOS
		Select Case OsVerInfo.dwMinorVersion
			Case 0
				If LOWORD(OsVerInfo.dwBuildNumber) = 950 Then
					'Windows 95
					GetWinVersion = WIN_VER_95
				ElseIf LOWORD(OsVerInfo.dwBuildNumber) > 1000 Then
					'Windows 95 OSR2
					GetWinVersion = WIN_VER_95_OSR2
				Else
					GetWinVersion = WIN_VER_95
				End If

				Exit Function
			Case 10
				If LOWORD(OsVerInfo.dwBuildNumber) = 1998 Then
					'Windows 98
					GetWinVersion = WIN_VER_98
				ElseIf LOWORD(OsVerInfo.dwBuildNumber) > 1998 Then
					'Windows 98 Second Edition
					GetWinVersion = WIN_VER_98_SE
				Else
					GetWinVersion = WIN_VER_98
				End If

				Exit Function
			Case 90
				'Windows Millenium Edition
				GetWinVersion = WIN_VER_ME
				Exit Function
		End Select
	ElseIf OsVerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then
		If OsVerInfo.dwMajorVersion = 4 Then
			'Windows NT
			GetWinVersion = WIN_VER_NT

			Exit Function
		ElseIf OsVerInfo.dwMajorVersion = 5 Then
			If OsVerInfo.dwMinorVersion = 0 Then
				'Windows 2000
				GetWinVersion = WIN_VER_NT_2000
			ElseIf OsVerInfo.dwMinorVersion = 1 Then
				'Windows XP
				GetWinVersion = WIN_VER_NT_XP
			ElseIf OsVerInfo.dwMinorVersion = 2 Then
				'Windows XP Professional x64 Edition / Windows Server 2003 / Windows Server 2003 R2
				GetWinVersion = WIN_VER_NT_SERVER_2003
			End If

			Exit Function
		ElseIf OsVerInfo.dwMajorVersion = 6 Then
			If OsVerInfo.dwMinorVersion = 0 Then
				'Windows Vista / Windows Server "Longhorn"
				GetWinVersion = WIN_VER_VISTA
			End If

			Exit Function
		End If
	End If			
End Function

#endif

Dim hUxThemeLib As HINSTANCE
Dim pEnableThemeDialogTexture As *Function(hWnd As HWND, dwFlags As DWord) As DWord

Const ETDT_ENABLE			= &H2
Const ETDT_USETABTEXTURE	= &H4
Const ETDT_ENABLETAB		= ETDT_ENABLE or ETDT_USETABTEXTURE

'--- MainWndのCreateイベント
If GetWinVersion() >= WIN_VER_NT_XP Then
	hUxThemeLib = LoadLibrary("UxTheme")

	If hUxThemeLib Then
		pEnableThemeDialogTexture = GetProcAddress(hUxThemeLib, "EnableThemeDialogTexture") As *Function
	End If
End If

'---タブに貼り付けるダイアログのCreateイベント
If GetWinVersion() >= WIN_VER_NT_XP Then
	EnableThemeDialogTexture([ダイアログのハンドル], ETDT_ENABLETAB)
End If

'--MainWndのDestroyイベント
If GetWinVersion() >= WIN_VER_NT_XP Then
	If hUxThemeLib Then FreeLibrary(hUxThemeLib)
End If