请问，如果用TBUTTON，TPOPUPMENU作出类似于“下拉按钮”？？？

Question

就像是在IDE环境里的RUN按钮，要在普通的按钮上实现啊

Answer 1

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  Pos: Tpoint;
begin
  Pos.X  := SpeedButton1.BoundsRect.left;
  pos.Y  := SpeedButton1.BoundsRect.Bottom;
  Pos := ClientToScreen(Pos);
  popupMenu1.Popup(Pos.X,Pos.y);
end;

Answer 2

to  lianshaohua这可以实现点击按钮弹出菜单的功能，可是菜单栏上的那个RUN按钮并不是这样的效果的啊。难道我要用两个BUTTON拼在一起吗？可是怎么让它们看起来好像是同时给按下去的呢？谢谢。

Answer 3

放一个toolbar，右键加一个toolbutton，设置toolbutton的style为tbsDropDown,关联一个popupmenu就和run一样了

Answer 4

to jinjazz(近身剪（N-P攻略）) 
   用工具栏的可以,可是要把这个按钮放在窗体的任何一个地方呢?那该怎么实现?我想用TBUTTON或类似的按钮能不能实现这个功能的.谢谢

Answer 5

toolbar可以放在panel里，panel可以随便放什么地方

Answer 6

toolbutton有此功能
也可以用下列代码实现
在button的onclick事件中
var
  P:TPoint ;
begin
  GetCursorPos(P) ;
  PopupMenu1.Popup(p.x,p.Y) ;
end

Answer 7

TSpeedButtonDropDownMenu = class(TComponent)
  private
    FSpeedButton: TSpeedButton;
    FOldWindowProc: TWndMethod;
    FPopupMenu: TPopupMenu;
    FDropped: Boolean;
    FOnDropDownClosed: TNotifyEvent;
    procedure SetPopupMenu(const Value: TPopupMenu);
  protected
    procedure wndproc(var Message: TMessage);
    procedure DropDownButtonPaint(DC: HDC);
    procedure DrawDownArrow(R: TRect);
    function GetMenuHeigth: integer;
    function CalculateMenuHeight: integer;
    function CalculatePopupPoint: TPoint;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetFromSpeedButton(SpeedButton: TSpeedButton): TSpeedButtonDropDownMenu;
    class function GetNameFromSpeedButton(SpeedButton: TSpeedButton): string;
    property DropDownMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnDropDownClosed: TNotifyEvent read FOnDropDownClosed write FOnDropDownClosed;
  end;

Answer 8

{ TSpeedButtonDropDownMenu }function TSpeedButtonDropDownMenu.CalculateMenuHeight: integer;
var
  i: integer;
  MenuItemHeight: integer;
begin
  Result := 0;
  DrawMenuBar(FPopupMenu.WindowHandle);
  for i := 0 to FPopupMenu.Items.Count - 1 do
  begin
    if FPopupMenu.Items[i].Visible then
    begin
      MenuItemHeight := GetMenuHeigth;
      Inc(Result, (MenuItemHeight));
    end;
  end;
  Inc(Result, 4);
end;function TSpeedButtonDropDownMenu.CalculatePopupPoint: TPoint;
var
  MenuHeight: integer;
begin
  Result := FSpeedButton.ClientToScreen(Point(0, FSpeedButton.ClientHeight));
  if FPopupMenu.IsRightToLeft then Inc(Result.X, FSpeedButton.Width);
  MenuHeight := CalculateMenuHeight;
  if Result.y + MenuHeight > Screen.Height then
    Dec(Result.Y, FSpeedButton.Height + MenuHeight);
end;constructor TSpeedButtonDropDownMenu.Create(AOwner: TComponent);
begin
  inherited;
  FSpeedButton := AOwner as TSpeedButton;
  FOldWindowProc := FSpeedButton.WindowProc;
  FSpeedButton.WindowProc := wndproc;
  Name := GetNameFromSpeedButton(FSpeedButton);
end;destructor TSpeedButtonDropDownMenu.Destroy;
begin
  FSpeedButton.WindowProc := FOldWindowProc;
  inherited;
end;const
  DropDownWidth = 14;type
  TSpeedButtonX = class(TSpeedButton);procedure TSpeedButtonDropDownMenu.DrawDownArrow(R: TRect);
var
  TopLeft: TPoint;
begin
  TopLeft.x := (R.Left + R.Right - 5) div 2;
  TopLeft.y := (R.Bottom + R.Top - 3) div 2 + 1;
  with TSpeedButtonX(FSpeedButton) do
  begin
    if not enabled then
    begin
      Canvas.pen.Color := clBtnShadow;
      Canvas.MoveTo(TopLeft.x - 1, TopLeft.y);
      Canvas.LineTo(TopLeft.x + 4, TopLeft.y);
      Canvas.MoveTo(TopLeft.x , TopLeft.y + 1);
      Canvas.LineTo(TopLeft.x + 3, TopLeft.y + 1);
      Canvas.MoveTo(TopLeft.x + 1, TopLeft.y + 2);
      Canvas.LineTo(TopLeft.x + 2, TopLeft.y + 2);
      Canvas.pen.Color := clWindow;
      Canvas.MoveTo(TopLeft.x + 3, TopLeft.y + 1);
      Canvas.LineTo(TopLeft.x + 6, TopLeft.y + 1);
      Canvas.MoveTo(TopLeft.x + 4, TopLeft.y + 2);
      Canvas.LineTo(TopLeft.x + 5, TopLeft.y + 2);
      Canvas.MoveTo(TopLeft.x + 2, TopLeft.y + 3);
      Canvas.LineTo(TopLeft.x + 4, TopLeft.y + 3);
    end
    else
    begin
      Canvas.pen.Color := clHighlight;
      Canvas.MoveTo(TopLeft.x, TopLeft.y);
      Canvas.LineTo(TopLeft.x + 5, TopLeft.y);
      Canvas.MoveTo(TopLeft.x + 1, TopLeft.y + 1);
      Canvas.LineTo(TopLeft.x + 4, TopLeft.y + 1);
      Canvas.MoveTo(TopLeft.x + 2, TopLeft.y + 2);
      Canvas.LineTo(TopLeft.x + 3, TopLeft.y + 2);
    end;
  end;
end;

Answer 9

procedure TSpeedButtonDropDownMenu.DropDownButtonPaint(DC: HDC);
const
  DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
  XorColor = $00FFD8CE;
var
  R, PaintRect: TRect;
  DrawFlags: Integer;
begin
  with TSpeedButtonX(FSpeedButton) do
  begin
    Canvas.Lock;
    try
      Canvas.Handle := DC;
      try
        R := Rect(Left, Top, Left + Width, Top + Height);
        UpdateBoundsRect(Rect(Left, Top, Left +  Width - DropDownWidth, Top + Height));
        try
          Paint;
        finally
          UpdateBoundsRect(R);
        end;
        PaintRect := Rect(Width - DropDownWidth, 0, Width, Height);        if not Flat then
        begin
          DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
          if (FState in [bsDown, bsExclusive]) or (Tag <> 0) then
            DrawFlags := DrawFlags or DFCS_PUSHED;
          DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
        end
        else
        begin
          if (FState in [bsDown, bsExclusive]) or (Tag <> 0) or
            (MouseInControl and (FState <> bsDisabled)) then
            DrawEdge(Canvas.Handle, PaintRect, DownStyles[(FState in [bsDown, bsExclusive]) or (Tag <> 0)],
              FillStyles[Transparent] or BF_RECT)
          else
          if not Transparent then
          begin
            Canvas.Brush.Color := Color;
            Canvas.FillRect(PaintRect);
          end;
          InflateRect(PaintRect, -1, -1);
        end;        if FState in [bsDown, bsExclusive] then
        begin
          if (FState = bsExclusive) and (not Flat or not MouseInControl) then
          begin
            Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
            Canvas.FillRect(PaintRect);
          end;
        end;
        DrawDownArrow(PaintRect);
      finally
        Canvas.Handle := 0;
      end;
    finally
      Canvas.Unlock;
    end;
  end;
end;class function TSpeedButtonDropDownMenu.GetFromSpeedButton(
  SpeedButton: TSpeedButton): TSpeedButtonDropDownMenu;
begin
  Result := SpeedButton.FindComponent(GetNameFromSpeedButton(SpeedButton)) as TSpeedButtonDropDownMenu;
end;function TSpeedButtonDropDownMenu.GetMenuHeigth: integer;
var
  NonClientMetrics: TNonClientMetrics;
begin
  Result := 16;
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    Result  := NonClientMetrics.iMenuHeight;
end;class function TSpeedButtonDropDownMenu.GetNameFromSpeedButton(
  SpeedButton: TSpeedButton): string;
begin
  Result := '__' + SpeedButton.Name + '_DropDownMenu';
end;procedure TSpeedButtonDropDownMenu.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FPopupMenu) then
    FPopupMenu := nil;
end;