Ruban panoramique ne sera pas affiché dans Delphi formulaire // Quelqu'un at-il une idée?
-
30-09-2019 - |
Question
Je l'ai joué un peu avec l'API de ruban Scenic ( Windows Framework ruban de ). Ceci est mon résultat:
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.
Tout fonctionne sans erreur. Je l'ai fait une ressource avec la définition XML binaire du ruban et ai bien compris dans mon exécutable lié. Mais ma fenêtre apparaît sans le ruban.
La partie importante est WndProc
. Le cadre s'initialisé avec tmpFrameW.Initialize
(semble être correct). Le compteur de référence de MyApp
(c'est ma mise en œuvre IUIApplication
) augmente. Avec un appel à tmpFrameW.LoadUI
la définition du ruban doit être chargé. Il n'y a pas d'erreur dans cet appel (résultat est 0 et aucune relances d'exception), mais le compteur de référence de MyApp
diminue.
Voilà ce qui arrive ... Est-ce que quelqu'un a une idée de ce que je fais mal?
La solution
J'ai trouvé l'erreur ...
- Je ne suis pas familier avec C ou C ++. (Je suppose) que j'ai donc pas tenu compte d'astérisques et quelques
out
de. Donc, il y a des params incorrectes qui conduit à des bogues de mineurs. - Mais mon principal problème est le fichier d'en-tête. Dans
UIRibbon.h
est la fonctionIUIFramework.Destroy
manquante. Dans le SDK en ligne et dans laUIRibbon.idl
cette fonction est définie. Je l'ai ajouté à mon interface et maintenant tout fonctionne comme prévu.