jvsystempopup.pas

East make Tray Icon in delphi

  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;
  Caption: string;
  NewFlags: Integer;
  IsOwnerDraw: Boolean;
  ParentMenu: TMenu;
begin
  Result := AMenuItem.Visible;
  if not Result then
    Exit;

  Caption := AMenuItem.Caption;
  if AMenuItem.Count > 0 then
  begin
    SubMenu := CreatePopupMenu;
    MenuItemInfo.hSubMenu := SubMenu;
  end
  else
  if (AMenuItem.ShortCut <> scNone) and ((AMenuItem.Parent = nil) or
    (AMenuItem.Parent.Parent <> nil) or not (AMenuItem.Parent.Owner is TMainMenu)) then
    Caption := Caption + Tab + ShortCutToText(AMenuItem.ShortCut);
  if Lo(GetVersion) >= 4 then
  begin
    MenuItemInfo.cbSize := 44; // Required for Windows 95
    MenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
      MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
    ParentMenu := AMenuItem.GetParentMenu;
    //      IsOwnerDraw := Assigned(ParentMenu) and ParentMenu.IsOwnerDraw or
    IsOwnerDraw := Assigned(ParentMenu) and
      (ParentMenu.OwnerDraw or (AMenuItem.GetImageList <> nil)) or
      Assigned(AMenuItem.Bitmap) and not AMenuItem.Bitmap.Empty;
    MenuItemInfo.fType := IRadios[AMenuItem.RadioItem] or
      IBreaks[AMenuItem.Break] or
      ISeparators[AMenuItem.Caption = cLineCaption] or IRTL[ARightToLeft] or
      IOwnerDraw[IsOwnerDraw];
    MenuItemInfo.fState := IChecks[AMenuItem.Checked] or
      IEnables[AMenuItem.Enabled] or IDefaults[AMenuItem.Default];
    MenuItemInfo.wID := AMenuItem.Command;
    MenuItemInfo.hSubMenu := 0;
    MenuItemInfo.hbmpChecked := 0;
    MenuItemInfo.hbmpUnchecked := 0;
    MenuItemInfo.dwTypeData := PChar(Caption);
    if AMenuItem.Count > 0 then
    begin
      MenuItemInfo.hSubMenu := SubMenu;
    end;
    InsertMenuItem(Menu, DWORD(InsertAt), True, MenuItemInfo);
  end
  else
  begin
    NewFlags := Breaks[AMenuItem.Break] or Checks[AMenuItem.Checked] or
      Enables[AMenuItem.Enabled] or
      Separators[AMenuItem.Caption = cLineCaption] or MF_BYPOSITION;
    if AMenuItem.Count > 0 then
      InsertMenu(Menu, DWORD(InsertAt), MF_POPUP or NewFlags,
        SubMenu, PChar(AMenuItem.Caption))
    else
      InsertMenu(Menu, DWORD(InsertAt), NewFlags, AMenuItem.Command,
        PChar(AMenuItem.Caption));
  end;
end;

procedure IterateMenu(AMenu: HMENU; AMenuItem: TMenuItem;
  ARightToLeft: Boolean; InsertAt: Integer);
var
  I: Integer;
  SubMenu: HMENU;
begin
  with AMenuItem do
    for I := 0 to Count - 1 do
    begin
      if AppendMenuItemTo(AMenu, Items[I], ARightToLeft, InsertAt, SubMenu) and
        (InsertAt >= 0) then
        Inc(InsertAt);

      if SubMenu > 0 then
        IterateMenu(SubMenu, Items[I], ARightToLeft, 0);
    end;
end;

procedure TJvSystemPopup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FPopup) and (Operation = opRemove) then
    Popup := nil;
end;

procedure TJvSystemPopup.PopulateMenu;
var
  Menu: HMENU;
  MenuItemInfo: TMenuItemInfo;
  MenuRightToLeft: Boolean;
  InsertAt: Integer;
begin
  { Add all MenuItems to the systemmenu }
  if (ComponentState * [csDesigning, csLoading] <> []) or
    (FPosition = ppNone) or (FPopup = nil) then
    Exit;

  MenuRightToLeft := FPopup.IsRightToLeft;

  Menu := GetMenu;
  if Menu = 0 then
    Exit;

  if PositionInMenu = pmTop then
    InsertAt := 0
  else
    InsertAt := -1;

  if FPopup.Items.Count > 0 then
  begin
    { Add a seperator }
    FillChar(MenuItemInfo, SizeOf(MenuItemInfo), #0);
    MenuItemInfo.cbSize := 44; //SizeOf(MenuItemInfo);
    MenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or
      MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
    MenuItemInfo.fType := MFT_SEPARATOR;
    { Give the seperator menu id $EFFF so we can seperate these from the
      normal seperators (with id=0), that we don't want to remove in procedure
      RemoveNonDefaultItems }
    MenuItemInfo.wID := $EFFF;
    InsertMenuItem(Menu, DWORD(InsertAt), True, MenuItemInfo);
  end;

  IterateMenu(Menu, FPopup.Items, MenuRightToLeft, InsertAt);
end;

procedure TJvSystemPopup.Refresh(SystemReset: Boolean = True);
begin
  ResetSystemMenu(SystemReset);
  PopulateMenu;
end;

procedure TJvSystemPopup.ResetSystemMenu(SystemReset: Boolean);

  // Hack, the original GetSystemMenu( , True) version called by Refresh
  // does not have affect immediately in WM_INITMENU state
  // (at least on Win Xp surely not)
  procedure RemoveNonDefaultItems(Menu: HMENU);
  var
    Id: Longword;
    C: Integer;
  begin
    if GetMenuItemCount(Menu) > 0 then
    begin
      for C := GetMenuItemCount(Menu) - 1 downto 0 do
      begin
        Id := GetMenuItemID(Menu, C);
        { MSDN : All predefined window menu items have identifier numbers
          greater than $F000. If an application adds commands to the window
          menu, it should use identifier numbers less than $F000.

          NOTE : SC_SIZE = $F000, seperators seem to have id = 0, although
          SC_SEPARATOR is defined as $F00F.
        }
        // non default system command or an item with submenuitems
        if ((Id > 0) and (Id < $F000)) or (Id = $FFFFFFFF) then
        begin
          if GetMenuItemCount(GetSubMenu(Menu, C)) > 0 then
            RemoveNonDefaultItems(GetSubMenu(Menu, C));
          DeleteMenu(Menu, C, MF_BYPOSITION);
        end;
      end;
    end;
  end;

begin
  { Reset the window menu back to the default state. The previous window
    menu, if any, is destroyed. }
  if ComponentState * [csDesigning, csLoading] <> [] then
    Exit;
  case FPosition of
    ppNone:
      ;
    ppForm:
      if Assigned(FOwnerForm) and not (csDestroying in FOwnerForm.ComponentState) then
        if SystemReset then
          RemoveNonDefaultItems(GetMenu)
        else
          GetSystemMenu(FOwnerForm.Handle, True);
    ppApplication:
      if SystemReset then
        RemoveNonDefaultItems(GetMenu)
      else
        GetSystemMenu(Application.Handle, True);
  end;
end;

procedure TJvSystemPopup.SetPopup(const Value: TPopupMenu);
begin
  if Assigned(FPopup) then
    FPopup.OnChange := nil;
  FPopup := Value;
  if Assigned(FPopup) then
  begin
    //FPopup.OnChange := MenuChanged;
    FPopup.FreeNotification(Self);
  end;
  //if not (csLoading in ComponentState) then
  //  Refresh;
end;

procedure TJvSystemPopup.SetPosition(const Value: TJvPopupPosition);
begin
  if FPosition = Value then
    Exit;

  if csDesigning in ComponentState then
  begin
    FPosition := Value;
    Exit;
  end;

  UnHook;
  ResetSystemMenu;
  FPosition := Value;
  Hook;
  //PopulateMenu;
end;

procedure TJvSystemPopup.SetPositionInMenu(const Value: TJvPositionInMenu);
begin
  FPositionInMenu := Value;
  //if ComponentState * [csLoading, csDesigning] = [] then
  //  Refresh;
end;

procedure TJvSystemPopup.UnHook;
begin
  if not FIsHooked then
    Exit;

  case FPosition of
    ppNone:
      ;
    ppForm:
      begin
        if not Assigned(FOwnerForm) then
          Exit;
        UnRegisterWndProcHook(FOwnerForm, HandleWndProc, hoBeforeMsg);
        FIsHooked := False;
      end;
    ppApplication:
      begin
        Application.UnhookMainWindow(HandleWndProc);
        FIsHooked := False;
      end;
  end;
end;

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.