#Include Once "windows.bi"
#Include Once "win/shlobj.bi"
#Undef IUnknown

Enum UI_EXECUTIONVERB
	UI_EXECUTIONVERB_EXECUTE
	UI_EXECUTIONVERB_PREVIEW
	UI_EXECUTIONVERB_CANCELPREVIEW
End Enum

Enum UI_VIEWTYPE
	UI_VIEWTYPE_RIBBON	= 1
End Enum

Enum UI_VIEWVERB
	UI_VIEWVERB_CREATE
	UI_VIEWVERB_DESTROY
	UI_VIEWVERB_SIZE
	UI_VIEWVERB_ERROR
End Enum

Enum UI_COMMANDTYPE
	UI_COMMANDTYPE_UNKNOWN
	UI_COMMANDTYPE_GROUP
	UI_COMMANDTYPE_ACTION
	UI_COMMANDTYPE_ANCHOR
	UI_COMMANDTYPE_CONTEXT
	UI_COMMANDTYPE_COLLECTION
	UI_COMMANDTYPE_COMMANDCOLLECTION
	UI_COMMANDTYPE_DECIMAL
	UI_COMMANDTYPE_BOOLEAN
	UI_COMMANDTYPE_FONT
	UI_COMMANDTYPE_RECENTITEMS
	UI_COMMANDTYPE_COLORANCHOR
	UI_COMMANDTYPE_COLORCOLLECTION
End Enum

Enum UI_INVALIDATIONS
	UI_INVALIDATIONS_STATE	= &h1,
	UI_INVALIDATIONS_VALUE	= &h2,
	UI_INVALIDATIONS_PROPERTY	= &h4,
	UI_INVALIDATIONS_ALLPROPERTIES	= &h8
End Enum

Dim Shared  IID_IUIFRAMEWORK As IID  = Type( &hf4f0385d, &h6872, &h43a8, {&had, &h09, &h4c, &h33, &h9c, &hb3, &hf5, &hc5})
Dim Shared  IID_IUICommandHandler As IID  = Type(&h75ae0a2d, &hdc03, &h4c9f, {&h88, &h83, &h06, &h96, &h60, &hd0, &hbe, &hb6})
Dim Shared  IID_IUIAPPLICATION As IID  = Type(&hd428903c, &h729a, &h491d, {&h91, &h0d, &h68, &h2a, &h08, &hff, &h25, &h22})
Dim Shared  CLSID_UIRibbonFramework As IID  = Type(&h926749fa, &h2615, &h4987, {&h88, &h45, &hc3, &h3e, &h65, &hf2, &hb9, &h57})

Type IUnknown EXTENDS OBJECT

	Declare Constructor()
	Declare Destructor()
	Declare Virtual Function QueryInterface (ByVal iid As REFIID, ByVal ppvObject As Any Ptr Ptr) As HRESULT
	Declare Virtual Function AddRef () As ULong
	Declare Virtual Function Release () As ULong

	As Long m_lRefCount

End Type

Constructor IUnknown

	m_lRefCount  = 1

End Constructor

Destructor IUnknown()

End Destructor

Function IUnknown.QueryInterface (ByVal iid As REFIID, ByVal ppvObject As Any Ptr Ptr) As HRESULT

	If memcmp ( iid, @IID_IUIAPPLICATION,SizeOf(GUID)) = 0 Or _
		memcmp ( iid, @IID_IUnknown,SizeOf(GUID)) = 0  Or _
		memcmp ( iid, @IID_IUICommandHandler,SizeOf(GUID)) = 0 Then

		AddRef()
		*ppvObject = @This
		Return S_OK
		
	Else
		
		*ppvObject = NULL
		Return E_NOINTERFACE
		
	End If

End Function

Function IUnknown.AddRef () As ULong

	m_lRefCount += 1
	Return m_lRefCount

End Function

Function IUnknown.Release () As ULong

	m_lRefCount -= 1

	If(m_lRefCount = 0) Then
		Delete @This
		Return 0
	Else
		Return m_lRefCount
	End If

End Function


Type IUISimplePropertySet extends IUnknown
	Declare abstract Function GetValue(key As REFPROPERTYKEY,value As PROPVARIANT Ptr) As HRESULT
End Type

Type IUICommandHandler extends IUnknown
	Declare virtual Function Execute(commandId As UInteger,verb As UI_EXECUTIONVERB,key As PROPERTYKEY Ptr, currentValue As PROPVARIANT Ptr, commandExecutionProperties As IUISimplePropertySet Ptr) As HRESULT
	Declare virtual Function UpdateProperty(commandId As UInteger, key As REFPROPERTYKEY Ptr, currentValue As PROPVARIANT Ptr, newValue As PROPVARIANT Ptr) As HRESULT
End Type


Type IUIApplication extends IUnknown
	Declare virtual Function OnViewChanged(viewId As UInteger,typeID As UI_VIEWTYPE,View_ As IUnknown Ptr,verb As UI_VIEWVERB, uReasonCode As Integer) As HRESULT
	Declare virtual Function OnCreateUICommand(commandId As UInteger, typeID As UI_COMMANDTYPE, commandHandler As IUICommandHandler Ptr Ptr) As HRESULT
	Declare virtual Function OnDestroyUICommand(commandId As UInteger, typeID As UI_COMMANDTYPE, commandHandler As IUICommandHandler Ptr) As HRESULT
	Private:
	m_pCommandHandler As IUICommandHandler Ptr
End Type

Function IUICommandHandler.Execute(commandId As UInteger,verb As UI_EXECUTIONVERB,key As PROPERTYKEY Ptr, currentValue As PROPVARIANT Ptr, commandExecutionProperties As IUISimplePropertySet Ptr) As HRESULT
	MessageBox(0, "Êíîïêà ñ ID:" & commandiD,"",0)
	Return S_OK
End Function

Function IUICommandHandler.UpdateProperty(commandId As UInteger, key As REFPROPERTYKEY Ptr, currentValue As PROPVARIANT Ptr, newValue As PROPVARIANT Ptr) As HRESULT
	Return E_NOTIMPL
End Function

Function IUIApplication.OnViewChanged(viewId As UInteger,typeID As UI_VIEWTYPE,View_ As IUnknown Ptr,verb As UI_VIEWVERB, uReasonCode As Integer) As HRESULT
	Return E_NOTIMPL
End Function

Function IUIApplication.OnCreateUICommand(commandId As UInteger, typeID As UI_COMMANDTYPE, commandHandler As IUICommandHandler Ptr Ptr) As HRESULT
	If m_pCommandHandler = 0 Then
		m_pCommandHandler = New IUICommandHandler
	EndIf
	If m_pCommandHandler Then
		Return m_pCommandHandler->QueryInterface(@IID_IUICommandHandler ,commandHandler)
	EndIf
	Return E_NOTIMPL
End Function

Function IUIApplication.OnDestroyUICommand(commandId As UInteger, typeID As UI_COMMANDTYPE, commandHandler As IUICommandHandler Ptr) As HRESULT
	Return E_NOTIMPL
End Function

Type IUIFramework extends IUnknown
	Declare abstract Function Initialize(frameWnd As HWND ,application As IUIApplication Ptr) As HRESULT
	Declare abstract Function Destroy() As HRESULT
	Declare abstract Function LoadUI(instance As HINSTANCE, resourceName As LPCWSTR) As HRESULT
	Declare abstract Function GetView(viewId As UInteger ,riid As REFIID , ppv As Any Ptr Ptr) As HRESULT
	Declare abstract Function GetUICommandProperty(commandId As UInteger,key As REFPROPERTYKEY, value As PROPVARIANT Ptr) As HRESULT
	Declare abstract Function SetUICommandProperty(commandId As UInteger,key As REFPROPERTYKEY, value As REFPROPVARIANT) As HRESULT
	Declare abstract Function InvalidateUICommand(commandId As UInteger, flags As UI_INVALIDATIONS, key As PROPERTYKEY Ptr) As HRESULT
	Declare abstract Function FlushPendingInvalidations() As HRESULT
	Declare abstract Function SetModes(iModes As Integer) As HRESULT
End Type

Dim Shared As IUIFramework Ptr g_pFramework = NULL

Function InitializeFramework(hWnd As HWND ) As Integer

	Dim As HRESULT hr

	hr = CoCreateInstance(@CLSID_UIRibbonFramework, NULL, CLSCTX_INPROC_SERVER, @IID_IUIFRAMEWORK, @g_pFramework)

	If (FAILED(hr)) Then
		Return(FALSE)
	Else
		Dim As IUIApplication Ptr pApplication = New  IUIApplication
		Dim As Any Ptr ppvObj = NULL

		hr = pApplication->QueryInterface(@IID_IUIAPPLICATION, @ppvObj)

		hr = g_pFramework->Initialize(hWnd, ppvObj)

		If (FAILED(hr)) Then Return false
		pApplication->Release()

		hr = g_pFramework->LoadUI(GetModuleHandle(0), "APPLICATION_RIBBON")
		If (FAILED(hr)) Then Return false

	EndIf
	Return(TRUE)

End Function

Sub DestroyRibbon()

	Dim As HRESULT hr
	If g_pFramework Then
		hr = g_pFramework->Destroy()
		g_pFramework = NULL
	EndIf

End Sub

Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As String NameClass="MyClass"
Dim As HINSTANCE Hinst=GetModuleHandle(0)

Function wndproc(hwnd As HWND, msg As UInteger,_
	wparam As WPARAM, lparam As LPARAM) As Integer
	Select Case msg
		Case WM_CREATE
			If InitializeFramework(hWnd) = 0 Then Return false
		Case WM_DESTROY
			DestroyRibbon()
			PostQuitMessage(0)
	End Select
	Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

With wc
	.cbSize=SizeOf(WNDCLASSEX)
	.style=CS_HREDRAW Or CS_VREDRAW
	.lpfnWndProc=@wndproc
	.hInstance=Hinst
	.hIcon=LoadIcon(0,IDI_WINLOGO)
	.hCursor=LoadCursor(0,IDC_CROSS)
	.hbrBackground=Cast(HBRUSH,COLOR_WINDOWFRAME)
	.lpszClassName=StrPtr(NameClass)
	.hIconSm=.hIcon
End With

If RegisterClassEx(@wc)=0 Then
	Print "Register error, press any key"
	Sleep
	End
EndIf

If CoInitialize(0) Then End

CreateWindowEx(0,NameClass,"RIBBON",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW Or WS_CLIPCHILDREN,100,100,555,255,0,0,Hinst,0)

While GetMessage(@msg,0,0,0)
	TranslateMessage(@msg)
	DispatchMessage(@msg)
Wend
CoUninitialize()