Delphi-PRAXiS - Delphi IUIFramework // Scenic Ribbon in Delphi App wird nicht angezeigt

Hallo,

ich habe da mal ein wenig gespielt, mit dem Ziel in eine eigene Anwendung das Scenic Ribbon einzubinden. Dazu bietet MS ja nun ein Satz Interfaces an (Win7 und Vista SP1(?)). Dazu habe ich das

Windows Ribbon Framework gelesen und das geschrieben/gebastelt:

Delphi-Quellcode:

			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.

Ist nicht schön, weil schon viel probiert und aus einem NonVCL-Tut kopiert und.... eigentlich egal.

Also das funktioniert fehlerfrei. Und auch die Ressourcen Datei wurde anstandslos verarbeitet und korrekt in das Programm gelinkt. Aber mein Fenster wird angezeigt und ist leer. Kein Ribbon zu sehen...

Der interessante Teil befindet sich in

Delphi-Quellcode:

WndProc

. Dort wird das Framework mit

Delphi-Quellcode:

tmpFrameW.Initialize

(scheinbar fehlerfrei) initialisiert und der Referenzzähler von

Delphi-Quellcode:

MyApp

geht rauf. Dann sollte mit

Delphi-Quellcode:

tmpFrameW.LoadUI

die Ribbon Definition geladen werden. Auch hier tritt kein Fehler auf aber der Referenzzähler von

Delphi-Quellcode:

MyApp

geht wieder runter.

Das ist es was ich beobachten konnte/musste.... Jetzt meine Frage: Warum? Hat jemand eine Idee was ich falsch mache?

PS:
Auf Wunsch häng ich die Ressource an aber ich habe nur das Simple Ribbon Demo von MS verwendet (

hier zu finden). Und dann einfach (in meinem Fall):

Code:

UICC.exe e:\Ribbon\test.xml test.bml /header:test.h /res:test.rc

und

Code:

brcc32.exe e:\Ribbon\test.rc