1
我已經玩了一些風景帶API（Windows Ribbon Framework）。這是我的結果：風景絲帶不會出現在Delphi窗體中//有任何想法嗎？
program RibTest;
uses
Windows,
Messages,
ActiveX,
ComObj;
{$R 'e:\ribbon\test.res'}
type
UI_VIEWTYPE = (UI_VIEWTYPE_RIBBON = 1);
UI_VIEWVERB = (UI_VIEWVERB_CREATE = 0, UI_VIEWVERB_DESTROY = 1,
UI_VIEWVERB_SIZE = 2, UI_VIEWVERB_ERROR = 3);
UI_COMMANDTYPE = (UI_COMMANDTYPE_UNKNOWN = 0,
UI_COMMANDTYPE_GROUP = 1,
UI_COMMANDTYPE_ACTION = 2,
UI_COMMANDTYPE_ANCHOR = 3,
UI_COMMANDTYPE_CONTEXT = 4,
UI_COMMANDTYPE_COLLECTION = 5,
UI_COMMANDTYPE_COMMANDCOLLECTION = 6,
UI_COMMANDTYPE_DECIMAL = 7,
UI_COMMANDTYPE_BOOLEAN = 8,
UI_COMMANDTYPE_FONT = 9,
UI_COMMANDTYPE_RECENTITEMS = 10,
UI_COMMANDTYPE_COLORANCHOR = 11,
UI_COMMANDTYPE_COLORCOLLECTION = 12);
UI_EXECUTEVERB = (UI_EXECUTIONVERB_EXECUTE = 0,
UI_EXECUTIONVERB_PREVIEW = 1,
UI_EXECUTIONVERB_CANCELPREVIEW = 2);
IUIRibbon = interface
['{803982ab-370a-4f7e-a9e7-8784036a6e26}']
function GetHeight(var CY: UInt32): HRESULT; StdCall;
function LoadSettingsFromStream(Stream: IStream): HRESULT; StdCall;
function SaveSettingsToStream(Stream: IStream): HRESULT; StdCall;
end;
IUISimplePropertySet = interface
['{c205bb48-5b1c-4219-a106-15bd0a5f24e2}']
function GetValue(Key: TPropertyKey; var Value: TPropVariant): HRESULT; StdCall;
end;
IUICommandHandler = interface
['{75ae0a2d-dc03-4c9f-8883-069660d0beb6}']
function Execute(CommandID: UInt32; Verb: UI_EXECUTEVERB; Key: TPropertyKey;
Value: TPropVariant; ExecProps: IUISimplePropertySet): HRESULT; StdCall;
function UpdateProperty(CommandID: UInt32; Key: TPropertyKey; CurrValue: TPropVariant;
var NewValue: TPropertyKey): HRESULT; StdCall;
end;
IUIApplication = interface
['{D428903C-729A-491d-910D-682A08FF2522}']
function OnViewChanged(ViewID: UInt32; TypeID: UI_VIEWTYPE; View: IUnknown;
Verb: UI_VIEWVERB; ReasonCode: Int32): HRESULT; stdcall;
function OnCreateUICommand(CommandID: UInt32; TypeID: UI_COMMANDTYPE;
CommandHandler: IUICommandHandler): HRESULT; stdcall;
function OnDestroyUICommand(CommandID: UInt32; TypeID: UI_COMMANDTYPE;
CommandHandler: IUICommandHandler): HRESULT; stdcall;
end;
UI_INVALIDATIONS = (UI_INVALIDATIONS_STATE = 1, UI_INVALIDATIONS_VALUE = 2,
UI_INVALIDATIONS_PROPERTY = 4, UI_INVALIDATIONS_ALLPROPERTIES = 8);
IUIFramework = interface
['{F4F0385D-6872-43a8-AD09-4C339CB3F5C5}']
function Initialize(FrameWnd: HWND; App: IUIApplication): HRESULT; StdCall;
function LoadUI(Instance: Cardinal; RecName: LPCWSTR): HRESULT; StdCall;
function GetView(ViedID: Uint32; RiID: TIID; var PPV: Pointer): HRESULT; StdCall;
function GetUICommandProperty(CommandID: UInt32; Key: TPropertyKey;
var Value: TPropVariant): HRESULT; StdCall;
function SetUICommandProperty(CommandID: UInt32; Key: TPropertyKey;
Value: TPropVariant): HRESULT; StdCall;
function InvalidateUICommand(CommandID: UInt32; Flags: UI_INVALIDATIONS;
const Key: PPropertyKey): HRESULT; StdCall;
function FlushPendingInvalidations: HRESULT; StdCall;
function SetModes(iModes: Int32): HRESULT; StdCall;
end;
TTest = class(TInterfacedObject, IUIApplication)
public
function OnViewChanged(ViewID: UInt32; TypeID: UI_VIEWTYPE; View: IUnknown;
Verb: UI_VIEWVERB; ReasonCode: Int32): HRESULT; stdcall;
function OnCreateUICommand(CommandID: UInt32; TypeID: UI_COMMANDTYPE;
CommandHandler: IUICommandHandler): HRESULT; stdcall;
function OnDestroyUICommand(CommandID: UInt32; TypeID: UI_COMMANDTYPE;
CommandHandler: IUICommandHandler): HRESULT; stdcall;
end;
const
CLSID_UIRibbonFramework: TGUID = '{926749fa-2615-4987-8845-c33e65f2b957}';
var
MyApp: TTest;
MeinHandle: HWND;
tmpFrameW: IUIFramework;
function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
var
Res: HRESULT;
begin
Result := 0;
case uMsg OF
WM_CREATE:
begin
CoInitialize(nil);
CoCreateInstance(CLSID_UIRibbonFramework, nil, CLSCTX_INPROC_SERVER,
IUIFramework, tmpFrameW);
if Succeeded(tmpFrameW.Initialize(hWnd, IUIApplication(MyApp))) then
begin
Res := tmpFrameW.LoadUI(HInstance, PChar('APPLICATION_RIBBON'));
if not Succeeded(Res)then
sleep(5);
end;
end;
WM_DESTROY:
begin
PostQuitMessage(0);
end;
else
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;
end;
var
wc: TWndClassEx;
msg: TMSG;
{ TTest }
function TTest.OnCreateUICommand(CommandID: UInt32; TypeID: UI_COMMANDTYPE;
CommandHandler: IUICommandHandler): HRESULT;
begin
Result := E_NOTIMPL;
end;
function TTest.OnDestroyUICommand(CommandID: UInt32; TypeID: UI_COMMANDTYPE;
CommandHandler: IUICommandHandler): HRESULT;
begin
Result := E_NOTIMPL;
end;
function TTest.OnViewChanged(ViewID: UInt32; TypeID: UI_VIEWTYPE;
View: IUnknown; Verb: UI_VIEWVERB; ReasonCode: Int32): HRESULT;
begin
Result := E_NOTIMPL;
end;
begin
MyApp := TTest.Create;
wc.cbSize := SizeOf(TWndClassEx);
wc.style := 0;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hbrBackground := COLOR_WINDOW;
wc.lpszMenuName := nil;
wc.lpszClassName := 'MeinRibbon';
wc.hIconSm := 0;
wc.hInstance := HInstance;
wc.hIcon := LoadIcon(HInstance, MAKEINTRESOURCE(1));
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.lpfnWndProc := @WndProc;
RegisterClassEx(wc);
MeinHandle := CreateWindow('MeinRibbon', 'TestAPP',
WS_OVERLAPPED or WS_CLIPCHILDREN or WS_SYSMENU or WS_CAPTION,
Integer(CW_USEDEFAULT), 0, Integer(CW_USEDEFAULT), 0, HWND_DESKTOP,
0, HInstance, nil);
ShowWindow(MeinHandle, SW_SHOWNORMAL);
UpdateWindow(MeinHandle);
while True do
begin
if not GetMessage(msg, 0, 0, 0) then break;
translatemessage(msg);
dispatchmessage(msg);
end;
ExitCode := GetLastError;
end.
一切都運行沒有錯誤。我使用Ribbon二進制XML定義創建了一個資源，並將其正確鏈接到我的可執行文件中。但是我的窗戶沒有絲帶。
重要部分是WndProc。框架被初始化爲tmpFrameW.Initialize（似乎是正確的）。參考計數器MyApp（這是我的IUIApplication實施）增加。在致電tmpFrameW.LoadUI時，應該加載功能區定義。此調用中沒有錯誤（結果爲0且沒有異常提升），但參考計數器MyApp減少。
這就是發生了什麼......有沒有人有一個想法我做錯了什麼？