لن يظهر الشريط المناظر الخلابة في نموذج دلفي // هل لدى أي شخص فكرة؟

StackOverflow https://stackoverflow.com/questions/4332977

سؤال

لقد لعبت قليلاً مع واجهة برمجة تطبيقات الشريط الخلابة (إطار الشريط Windows). هذه هي نتيجتي:

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.

كل شيء يعمل دون خطأ. لقد صنعت موردًا مع تعريف الشريط الثنائي XML وتم ربطه بشكل صحيح في بلدي القابل للتنفيذ. لكن نافذتي تظهر بدون الشريط.

الجزء المهم هو في WndProc. يتم تهيئة الإطار مع tmpFrameW.Initialize (يبدو أنه صحيح). العداد المرجعي MyApp (إنه بلدي IUIApplication التنفيذ) يزيد. مع دعوة إلى tmpFrameW.LoadUI يجب تحميل تعريف الشريط. لا يوجد خطأ في هذه المكالمة (النتيجة هي 0 ولا يوجد استثناء يثير) ولكن العداد المرجعي MyApp ينخفض.

هذا ما يحدث ... هل لدى أي شخص فكرة عما أفعله خطأ؟

هل كانت مفيدة؟

المحلول

لقد وجدت الخطأ ...

  1. لست على دراية بـ C أو C ++. (أعتقد) لذلك تجاهلت بعض العلامات النجمية والبعض out'س. لذلك هناك بعض المعلمات غير الصحيحة التي تؤدي إلى الأخطاء البسيطة.
  2. لكن مشكلتي الرئيسية هي ملف الرأس. في UIRibbon.h هي الوظيفة IUIFramework.Destroy مفقود. في SDK عبر الإنترنت وفي UIRibbon.idl يتم تعريف هذه الوظيفة. أضفتها إلى واجهتي والآن كل شيء يعمل مثل المتوقع.
مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top