1
Ich habe ein wenig mit der Scenic Ribbon API gespielt (Windows Ribbon Framework). Das ist mein Ergebnis:Scenic Ribbon wird nicht in Delphi Form angezeigt // Hat jemand eine Idee?
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.
Alles läuft ohne Fehler. Ich habe eine Ressource mit der binären Ribbon-XML-Definition erstellt und sie wurde korrekt mit meiner ausführbaren Datei verknüpft. Aber mein Fenster erscheint ohne die Multifunktionsleiste.
Der wichtige Teil ist in WndProc. Das Framework wird mit tmpFrameW.Initialize initialisiert (scheint korrekt zu sein). Der Referenzzähler von MyApp (es ist meine IUIApplication Implementierung) erhöht. Bei einem Aufruf an tmpFrameW.LoadUI sollte die Ribbon-Definition geladen werden. Es gibt keinen Fehler in diesem Aufruf (Ergebnis ist 0 und keine Ausnahme wird ausgelöst), aber der Referenzzähler von MyApp sinkt.
Das ist was passiert ... Hat jemand eine Idee, was ich falsch mache?