Cinta escénica no se mostrará en el formulario Delphi // Nadie tiene una idea?

Question

He jugado un poco con la API de la cinta escénica ( Marco de cinta de Windows ). Este es mi resultado:

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.

Todo funciona sin un error. He hecho un recurso con la definición XML binario de la cinta y se puso vinculado correctamente en mi ejecutable. Pero mi ventana aparece sin la cinta.

La parte importante es en WndProc. El marco se inicializa con tmpFrameW.Initialize (parece ser correcta). El contador de referencia de MyApp (que es mi implementación IUIApplication) aumenta. Con un llamado a tmpFrameW.LoadUI la definición de la cinta debe ser cargado. No hay error en esta llamada (resultado es 0 y no hay aumentos de excepción), pero el contador de referencia de MyApp disminuye.

Esto es lo que pasa ... ¿Alguien tiene una idea de lo que estoy haciendo mal?

Answer 1

He encontrado el error ...

1. No estoy familiarizado con C o C ++. (Supongo) Por tanto, yo he pasado por alto algunos asteriscos y algunos de out. Así que hay algunos parametros incorrectos que conduce a errores menores.
2. Pero mi principal problema es el archivo de cabecera. En UIRibbon.h es la IUIFramework.Destroy función que falta. En el SDK en línea y en el UIRibbon.idl se define esta función. He añadido a mi interfaz y ahora todo funciona como se esperaba.