actnmenus.pas

天涯進銷存系統

    RootMenu.MouseControl := nil;
  end;
  if Assigned(ParentMenu) then
    ParentMenu.FAnimatePopups := False;
  InMenuLoop := False;
  if Assigned(RootMenu) and Assigned(RootMenu.PopupStack) then
  begin
    if RootMenu.PopupStack.Peek = RootMenu then
    begin
      InMenuLoop := False;
      if Assigned(Selected) then
        Selected.Control.Selected := False;
    end
    else
      RootMenu.PopupStack.Pop;
  end;
end;

procedure TCustomActionMenuBar.CMItemClicked(var Message: TCMItemMsg);
begin
  if FInMenuLoop then exit;
  PostMessage(Handle, Message.Msg, 0, LongInt(Message.Sender));
  TrackMenu;
end;

procedure TCustomActionMenuBar.CMEnterMenuLoop(var Message: TMessage);
begin
  TrackMenu;
end;

procedure TCustomActionMenuBar.CMItemKeyed(var Message: TCMItemMsg);
begin
  if FInMenuLoop then exit;
  PostMessage(Handle, Message.Msg, 0, LongInt(Message.Sender));
  TrackMenu;
end;

function TCustomActionMenuBar.CreateControl(
  AnItem: TActionClientItem): TCustomActionControl;
const
  Alignment: array [TBarOrientation] of TAlign = (alNone, alNone, alTop,
    alTop);
begin
  Result := inherited CreateControl(AnItem);
  Result.ShowHint := False;
  AnItem.ShowCaption := True;
  if not Result.Separator then
    Result.Enabled := Result.Enabled and (Assigned(AnItem.Action) or
      (AnItem.HasItems and (AnItem.Items.VisibleCount > 0)));
end;

function TCustomActionMenuBar.CreatePopup(AOwner: TCustomActionMenuBar;
  Item: TCustomActionControl): TCustomActionPopupMenu;
var
  OldVisible: Boolean;
begin
  Result := nil;
  if not InMenuLoop or (AOwner = nil) or (Item = nil) or (FPopupStack.Count = 0) or
     (FPopupStack.Peek.ParentControl = Item) or (Item.ActionClient = nil) or
     (Item.ActionClient.Items.VisibleCount = 0) then
    exit;
  DoPopup(Item);
  FDelayItem := nil;
  Result := NewPopup;
  with Result do
  begin
    DisableAlign;
    try
      ColorMap := Self.ColorMap;
      Color := Self.Color;
      RootMenu := Self.RootMenu;
      Designable := Self.Designable;
      Item.ActionClient.ChildActionBar := Result;
      Font.Assign(Self.Font);
      ParentMenu := AOwner;
      FInMenuLoop := True;
      ParentControl := Item;
      OldVisible := Item.ActionClient.Visible;
      ActionClient := Item.ActionClient;
      Item.ActionClient.Visible := OldVisible;
      Expanded := Self.Expanded or Self.DesignMode or (FindFirstVisibleItem = nil)
        or not Item.ActionClient.Items.HideUnused;
      if Expanded then
        Expand(False);
      ParentWindow := Application.Handle;
      DesignMode := AOwner.DesignMode;
    finally
      EnableAlign;
    end;
    Show;
  end;
  if Item is TCustomMenuButton then Item.Invalidate;
  FExpandTimer.Enabled := Result.Expandable and not Result.Expanded;
end;

procedure TCustomActionMenuBar.DoItemSelected(AnItem: TCustomActionControl);
begin
  if (AnItem is TCustomMenuItem) then
    RootMenu.FDelayItem := AnItem
  else
    FDelayItem := nil;
  RootMenu.FPopupTimer.Enabled := True;
  // Reset the expand timer every time new item is selected
  if not RootMenu.FPopupStack.Peek.Expandable {or (AnItem.Owner = Self)} then
    exit;
  RootMenu.FExpandTimer.Enabled := False;
  // Tag = 1 indicates that when the timer fires that it should only
  // highlight the expand button rather than expand the popup menu
  if Selected <> FindFirstVisibleItem then
    RootMenu.FExpandTimer.Tag := 1;
  RootMenu.FExpandTimer.Enabled := not DesignMode;
end;

procedure TCustomActionMenuBar.ExecAction(Action: TContainedAction);
begin
  if (Action = nil) or (csDesigning in ComponentState) then exit;
  if not DesignMode then
  begin
    sndPlaySound(nil, SND_NODEFAULT);
    sndPlaySound('MenuCommand', SND_NOSTOP or SND_ASYNC or SND_NODEFAULT);
    FSelectedItem.ActionLink.Execute;
  end;
end;

function TCustomActionMenuBar.DoGetPopupClass: TCustomPopupClass;
begin
  Result := GetPopupClass;
  if Assigned(FOnGetPopupClass) then
    FOnGetPopupClass(Self, Result)
end;

type
  TActionControlClass = class(TCustomActionControl);

function TCustomActionMenuBar.DoItemClicked(
  AnItem: TCustomActionControl): TActionClientItem;
var
  SelectionFade: BOOL;
  I: Integer;
begin
  Result := nil;
  if (AnItem.Owner = Self) then
  begin
    if AnItem is TCustomMenuButton then
    begin
      ClearSubMenus;
      AnItem.Invalidate;
    end;
    FDelayItem := nil;
  end;
  if AnItem.ActionClient.HasItems then
  begin
    if Assigned(FDelayItem) then
    begin
      while FPopupStack.Peek <> FDelayItem.Parent do
        RootMenu.PopupStack.Pop;
      FDelayItem := nil;
    end;
    if not AnItem.Visible then
      FPopupStack.Peek.Expand(True);
    RootMenu.ProcessMessages;
    if (AnItem is TCustomMenuButton) and (FPopupStack.Count = 2) then
      while FPopupStack.Count > 2 do
        FPopupStack.Peek.CloseMenu;
    CreatePopup(FPopupStack.Peek, AnItem);
    FAnimatePopups := False;
  end
  else
  begin
    Result := AnItem.ActionClient;
    if not DesignMode then
    begin
      SystemParametersInfo(SPI_GETSELECTIONFADE, 0, @SelectionFade, 0);
      if (FPopupStack.Count > 1) and SelectionFade then
        for I := 1 to FPopupStack.Count - 2 do
          FPopupStack.Bars[I].Visible := False;
      ClearSubMenus;
      CloseMenu;
    end;
  end;
end;

function TCustomActionMenuBar.DoItemKeyed(
  AnItem: TCustomActionControl): TActionClientItem;
var
  Item: TActionClientItem;
begin
  FItemKeyed := True;
  try
    Result := DoItemClicked(AnItem);
    if not Assigned(Result) then
    begin
      // if the keyboard was used to display the popup then automatically
      // select the first item if the mouse was used no item is selected
      Item := FPopupStack.Peek.FindFirstVisibleItem;
      if Assigned(Item) and Assigned(Item.Control) then
        Item.Control.Selected := True;
    end;
  finally
    FItemKeyed := False;
  end;
end;

procedure TCustomActionMenuBar.GetDefaultSounds;
begin
  // ActionBand menus now use PlaySound API and Windows sound command aliases
end;

function TCustomActionMenuBar.IsDesignMsg(var Msg: TMsg): Boolean;
begin
  Result := DesignMode and not Mouse.IsDragging;
  if Result then
  begin
    Result := Assigned(FDragItem) or Mouse.IsDragging;
    if Result then  // Allow mouse up to end the drag operation
    begin
      Result := (Msg.message <> WM_LBUTTONUP);
      exit;
    end;
    Result := Assigned(FParentForm) and (GetForeGroundWindow <> FParentForm.Handle);
    if csDesigning in ComponentState then
      Result := Result and (Msg.Message <> CM_ITEMCLICKED)
    else
      Result := Assigned(RootMenu) and not RootMenu.InMenuLoop;
  end;
end;

procedure TCustomActionMenuBar.DoMenuDelay(Sender: TObject);
var
  P: TPoint;
begin
  FPopupTimer.Enabled := False;
  if DelayItem = nil then exit;
  if (FDelayItem.Parent = nil) or
     Assigned(FDelayItem.ActionClient.ChildActionBar) then exit;
  while (RootMenu.PopupStack.Count > 1) and
     (RootMenu.PopupStack.Peek <> FDelayItem.Parent) do
    RootMenu.PopupStack.Pop;
  GetCursorPos(P);
  if PtInRect(FDelayItem.BoundsRect, FPopupStack.Peek.ScreenToClient(P)) then
    CreatePopup(FPopupStack.Peek, FDelayItem);
end;

procedure TCustomActionMenuBar.DoneMenuLoop;
begin
  CloseMenu;
  MouseControl := nil;
  FreeAndNil(FCachedMenu);
  ActiveMenu := nil;
  if Designable and Assigned(ActionBarDesigner) then
    ActionBarDesigner.SetActiveMenu(nil);
  FAnimatePopups := True;
  ShowCaret(0);
  FreeAndNil(FPopupTimer);
  FreeAndNil(FPopupStack);
  FreeAndNil(FExpandTimer);
end;

procedure TCustomActionMenuBar.DoPopup(Item: TCustomActionControl);
begin
  if Assigned(FOnPopup) then
    FOnPopup(Self, Item);
end;

procedure TCustomActionMenuBar.Expand(Full: Boolean);
var
  I: Integer;
begin
  FExpanded := True;
  if Full then
    RootMenu.Expanded := Full;
  FExpandable := False;
  if not HasItems then exit;
  DisableAlign;
  try
    for I := 0 to Items.Count - 1 do
      Items[I].Control.Visible := Items[I].Visible;
    RequestAlign;
  finally
    EnableAlign;
  end;
end;

procedure TCustomActionMenuBar.ExpandTimer(Sender: TObject);
begin
  FExpandTimer.Enabled := False;
  if RootMenu.PopupStack.Peek.Expandable then
    // Tag = 1 indicates that when the timer fires that it should only
    // highlight the expand button rather than expand the popup menu
    if FExpandTimer.Tag = 1 then
      with TCustomActionPopupMenu(FPopupStack.Peek).ExpandBtn do
        Flat := False
    else
    begin
      FExpanded := True;
      FPopupStack.Peek.Expand(True);
    end;
end;

function TCustomActionMenuBar.GetDesignMode: Boolean;
begin
  Result := inherited GetDesignMode;
  if not Result and Assigned(FParentMenu) and (FParentMenu <> Self) then
    Result := FParentMenu.DesignMode;
end;

function TCustomActionMenuBar.GetMouseHoverItem(Msg: TMsg): TCustomActionControl;
var
  I: Integer;
  Control: TControl;
  ARootMenu: TCustomActionMenuBar;
begin
  Result := nil;
  Control := nil;
  ARootMenu := RootMenu;
  if Assigned(ARootMenu) then
  begin
    for I := ARootMenu.PopupStack.Count - 1 downto 0 do
      if WindowFromPoint(Msg.pt) = ARootMenu.PopupStack.Bars[I].Handle then
        with ARootMenu.PopupStack.Bars[I] do
          Control := ControlAtPos(ScreenToClient(Msg.Pt), True);
    if Control is TCustomActionControl then
      Result := TCustomActionControl(Control);
  end;
end;

function TCustomActionMenuBar.GetPopupClass: TCustomPopupClass;
begin
  if Style <> nil then
    Result := TActionBarStyleEx(Style).GetPopupClass(Self)
  else
    Result := TActionBarStyleEx(ActionBarStyles.Style[0]).GetPopupClass(Self);
end;

function TCustomActionMenuBar.GetSelected: TActionClientItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to ItemCount - 1 do
    if Assigned(ActionControls[I]) and ActionControls[I].Selected then
    begin
      Result := ActionControls[I].ActionClient;
      break;
    end;
end;

procedure TCustomActionMenuBar.InitMenuLoop;
var
  DelayTime: DWORD;
  ParentFrm: TCustomForm;
begin
  FMousePos := Mouse.CursorPos;
  // Need to use FSelectedItem because it's possible for the item to be
  // destroyed in designmode before TrackMenu gets an opportunity to execute
  // the associated action
  FSelectedItem := nil;
  FExpanded := False;
  FDelayItem := nil;
  if csDesigning in ComponentState then
    DelayTime := 1
  else
  begin
    SystemParametersInfo(SPI_GETMENUSHOWDELAY, 0, @DelayTime, 0);
    if DelayTime = 0 then
      Inc(Delaytime);
  end;
  if not (csDesigning in ComponentState) then
  begin
    ParentFrm := GetParentForm(Self);
    if Assigned(ParentFrm) then
      ParentFrm.SetFocus;
  end;
  FPopupTimer := TTimer.Create(nil);
  FPopupTimer.OnTimer := DoMenuDelay;
  FPopupTimer.Interval := DelayTime;
  FPopupTimer.Enabled := False;
  FPopupStack := TMenuStack.Create(Self);
  FPopupStack.Push(Self);
  FExpandTimer := TTimer.Create(nil);
  with FExpandTimer do
  begin
    Enabled := False;
    Interval := FExpandDelay;
    OnTimer := ExpandTimer;
  end;
  FInMenuLoop := True;
  HideCaret(0);
  ActiveMenu := Self;
  if Designable and Assigned(ActionBarDesigner) then
    ActionBarDesigner.SetActiveMenu(ActiveMenu);
end;

function TCustomActionMenuBar.NewPopup: TCustomActionPopupMenu;
begin
  Result := nil;
  if Assigned(RootMenu.PopupStack.Peek.FCachedMenu) then
  begin
    Result := RootMenu.PopupStack.Peek.FCachedMenu;
    FreeAndNil(Result.FExpandBtn);
    Result.FExpandable := False;
    Result.FExpanded := False;
    Result.SetBounds(0,0, 150, 50);
  end;
  if Result = nil then
    Result := DoGetPopupClass.Create(Self);
  FPopupStack.Push(Result);