jvbandobject.pas

East make Tray Icon in delphi

begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.Load()');
  {$ENDIF DEBUGINFO_ON}
  Result := S_OK;
end;

function TzCustomBandObject.Save(const Strm: IStream; ClearDirty: BOOL): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.Save()');
  {$ENDIF DEBUGINFO_ON}
  Result := S_OK;
end;

function TzCustomBandObject.GetSizeMax(out Size: Largeint): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.GetSizeMax()');
  {$ENDIF DEBUGINFO_ON}
  Size := 0;
  Result := S_OK;
end;

// IPersist

function TzCustomBandObject.GetClassID(out ClassID: TCLSID): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.GetClassID()');
  {$ENDIF DEBUGINFO_ON}
  ClassID := Factory.ClassID;
  {$IFDEF DEBUGINFO_ON}
  zTraceLog('  ClassID=' + GUIDToString(ClassID));
  {$ENDIF DEBUGINFO_ON}
  Result := S_OK;
end;

// IInputObject

function TzCustomBandObject.UIActivateIO(Activate: BOOL;
  var Msg: TMsg): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.UIActivateIO()');
  if Activate then
    zTraceLog('  Activate=True')
  else
    zTraceLog('  Activate=False');
  {$ENDIF DEBUGINFO_ON}
  Result := S_OK;
  FHasFocus := Activate;
  if not Assigned(FBandForm) then
    Exit;
  if Activate then
    FBandForm.SetFocus;
end;

function TzCustomBandObject.HasFocusIO: HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.HasFocusIO()');
  {$ENDIF DEBUGINFO_ON}
  Result := Ord(not FHasFocus);
//  Result := iif(Assigned(FBandForm) and FBandForm.Focused,
//    S_OK, S_FALSE);
  {$IFDEF DEBUGINFO_ON}
  zTraceLog('  Result=' + IntToStr(Result));
  {$ENDIF DEBUGINFO_ON}
end;

function TzCustomBandObject.TranslateAcceleratorIO(var Msg: TMsg): HRESULT;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.TranslateAcceleratorIO()');
  {$ENDIF DEBUGINFO_ON}
  Result := S_FALSE;
end;

procedure TzCustomBandObject.BandWndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_PARENTNOTIFY then
  begin
    FHasFocus := True;
    FocusChange(True);
  end;
  //if (Msg.Msg >= WM_KEYFIRST) and (Msg.Msg <= WM_KEYLAST) then
  //  SendMessage(FBandForm.Handle, Msg.Msg, Msg.wParam, Msg.lParam);
  FSavedWndProc(Msg);
end;

procedure TzCustomBandObject.FocusChange(HasFocus: Boolean);
var
  Obj: IUnknown;
begin
  if Site <> nil then
  begin
    if Supports(FBandForm, IUnknown, Obj) then
      Site.OnFocusChangeIS(Obj, HasFocus);
  end;
end;

function TzCustomBandObject.MsgHookProc(nCode, wParam, lParam: Integer): Integer;
var
  lOk: Boolean;
begin
  try
    if FBandForm <> nil then
    begin
      lOk := False;
      with PMsg(Pointer(lParam))^ do
      begin
        if (((message = WM_KEYDOWN) or (message = WM_KEYUP)) and
          ((wParam = VK_BACK))) then
          lOk := True
        else
        if message = WM_MOUSEMOVE then //Enable Flat effects!
          Application.HandleMessage;
      end;
      if lOk then
        if IsDialogMessage(FBandForm.Handle, PMsg(Pointer(lParam))^) then
          PMsg(lParam)^.message := WM_NULL;
    end;
  except
  end;
  Result := CallNextHookEx(FHook, nCode, wParam, lParam);
end;

//=== { TzContextMenuBandObject } ============================================

// IContextMenu

function GetContextMenuCaption(const MenuItem: TMenuItem): string;
begin
  Result := MenuItem.Caption;
  if MenuItem.Count > 0 then
    Exit;
  if (MenuItem.ShortCut <> scNone) and
    ((MenuItem.Parent = nil) or (MenuItem.Parent.Parent <> nil) or not (MenuItem.Parent.Owner is TMainMenu)) then
    Result := Result + Tab + ShortCutToText(MenuItem.ShortCut);
end;

(* make Delphi 5 compiler happy // andreas
function AddContextMenuItem(const MenuItem: TMenuItem; const AMenu: HMENU;
  const idCmdFirst: UINT; ARightToLeft: Boolean; out idCMD : uInt): Boolean;
const
  RightToLeftMenuFlag = MFT_RIGHTORDER or MFT_RIGHTJUSTIFY;
  IBreaks: array [TMenuBreak] of DWORD = (MFT_STRING, MFT_MENUBREAK, MFT_MENUBARBREAK);
  IChecks: array [Boolean] of DWORD = (MFS_UNCHECKED, MFS_CHECKED);
  IDefaults: array [Boolean] of DWORD = (0, MFS_DEFAULT);
  IEnables: array [Boolean] of DWORD = (MFS_DISABLED or MFS_GRAYED, MFS_ENABLED);
  IRadios: array [Boolean] of DWORD = (MFT_STRING, MFT_RADIOCHECK);
  ISeparators: array [Boolean] of DWORD = (MFT_STRING, MFT_SEPARATOR);
  IRTL: array [Boolean] of DWORD = (0, RightToLeftMenuFlag);
  IOwnerDraw: array [Boolean] of DWORD = (MFT_STRING, MFT_OWNERDRAW);
var
  MenuItemInfo: TMenuItemInfo;
  IsOwnerDraw: Boolean;
  ParentMenu: TMenu;
  Count: Integer;
begin
  Result := False;
  if not MenuItem.Visible then
    Exit;
  MenuItemInfo.cbSize := SizeOf(TMenuItemInfo);
  MenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
    MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
  ParentMenu := MenuItem.GetParentMenu;
  IsOwnerDraw := Assigned(ParentMenu) and
    (ParentMenu.OwnerDraw or (MenuItem.GetImageList <> nil)) or
    Assigned(MenuItem.Bitmap) and not MenuItem.Bitmap.Empty;
  MenuItemInfo.fType := IRadios[MenuItem.RadioItem] or
    IBreaks[MenuItem.Break] or
    ISeparators[MenuItem.Caption = cLineCaption] or
    IRTL[ARightToLeft] or
    IOwnerDraw[IsOwnerDraw];
  MenuItemInfo.fState := IChecks[MenuItem.Checked] or
    IEnables[MenuItem.Enabled] or
    IDefaults[MenuItem.Default];
  MenuItemInfo.wID := MenuItem.Command + idCmdFirst;
  MenuItemInfo.hbmpChecked := 0;
  MenuItemInfo.hbmpUnchecked := 0;
  MenuItemInfo.dwTypeData := PChar(GetContextMenuCaption(MenuItem));
  if MenuItem.Count > 0 then
    MenuItemInfo.hSubMenu := MenuItem.Handle
  else
  begin
    MenuItemInfo.fMask := MenuItemInfo.fMask or MIIM_SUBMENU;
    MenuItemInfo.hSubMenu := CreateMenu;
    for Count := 0 to MenuItem.Count do
      if AddContextMenuItem(MenuItem[Count], MenuItemInfo.hSubMenu, idCmdFirst, ARightToLeft,idCMD) then
        idCmd := Max(idCmd, MenuItem[Count].Command);
  end;
  Result := InsertMenuItem(AMenu, DWORD(-1), True, MenuItemInfo);
  {$IFDEF DEBUGINFO_ON}
  if not Result then
    Exit;
  zTraceLog('  Menu item added, MenuItem.Command=' + IntToStr(MenuItem.Command));
  zTraceLog('    Count=' + IntToStr(MenuItem.Count));
  zTraceLog('    Handle=' + Format('0x%x', [MenuItemInfo.hSubMenu]));
  {$ENDIF DEBUGINFO_ON}
end;
*)

function TzContextMenuBandObject.QueryContextMenu(AMenu: HMENU; IndexMenu,
  idCmdFirst, idCmdLast, uFlags: UINT): HRESULT;
//var
//  idCmd: UINT;

  procedure SetItemParams(var ItemInfo: TMenuItemInfo; var MenuItem: TMenuItem);
  begin
    ItemInfo.fState := 0;
    if MenuItem.Checked then
      ItemInfo.fState := ItemInfo.fState or MFS_CHECKED
    else
      ItemInfo.fState := ItemInfo.fState or MFS_UNCHECKED;

    if MenuItem.Default then
      ItemInfo.fState := ItemInfo.fState or MFS_DEFAULT;
    if MenuItem.Enabled then
      ItemInfo.fState := ItemInfo.fState or MFS_ENABLED
    else
      ItemInfo.fState := ItemInfo.fState or MFS_DISABLED;

    ItemInfo.fType := 0;
    if MenuItem.Caption = '-' then
      ItemInfo.fType := ItemInfo.fType or MFT_SEPARATOR
    else
    begin
      ItemInfo.fType := ItemInfo.fType or MFT_STRING;
      ItemInfo.dwTypeData := PChar(MenuItem.Caption);
      ItemInfo.cch := Length(MenuItem.Caption);
    end;
    if MenuItem.RadioItem then
      ItemInfo.fType := ItemInfo.fType or MFT_RADIOCHECK;
  end;

  procedure InsertContextMenuItems(ThisMenu: HMENU; Items: PMenuItem; InsertIndex: Integer);
  var
    I: Integer;
    ItemInfo: TMenuItemInfo;
    TempItem: TMenuItem;
  begin
    for I := 0 to Items.Count - 1 do
    begin
      TempItem := Items^[I];
      if not TempItem.Visible then
        Continue;
      ItemInfo.cbSize := SizeOf(ItemInfo);
      ItemInfo.fMask := MIIM_DATA or MIIM_ID or MIIM_STATE or MIIM_TYPE;
      SetItemParams(ItemInfo, TempItem);
      ItemInfo.wID := idCmdFirst + Cardinal(FMenuItemLink.Count);
      if Items^[I].Count > 0 then
      begin
        ItemInfo.fMask := ItemInfo.fMask or MIIM_SUBMENU;
        ItemInfo.hSubMenu := CreateMenu;
        InsertContextMenuItems(ItemInfo.hSubMenu, @TempItem, 0);
      end;
      InsertMenuItem(ThisMenu, InsertIndex, True, ItemInfo);
      FMenuItemLink.Add(Pointer(Items^[I].ComponentIndex));
      InsertIndex := InsertIndex+1;
    end;
  end;

begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.QueryContextMenu()');
  zTraceLog('  IndexMenu: ' + IntToStr(IndexMenu));
  zTraceLog('  idCmdFirst: ' + IntToStr(idCmdFirst));
  zTraceLog('  idCmdLast: ' + IntToStr(idCmdLast));
  zTraceLog('  uFlags: ' + Format('0x%x', [uFlags]));
  {$ENDIF DEBUGINFO_ON}

  if not Assigned(FMenuItemLink) then
    FMenuItemLink := TList.Create;
  FMenuItemLink.Clear;
  if (CMF_DEFAULTONLY and uFlags) <> 0 then
  begin
    Result := MakeHResult(SEVERITY_SUCCESS, 0, 0);
    Exit;
  end;
  Result := MakeHResult(SEVERITY_SUCCESS, 0, 1);
  if not Assigned(FBandForm) then
    Exit;
  with FBandForm do
  begin
    if not Assigned(BandContextMenu) then
      Exit;
    //idCmd := idCmdFirst;
    with BandContextMenu do
      InsertContextMenuItems(AMenu, @BandContextMenu.Items, IndexMenu);
  end;
  Result := MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, FMenuItemLink.Count);
end;

procedure FindItem(Item: TMenuItem; SeekIndex: Integer; var CurrentIndex: Integer);
var
  Count: Integer;
begin
  if Item.Count > 0 then
    for Count := 0 to Item.Count-1 do
    begin
      if Item[Count].Count > 0 then
        FindItem(Item[Count], SeekIndex, CurrentIndex);

      if CurrentIndex = SeekIndex then
       Item[Count].Click;
      Inc(CurrentIndex);
    end;
end;

function TzContextMenuBandObject.InvokeCommand(var Ici: TCMInvokeCommandInfo): HRESULT;
var
  idCmd: UINT;
  ci: Integer;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.InvokeCommand()');
  {$ENDIF DEBUGINFO_ON}
  idCmd := LoWord(Ici.lpVerb);
  {$IFDEF DEBUGINFO_ON}
  zTraceLog('  idCmd=' + IntToStr(idCmd));
  {$ENDIF DEBUGINFO_ON}
  Result := E_INVALIDARG;
  if not Assigned(FBandForm) then
    Exit;
  with FBandForm do
  begin
    if not Assigned(BandContextMenu) then
      Exit;
    FindItem(BandContextMenu.Items, idCmd, ci);
    //if BandContextMenu.DispatchCommand(idCmd) then
    //   Result := NOERROR;
  end;
end;

function TzContextMenuBandObject.GetCommandString(idCmd, uType: UINT;
  pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HRESULT;
var
  MenuItem: TMenuItem;
begin
  {$IFDEF DEBUGINFO_ON}
  zTraceLog(ClassName + '.GetCommandString()');
  zTraceLog('  idCmd=' + IntToStr(idCmd));
  zTraceLog('  uType=' + Format('0x%x', [uType]));
  {$ENDIF DEBUGINFO_ON}
  Result := E_INVALIDARG;
  if not Assigned(FBandForm) then
    Exit;
  with FBandForm do
  begin
    if not Assigned(BandContextMenu) then
      Exit;
    case uType of
      GCS_HELPTEXT:
        begin
          MenuItem := BandContextMenu.FindItem(idCmd, fkCommand);
          if MenuItem = nil then
            Exit;
          StrCopy(pszName, PChar(MenuItem.Hint));
        end;
      GCS_VERB:
        begin
          MenuItem := BandContextMenu.FindItem(idCmd, fkCommand);
          if MenuItem = nil then
            Exit;
          StrCopy(pszName, PChar(GetContextMenuCaption(MenuItem)));
        end;
      GCS_VALIDATE:
        Result := NOERROR;
    end;
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.