actnmenus.pas

天涯進銷存系統

end;

procedure TCustomActionMenuBar.ProcessMouseMsg(var Msg: TMsg);
var
  Item: TCustomActionControl;
  Control: TControl;
  Form: TCustomForm;
begin
  Item := GetMouseHoverItem(Msg);
  if not Assigned(Item) then
    case Msg.message of
      WM_MOUSEMOVE:
        if Mouse.IsDragging and
           (WindowFromPoint(Msg.pt) <> RootMenu.PopupStack.Peek.Handle) then
        begin
          Form := GetParentForm(Self);
          if Assigned(Form) then
          begin
            Control := Form.ControlAtPos(ScreenToClient(Msg.pt), False, True);
            if Assigned(Control) and ((Control is TCustomActionBar) or
               (Control is TCustomActionControl)) then
              RootMenu.CloseMenu;
          end;
        end;
      WM_MBUTTONDOWN,
      WM_RBUTTONDOWN,
      WM_RBUTTONDBLCLK,
      WM_LBUTTONDOWN,
      WM_LBUTTONDBLCLK:
        if (csDesigning in ComponentState) or (RootMenu is TCustomActionPopupMenu) then
          RootMenu.CloseMenu;
    end;
  DispatchMessage(Msg);
end;

function TCustomActionMenuBar.ProcessMenuLoop: TActionClientItem;
var
  Msg: TMsg;
  ContextID: Integer;
begin
  Result := nil;
  if FInMenuLoop then exit;
  InitMenuLoop;
  try
    repeat
      if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
      begin
        // Prevent multiple right click menus from appearing in form designer
        if (Msg.message = WM_CONTEXTMENU) and (RootMenu is TCustomActionPopupMenu) then
          Continue;
        // Allow keystroke messages to be propagated to the IDE at designtime
        if (csDesigning in ComponentState) and
           TApplicationClass(Application).IsKeyMsg(Msg) then
          Continue;
        if IsDesignMsg(Msg) then
        begin
          TranslateMessage(Msg);
          DispatchMessage(Msg);
          Continue;
        end;
        case Msg.message of
          WM_NCMBUTTONDOWN,
          WM_NCRBUTTONDOWN,
          WM_NCLBUTTONDOWN,
          CM_RELEASE,
          WM_CLOSE:
            begin
              CloseMenu;
              RootMenu.ProcessMessages;
              DispatchMessage(Msg);
            end;
          WM_KEYFIRST..WM_KEYLAST:
            begin
              if Msg.wParam = VK_F1 then
              begin
                if FPopupStack.Peek.Selected <> nil then
                begin
                  ContextID := FPopupStack.Peek.Selected.HelpContext;
                  if Screen.ActiveForm = nil then Exit;
                  if (ContextID = 0) then
                    ContextID := Screen.ActiveForm.HelpContext;
                  if (biHelp in Screen.ActiveForm.BorderIcons) then
                    Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID)
                  else
                    Application.HelpContext(ContextID);
                  Exit;
                end;
              end;
              if not PersistentHotKeys then
                PersistentHotkeys := True;
              if (Msg.message = WM_SYSKEYDOWN) and (Msg.wParam = VK_MENU) then
              begin
                CloseMenu;
                FCancelMenu := True;
                TranslateMessage(Msg);
                DispatchMessage(Msg);
              end
              else
                FPopupStack.Peek.Dispatch(TMessage((@Msg.message)^));
            end;
          WM_MOUSEFIRST..WM_MOUSELAST: ProcessMouseMsg(Msg);
          CM_ITEMSELECTED: DoItemSelected(TCustomActionControl(Msg.lParam));
          CM_ITEMKEYED  : FSelectedItem := DoItemKeyed(TCustomActionControl(Msg.lParam));
          CM_ITEMCLICKED: FSelectedItem := DoItemClicked(TCustomActionControl(Msg.lParam));
        else
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
        CleanupStack;
      end
      else
        Idle(Msg);
    until not FInMenuLoop;
  finally
    DoneMenuLoop;
  end;
end;

procedure TCustomActionMenuBar.Select(const Forward: Boolean);

  function SkipItems(const Forward: Boolean;
    var NextItem: TActionClientItem): Boolean;
  var
    Loop: Boolean;
  begin
    Loop := True;
    NextItem := Selected;
    while Loop do
    begin
      if Forward then
        NextItem := FindNext(NextItem)
      else
        NextItem := FindPrevious(NextItem);
      if Assigned(NextItem) and Assigned(NextItem.Control) then
        if csDesigning in ComponentState then
          break
        else
          if DesignMode then
          begin
            if NextItem.Control.Enabled then
              break;
          end
          else
            if not NextItem.Separator and NextItem.Control.Visible then
              break;
      Loop :=  Assigned(NextItem);
    end;
    Result := Assigned(NextItem);
  end;

  procedure CheckChangesAllowed(AnItem: TActionClientItem);
  begin
    if not (caMove in AnItem.ChangesAllowed) then
      raise Exception.CreateFmt(SMoveNotAllowed, [AnItem.Caption]);
  end;

var
  NextItem: TActionClientItem;
begin
  if not SkipItems(Forward, NextItem) then exit;
  if (RootMenu.PopupStack.Peek = Self) then
    if DesignMode and (KeyboardStateToShiftState = [ssCtrl]) and
       Assigned(NextItem) and Assigned(Selected) then
    begin
      CheckChangesAllowed(Selected);
      CheckChangesAllowed(NextItem);
      Selected.Index := NextItem.Index
    end
    else
      SelectItem(NextItem.Control)
  else
    if (NextItem.Control.Parent = Self) and Assigned(NextItem.Action) then
    begin
      RootMenu.PopupStack.Peek.FInMenuLoop := False;
      RootMenu.FDelayItem := nil;
      NextItem.Control.Selected := True;
    end
    else
      NextItem.Control.Keyed;
end;

procedure TCustomActionMenuBar.SelectItem(AnItem: TCustomActionControl);
begin
  if (AnItem = nil) then exit;
  AnItem.Selected := True;
end;

procedure TCustomActionMenuBar.SetDesignMode(const Value: Boolean);
begin
  if DesignMode <> Value then
    CloseMenu;
  inherited SetDesignMode(Value);
end;

procedure TCustomActionMenuBar.SetParentMenu(
  const Value: TCustomActionMenuBar);
begin
  if FParentMenu <> Value then
  begin
    FParentMenu := Value;
    if Assigned(FParentMenu) then
    begin
      FParentMenu.FChildMenu := Self;
      PersistentHotkeys := FParentMenu.PersistentHotkeys;
      if Assigned(FParentMenu.OnGetControlClass) then
        OnGetControlClass := FParentMenu.OnGetControlClass;
      FAnimationStyle := FParentMenu.AnimationStyle;
    end;
  end;
end;

procedure TCustomActionMenuBar.SetPersistentHotkeys(const Value: Boolean);
var
  I: Integer;
  UpdatePopups: Boolean;
begin
  UpdatePopups := (Value <> PersistentHotkeys) and Value;
  inherited SetPersistentHotkeys(Value);
  if UpdatePopups and Assigned(FPopupStack) then
    for I := 0 to FPopupStack.Count - 1 do
      TCustomActionMenuBar(FPopupStack.List[I]).PersistentHotkeys := True;
end;

procedure TCustomActionMenuBar.SetParent(AParent: TWinControl);
begin
  inherited;
  FParentForm := GetParentForm(Self);
end;

type
  TActionClientItemClass = class(TActionClientItem);

procedure TCustomActionMenuBar.TrackMenu;
var
  Cancelled: Boolean;
begin
  if InMenuLoop then Exit;
  FRootMenu := Self;
  Cancelled := True;
  if Assigned(FOnEnterMenuLoop) then
    FOnEnterMenuLoop(Self);
  try
    ProcessMenuLoop;  // Sets FSelectedItem
    Cancelled := (FSelectedItem = nil) or
      (Assigned(FSelectedItem) and
       not TCustomAction(FSelectedItem.Action).Enabled);
    if not DesignMode and Assigned(FSelectedItem) then
    begin
      TActionClientItemClass(FSelectedItem).ResetUsageData;
      Update;
      ExecAction(FSelectedItem.Action);
    end;
  finally
    // Selecting a disabled item is equalivalent to cancelling the menu
    if Assigned(FOnExitMenuLoop) then
      FOnExitMenuLoop(Self, Cancelled);
  end;
end;

procedure TCustomActionMenuBar.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_NCHITTEST: Message.Result := HTCLIENT;
  end;
  inherited WndProc(Message);
end;

procedure TCustomActionMenuBar.WMKeyDown(var Message: TWMKeyDown);
var
  Item: TActionClientItem;
  SelIndex: Integer;
begin
  inherited;
  if not FInMenuLoop then exit;
  if (RootMenu <> nil) and (Chr(Message.CharCode) in ['0'..'9', 'A'..'Z']) then
  begin
    if not (ssCtrl in KeyboardStateToShiftState) then
    begin
      Item := RootMenu.PopupStack.Peek.FindAccelItem(Message.CharCode);
      if Assigned(Item) then
        Item.Control.Keyed;
    end;
  end;
  case Message.CharCode of
    VK_UP  : Select(False);
    VK_DOWN: Select(True);
    VK_HOME: SelectItem(FindFirstVisibleItem.Control);
    VK_END : SelectItem(FindLastVisibleItem.Control);
    VK_RETURN:
      if Assigned(Selected) then
        Selected.Control.Keyed;
    VK_ESCAPE:
      if DesignMode and Assigned(FDragItem) then
        DragDone(False)
      else
        if Mouse.IsDragging then
          CancelDrag
        else
          CloseMenu;
    VK_DELETE:
      begin
        if not DesignMode or (Selected = nil) then exit;
        Item := Selected;
        if not (caDelete in Item.ChangesAllowed) then
          raise Exception.Create(SDeleteNotAllowed);
        if Item.HasItems and
           (MessageDlg(Format(SDeleteItemWithSubItems,
            [Item.Caption]), mtConfirmation, mbOKCancel, 0) <> mrOk) then
          exit;
        SelIndex := Item.Index;
        if SelIndex = ItemCount - 1 then
          Item := FindPrevious(Item, False)
        else
          Item := FindNext(Item, False);
        ActionClient.Items.Delete(SelIndex);
        if Assigned(Item) then
          Item.Control.Selected := True
        else
          PostMessage(RootMenu.Handle, CM_ITEMSELECTED, 0,
            LongInt(ParentControl));
        NotifyDesigner(Self);
      end;
  end;
end;

procedure TCustomActionMenuBar.WMMouseActivate(var Message: TWMMouseActivate);
begin
  inherited;
  if FInMenuLoop then
    Message.Result := MA_NOACTIVATE;
end;

procedure TCustomActionMenuBar.WMSysKeyDown(var Message: TWMSysKeyDown);
var
  Item: TActionClientItem;
begin
  inherited;
  if not FInMenuLoop then exit;
  if (RootMenu <> nil) and
     (Chr(Message.CharCode) in ['0'..'9', 'A'..'Z']) then
  begin
    Item := RootMenu.PopupStack.Peek.FindAccelItem(Message.CharCode);
    if Assigned(Item) and Assigned(Item.Control) then
      Item.Control.Keyed;
  end;
  if (Message.CharCode = VK_MENU) then
    RootMenu.CloseMenu;
end;

procedure TCustomActionMenuBar.SetAnimateDuration(const Value: Integer);
begin
  if Value <= 0 then
    FAnimateDuration := 1
  else
    FAnimateDuration := Value;
end;

procedure TCustomActionMenuBar.CMFontchanged(var Message: TMessage);

  function IsScreenFont: Boolean;
  begin
    Result := (Font.Name = Screen.MenuFont.Name) and
              (Font.Style = Screen.MenuFont.Style) and
              (Font.Color = Screen.MenuFont.Color) and
              (Font.Pitch = Screen.MenuFont.Pitch) and
              (Font.PixelsPerInch = Screen.MenuFont.PixelsPerInch) and
              (Font.Height = Screen.MenuFont.Height) and
              (Font.Size = Screen.MenuFont.Size);
  end;

begin
  inherited;
  FUseSystemFont := IsScreenFont;
  AdjustSize;
end;

procedure TCustomActionMenuBar.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) then
    if (AComponent is TCustomActionControl) then
      if TCustomActionControl(AComponent).ActionClient = FSelectedItem then
        FSelectedItem := nil
      else if AComponent = FMouseControl then
        FMouseControl := nil;
end;

function TCustomActionMenuBar.DoMouseIdle: TControl;
var
  CaptureControl: TControl;
  P: TPoint;
begin
  GetCursorPos(P);
  Result := FindDragTarget(P, True);
  CaptureControl := GetCaptureControl;
  if (MouseControl <> Result) and not PointsEqual(FMousePos, Mouse.CursorPos) then
  begin
    FMousePos := Mouse.CursorPos;
    if ((MouseControl <> nil) and (CaptureControl = nil)) or
      ((CaptureControl <> nil) and (MouseControl = CaptureControl)) then
      MouseControl.Perform(CM_MOUSELEAVE, 0, 0);
    MouseControl := Result;
    if ((MouseControl <> nil) and (CaptureControl = nil)) or
      ((CaptureControl <> nil) and (MouseControl = CaptureControl)) then
      MouseControl.Perform(CM_MOUSEENTER, 0, 0);
  end;