IUIFramework // Scenic Ribbon in Delphi App wird nicht angezeigt

[bepe]

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 WndProc . Dort wird das Framework mit tmpFrameW.Initialize (scheinbar fehlerfrei) initialisiert und der Referenzzähler von MyApp geht rauf. Dann sollte mit tmpFrameW.LoadUI die Ribbon Definition geladen werden. Auch hier tritt kein Fehler auf aber der Referenzzähler von 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

[bepe]

Sollte es jemanden interessieren, ich habe den Fehler ausfindig gemacht. Im IUIFramework fehlt noch eine Funktion:

function Destroy: HRESULT; stdcall;

Diese wird in der "UIRibbon.h" einfach nicht mit aufgeführt. Im online SDK und in der "UIRIbbon.idl" ist sie aber definiert.

Abgesehen davon gibt es noch zwei, drei weitere kleinere Fehler in meiner Übersetzung. Der Parameter CommandHandler von IUIApplication.OnCreateUICommand ist ein Out Parameter und sollte dementsprechend als out oder var gekennzeichnet werden. Außerdem ist bei mir nicht alles Pointer was Pointer sein sollte...

Auch wenn die Ribbons nicht unbedingt beliebt sind: Sollte Interesse bestehen kann ich meine Übersetzung, wenn sie fertig ist, gerne zur Verfügung stellen...

Und mir gefällt es

[nytaiceman]

Hallo bepe,

ich wäre sehr interessiert an einer solchen Ribbon Implementation. Bisher habe ich noch keine positiven Erfahrungen damit machen können.

Danke für Deine weiteren Infos wenn Du damit fertig geworden bist.

Gruss

[generic]

In meinen Artikel bin ich damals einen anderen Weg gegangen.
Dort habe ich die IDL in eine TLB kompiliert und diese mit Delphi eingelesen.
Allerdings musste der Import auch angepasst werden.

http://www.delphipraxis.net/147834-d...tml#post999256

Der Beispielcode hat eine neue Url:
http://entwickler-magazin.de/zonen/m...043faf1ac3.zip

Ausgabe 02/10 Entwicklermagazin:
http://entwickler-magazin.de/zonen/m...urces,p,0.html

[bepe]

@nytaiceman
Dann sehe ich mal zu, das Ganze sauber zu implementieren. Nicht dass es als Quick 'n' Dirty Spielprojekt verkommt...

@generic
Das hätte mir mal einer sagen sollen. Habe doch eine Weile nach einer Übersetzung gesucht und nichts gefunden.

Die TLB war auch mein erster Gedanke aber das ist bei mir kläglich gescheitert. Ich befürchte dazu würde ich das Visual Studio benötigen, denn nur die midl.exe aus dem SDK war mir keine Hilfe.

Naja, jetzt habe ich eine Übersetzung die ich kenne und für den Fall der Fälle ein Nachschlagewerk. Danke.

[generic]

Zitat von bepe:

@generic
Das hätte mir mal einer sagen sollen. Habe doch eine Weile nach einer Übersetzung gesucht und nichts gefunden.

Hättest du hier gefragt (oder gesucht)

Am 17. Feb 2010 gab es schon einmal einen Betrag zu dem Thema.
http://www.delphipraxis.net/147834-d...ic-ribbon.html