rxmenus.pas

rxlib2.75控件包

      MaxW := Canvas.TextWidth(ShortCutToText(Item.ShortCut) + ' ');
      if (Item.Parent <> nil) and (Item.ShortCut <> scNone) then begin
        for I := 0 to Item.Parent.Count - 1 do
          with Item.Parent.Items[I] do begin
            Result := Max(Result, Canvas.TextWidth(DelChars(Caption, '&') + Tab));
            MaxW := Max(MaxW, Canvas.TextWidth(ShortCutToText(ShortCut) + ' '));
          end;
      end;
      Result := Result + MaxW;
      if Item.Count > 0 then Inc(Result, Canvas.TextWidth(Tab));
    end
    else Result := Canvas.TextWidth(DelChars(Item.Caption, '&'));
  end;

begin
  IsPopup := IsItemPopup(Item);
  ItemHeight := GetDefItemHeight;
  if IsPopup then begin
    ItemWidth := GetMarginOffset * 2;
{$IFDEF WIN32}
    if Assigned(Images) then
      MinOffset := Max(MinOffset, Images.Width + AddWidth);
{$ENDIF}
  end
  else begin
    ItemWidth := 0;
    MinOffset := 0;
  end;
  Inc(ItemWidth, GetTextWidth(Item));
  if IsPopup and ShowCheck then
    Inc(ItemWidth, LoWord(GetMenuCheckMarkDimensions));
  if Item.Caption = Separator then begin
    ItemHeight := Max(Canvas.TextHeight(Separator) div 2, 9);
  end
  else begin
    ItemHeight := Max(ItemHeight, Canvas.TextHeight(Item.Caption));
{$IFDEF WIN32}
    if Assigned(Images) and (IsPopup or ((ImageIndex >= 0) and
      (ImageIndex < Images.Count))) then
    begin
      Inc(ItemWidth, Max(Images.Width + AddWidth, MinOffset));
      if not IsPopup then Inc(ItemWidth, GetMarginOffset);
      if (ImageIndex >= 0) and (ImageIndex < Images.Count) then
        ItemHeight := Max(ItemHeight, Images.Height + AddHeight);
    end else
{$ENDIF}
    if Assigned(Glyph) and not Glyph.Empty then begin
      W := Glyph.Width;
      if (Glyph is TBitmap) and (NumGlyphs in [2..5]) then
        W := W div NumGlyphs;
      H := Glyph.Height;
{$IFDEF WIN32}
      if Glyph is TIcon then begin
        Ico := CreateRealSizeIcon(TIcon(Glyph));
        try
          GetIconSize(Ico, W, H);
        finally
          DestroyIcon(Ico);
        end;
      end;
{$ENDIF}
      W := Max(W + AddWidth, MinOffset);
      Inc(ItemWidth, W);
      if not IsPopup then Inc(ItemWidth, GetMarginOffset);
      ItemHeight := Max(ItemHeight, H + AddHeight);
    end
    else if MinOffset > 0 then begin
      Inc(ItemWidth, MinOffset);
      if not IsPopup then Inc(ItemWidth, GetMarginOffset);
    end;
  end;
end;

{ TRxMainMenu }

constructor TRxMainMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  FShowCheckMarks := True;
  FHook := TRxWindowHook.Create(Self);
  FHook.AfterMessage := WndMessage;
{$IFDEF WIN32}
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
{$ENDIF}
end;

destructor TRxMainMenu.Destroy;
begin
{$IFDEF WIN32}
  FImageChangeLink.Free;
{$ENDIF}
  SetStyle(msStandard);
  FHook.Free;
  FCanvas.Free;
  inherited Destroy;
end;

procedure TRxMainMenu.Loaded;
begin
  inherited Loaded;
  if IsOwnerDrawMenu then RefreshMenu(True);
end;

function TRxMainMenu.IsOwnerDrawMenu: Boolean;
begin
  Result := (FStyle <> msStandard)
    {$IFDEF WIN32} or (Assigned(FImages) and (FImages.Count > 0)) {$ENDIF};
end;

{$IFDEF WIN32}
procedure TRxMainMenu.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then begin
    if AComponent = FImages then SetImages(nil);
  end;
end;

procedure TRxMainMenu.ImageListChange(Sender: TObject);
begin
  if Sender = FImages then RefreshMenu(IsOwnerDrawMenu);
end;

procedure TRxMainMenu.SetImages(Value: TImageList);
var
  OldOwnerDraw: Boolean;
begin
  OldOwnerDraw := IsOwnerDrawMenu;
  if FImages <> nil then FImages.UnregisterChanges(FImageChangeLink);
  FImages := Value;
  if Value <> nil then begin
    FImages.RegisterChanges(FImageChangeLink);
    FImages.FreeNotification(Self);
  end;
  if IsOwnerDrawMenu then FHook.WinControl := FindForm
  else FHook.WinControl := nil;
  if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw);
end;
{$ENDIF}

procedure TRxMainMenu.SetStyle(Value: TRxMenuStyle);
begin
  if FStyle <> Value then begin
    FStyle := Value;
    if IsOwnerDrawMenu then FHook.WinControl := FindForm
    else FHook.WinControl := nil;
    RefreshMenu(IsOwnerDrawMenu);
  end;
end;

function TRxMainMenu.FindForm: TWinControl;
begin
  Result := FindControl(WindowHandle);
  if (Result = nil) and (Owner is TWinControl) then
    Result := TWinControl(Owner);
end;

procedure TRxMainMenu.Refresh;
begin
  RefreshMenu(IsOwnerDrawMenu);
end;

procedure TRxMainMenu.RefreshMenu(AOwnerDraw: Boolean);
{$IFDEF RX_D4}
begin
  Self.OwnerDraw := AOwnerDraw and (FHook.WinControl <> nil) and
    not (csDesigning in ComponentState);
{$ELSE}
var
  I: Integer;
begin
  if AOwnerDraw and (FHook.WinControl = nil) then Exit;
  if not (csDesigning in ComponentState) then
    for I := 0 to Items.Count - 1 do
      RefreshMenuItem(Items[I], AOwnerDraw);
{$ENDIF}
end;

procedure TRxMainMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  State: TMenuOwnerDrawState);
var
  Graphic: TGraphic;
  BackColor: TColor;
  NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
begin
  if Canvas.Handle <> 0 then begin
    Graphic := nil;
    BackColor := Canvas.Brush.Color;
    NumGlyphs := 1;
    GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
{$IFDEF WIN32}
{$IFDEF RX_D4}
    ImageIndex := Item.ImageIndex;
{$ELSE}
    ImageIndex := -1;
{$ENDIF}
    GetImageIndex(Item, State, ImageIndex);
{$ENDIF}
    DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
      BtnStyle(Style), Rect, FMinTextOffset, State
      {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  end;
end;

procedure TRxMainMenu.DrawItem(Item: TMenuItem; Rect: TRect;
  State: TMenuOwnerDrawState);
var
  Graphic: TGraphic;
  BackColor: TColor;
  NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
begin
  if Canvas.Handle <> 0 then begin
    Graphic := nil;
    BackColor := Canvas.Brush.Color;
    NumGlyphs := 1;
    GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
    if BackColor <> clNone then begin
      Canvas.Brush.Color := BackColor;
      Canvas.FillRect(Rect);
    end;
    if Assigned(FOnDrawItem) then FOnDrawItem(Self, Item, Rect, State)
    else begin
{$IFDEF WIN32}
{$IFDEF RX_D4}
      ImageIndex := Item.ImageIndex;
{$ELSE}
      ImageIndex := -1;
{$ENDIF}
      GetImageIndex(Item, State, ImageIndex);
{$ENDIF}
      DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
        BtnStyle(Style), Rect, FMinTextOffset, State
        {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
    end;
  end;
end;

procedure TRxMainMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer);
begin
  if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Item, Width, Height)
end;

procedure TRxMainMenu.WndMessage(Sender: TObject; var AMsg: TMessage;
  var Handled: Boolean);
begin
  if IsOwnerDrawMenu then MenuWndMessage(Self, AMsg, Handled);
end;

procedure TRxMainMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer);
begin
  if Assigned(FOnGetItemParams) then
    FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs);
  if (Item <> nil) and (Item.Caption = Separator) then Graphic := nil;
end;

{$IFDEF WIN32}
procedure TRxMainMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  var ImageIndex: Integer);
begin
  if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and
    Assigned(FOnGetImageIndex) then
    FOnGetImageIndex(Self, Item, State, ImageIndex);
end;
{$ENDIF}

procedure TRxMainMenu.CMMenuChanged(var Message: TMessage);
begin
{$IFNDEF RX_D4}
  if IsOwnerDrawMenu then RefreshMenu(True);
{$ENDIF}
end;

procedure TRxMainMenu.WMDrawItem(var Message: TWMDrawItem);
var
  State: TMenuOwnerDrawState;
  SaveIndex: Integer;
  Item: TMenuItem;
begin
  with Message.DrawItemStruct^ do begin
{$IFDEF WIN32}
    State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
{$ELSE}
    State := TMenuOwnerDrawState(WordRec(itemState).Lo);
{$ENDIF}
    {if (mdDisabled in State) then State := State - [mdSelected];}
    Item := TMenuItem(Pointer(itemData));
    if Assigned(Item) and
      (FindItem(Item.Command, fkCommand) = Item) then
    begin
      SaveIndex := SaveDC(hDC);
      try
        FCanvas.Handle := hDC;
        SetDefaultMenuFont(FCanvas.Font);
        FCanvas.Font.Color := clMenuText;
        FCanvas.Brush.Color := clMenu;
{$IFDEF WIN32}
        if mdDefault in State then
          FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
{$ENDIF}
        if (mdSelected in State) {$IFDEF WIN32} and not
          (Style in [msBtnLowered, msBtnRaised]) {$ENDIF} then
        begin
          FCanvas.Brush.Color := clHighlight;
          FCanvas.Font.Color := clHighlightText;
        end;
        with rcItem do
          IntersectClipRect(FCanvas.Handle, Left, Top, Right, Bottom);
        DrawItem(Item, rcItem, State);
        FCanvas.Handle := 0;
      finally
        RestoreDC(hDC, SaveIndex);
      end;
    end;
  end;
end;

procedure TRxMainMenu.WMMeasureItem(var Message: TWMMeasureItem);
var
  Item: TMenuItem;
  Graphic: TGraphic;
  BackColor: TColor;
  DC: HDC;
  NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
begin
  with Message.MeasureItemStruct^ do begin
    Item := TMenuItem(Pointer(itemData));
    if Assigned(Item) and (FindItem(Item.Command, fkCommand) = Item) then
    begin
      DC := GetDC(0);
      try
        FCanvas.Handle := DC;
        SetDefaultMenuFont(FCanvas.Font);
{$IFDEF WIN32}
        if Item.Default then
          FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
{$ENDIF}
        Graphic := nil;
        BackColor := FCanvas.Brush.Color;
        NumGlyphs := 1;
        GetItemParams(Item, [], FCanvas.Font, BackColor, Graphic, NumGlyphs);
{$IFDEF WIN32}
{$IFDEF RX_D4}
        ImageIndex := Item.ImageIndex;
{$ELSE}
        ImageIndex := -1;
{$ENDIF}
        GetImageIndex(Item, [], ImageIndex);
{$ENDIF}
        MenuMeasureItem(Self, Item, FCanvas, FShowCheckMarks, Graphic,
          NumGlyphs, Integer(itemWidth), Integer(itemHeight), FMinTextOffset
          {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
        MeasureItem(Item, Integer(itemWidth), Integer(itemHeight));
      finally
        FCanvas.Handle := 0;
        ReleaseDC(0, DC);
      end;
    end;
  end;
end;

procedure TRxMainMenu.WMMenuSelect(var Message: TWMMenuSelect);
var
  MenuItem: TMenuItem;
  FindKind: TFindItemKind;
  MenuID: Integer;
begin
  if FCursor <> crDefault then
    with Message do begin
      FindKind := fkCommand;
      if MenuFlag and MF_POPUP <> 0 then begin
        FindKind := fkHandle;
        MenuId := GetSubMenu(Menu, IDItem);
      end
      else MenuId := IDItem;
      MenuItem := FindItem(MenuId, FindKind);
      if (MenuItem <> nil) and (IsItemPopup(MenuItem) or (MenuItem.Count = 0))
        and (MenuFlag and MF_HILITE <> 0) then
        SetCursor(Screen.Cursors[FCursor])
      else SetCursor(Screen.Cursors[crDefault]);
    end;
end;

{ TPopupList }

type
  TPopupList = class(TList)
  private
{$IFNDEF WIN32}
    FMenuHelp: THelpContext;
{$ENDIF}
    procedure WndProc(var Message: TMessage);
  public
    Window: HWND;
    procedure Add(Popup: TPopupMenu);
    procedure Remove(Popup: TPopupMenu);
  end;

const
  PopupList: TPopupList = nil;

procedure TPopupList.WndProc(var Message: TMessage);
var
  I: Integer;
  MenuItem: TMenuItem;
  FindKind: TFindItemKind;
  ContextID: Integer;
  Handled: Boolean;
begin
  try
    case Message.Msg of
      WM_MEASUREITEM, WM_DRAWITEM:
        for I := 0 to Count - 1 do begin
          Handled := False;
          TRxPopupMenu(Items[I]).WndMessage(nil, Message, Handled);
          if Handled then Exit;
        end;
      WM_COMMAND:
        for I := 0 to Count - 1 do
          if TRxPopupMenu(Items[I]).DispatchCommand(Message.wParam) then Exit;
      WM_INITMENUPOPUP:
        for I := 0 to Count - 1 do
          with TWMInitMenuPopup(Message) do
            if TRxPopupMenu(Items[I]).DispatchPopup(MenuPopup) then Exit;
      WM_MENUSELECT:
        with TWMMenuSelect(Message) do begin
          FindKind := fkCommand;
          if MenuFlag and MF_POPUP <> 0 then begin
            FindKind := fkHandle;
            ContextId := GetSubMenu(Menu, IDItem);
          end
          else ContextId := IDItem;
          for I := 0 to Count - 1 do begin
            MenuItem := TRxPopupMenu(Items[I]).FindItem(ContextId, FindKind);
            if MenuItem <> nil then begin
{$IFNDEF WIN32}
              FMenuHelp := MenuItem.HelpContext;
{$ENDIF}
              Application.Hint := MenuItem.Hint;
              with TRxPopupMenu(Items[I]) do
                if FCursor <> crDefault then begin
                  if (MenuFlag and MF_HILITE <> 0) then
                    SetCursor(Screen.Cursors[FCursor])
                  else SetCursor(Screen.Cursors[crDefault]);
                end;
              Exit;
            end;
          end;
{$IFNDEF WIN32}
          FMenuHelp := 0;
{$ENDIF}
          Application.Hint := '';
        end;
      WM_MENUCHAR:
        for I := 0 to Count - 1 do
          with TRxPopupMenu(Items[I]) do
            if (Handle = HMenu(Message.LParam)) or
              (FindItem(Message.LParam, fkHandle) <> nil) then
            begin
{$IFDEF RX_D4}
              ProcessMenuChar(TWMMenuChar(Message));
{$ELSE}
              ProcessMenuChar(TRxPopupMenu(Items[I]), TWMMenuChar(Message));