Nastro Scenic non verrà visualizzato in Delphi Form // Qualcuno ha un'idea?
-
30-09-2019 - |
Domanda
Ho giocato un po 'con l'API Scenic Ribbon ( di Windows Ribbon Framework ). Questo è il mio risultato:
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.
Il tutto viene eseguito senza errori. Ho fatto una risorsa con la barra multifunzione definizione XML binario e ha ottenuto legato correttamente nel mio eseguibile. Ma appare la mia finestra senza la barra multifunzione.
La parte importante è in WndProc
. Il quadro viene inizializzato con tmpFrameW.Initialize
(sembra essere corretta). Il contatore di riferimento di MyApp
(è la mia IUIApplication
attuazione) aumenta. Con una chiamata al tmpFrameW.LoadUI
la definizione del nastro dovrebbe essere caricato. Non v'è alcun errore in questa chiamata (risultato è 0 e rilanci eccezione) ma il contatore di riferimento MyApp
diminuisce.
Ecco cosa succede ... Qualcuno ha un'idea di ciò che sto facendo male?
Soluzione
Ho trovato l'errore ...
- Non ho familiarità con C o C ++. (Credo) quindi ho trascurato alcuni asterischi e qualche
out
di. Quindi ci sono alcuni params non corretti che porta a bug minori. - Ma il mio problema principale è il file di intestazione. In
UIRibbon.h
è la funzioneIUIFramework.Destroy
mancanti. Nel SDK in linea e nelUIRibbon.idl
viene definita questa funzione. Ho aggiunto al mio interfaccia e ora tutto funziona come previsto.