不用delphi自带的toolbar,CoolBar1,怎样让speedbutton的右边有一个下拉的三解,可以下拉菜单

解决方案 »

  1.   

    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      ExtCtrls, StdCtrls, Buttons;type
      TForm1 = class(TForm)
        ImageRight: TImage;
        ImageDown: TImage;
        PanelCenter: TPanel;
        ImageCenter: TImage;
        MemoRight: TMemo;
        MemoDown: TMemo;
        SpeedButtonRight: TSpeedButton;
        SpeedButtonDown: TSpeedButton;
        SpeedButtonClose: TSpeedButton;
        procedure SpeedButtonRightClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure SpeedButtonDownClick(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure ImageCenterMouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure SpeedButtonCloseClick(Sender: TObject);
      private
        { Private declarations }
        FRGNRight: HRGN;
        FRGNDown: HRGN;
        FRGNCenter: HRGN;
        FRGNForm: HRGN;
        FShowRight: Boolean;
        FShowDown: Boolean;
        procedure SetShowRight(const Value: Boolean);
        procedure SetShowDown(const Value: Boolean);
        procedure ShowFormRgn;
      public
        { Public declarations }
        property ShowRight: Boolean read FShowRight write SetShowRight;
        property ShowDown: Boolean read FShowDown write SetShowDown;
      end;var
      Form1: TForm1;implementation{$R *.DFM}procedure TForm1.SpeedButtonRightClick(Sender: TObject);
    begin
      ShowRight := not ShowRight;
    end;procedure TForm1.SpeedButtonDownClick(Sender: TObject);
    begin
      ShowDown := not ShowDown;
    end;procedure TForm1.FormCreate(Sender: TObject);
    begin
      with ImageCenter do begin
        Picture.Bitmap.Width := Width;
        Picture.Bitmap.Height := Height;
        Picture.Bitmap.Canvas.Brush.Color := clBlue;
        Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
      end;  ///////Begin 创建不规则的区域
      { TODO : 修改区域 }
      FRGNRight := CreateRectRgn(
        ImageRight.BoundsRect.Left,
        ImageRight.BoundsRect.Top,
        ImageRight.BoundsRect.Right,
        ImageRight.BoundsRect.Bottom);  FRGNDown := CreateRectRgn(
        ImageDown.BoundsRect.Left,
        ImageDown.BoundsRect.Top,
        ImageDown.BoundsRect.Right,
        ImageDown.BoundsRect.Bottom);  FRGNCenter :=  CreateRectRgn(
        ImageCenter.BoundsRect.Left,
        ImageCenter.BoundsRect.Top,
        ImageCenter.BoundsRect.Right,
        ImageCenter.BoundsRect.Bottom);
      ///////End 创建不规则的区域
      
      ShowFormRgn;  DoubleBuffered := True;
      FShowRight := False;
      FShowDown := False;
    end;procedure TForm1.SetShowRight(const Value: Boolean);
    const
      {$J+}vChanging: Boolean = False;
    const
      cOffset = 3;
    var
      I: Integer;
      vStart, vEnd: Integer;
      vOffset: Integer; //偏移量
    begin
      if FShowRight = Value then Exit;
      if vChanging then Exit;
      FShowRight := Value;
      vChanging := True;
      if FShowRight then begin
        vOffset := -cOffset;
        vStart := ImageRight.Left;
        vEnd := ImageRight.Left - ImageRight.Width + 20;
      end else begin
        vOffset := +cOffset;
        vStart := ImageRight.Left;
        vEnd := ImageRight.Left + ImageRight.Width - 20;
      end;
      I := vStart;
      while Abs(I - vEnd) > Abs(vOffset) do begin
        ImageRight.Left := I;
        MemoRight.Left := I + 1;
        SpeedButtonRight.Left := I + 170;
        Application.ProcessMessages;
        OffsetRgn(FRGNRight, vOffset, 0); //偏移区域
        ShowFormRgn;
        ClientWidth := I + ImageRight.Width + 2; //宽度改变
        Update;
        I := I + vOffset;
      end;
      vChanging := False;
    end;procedure TForm1.SetShowDown(const Value: Boolean);
    const
      {$J+}vChanging: Boolean = False;
    const
      cOffset = 3;
    var
      I: Integer;
      vStart, vEnd: Integer;
      vOffset: Integer; //偏移量
    begin
      if FShowDown = Value then Exit;
      if vChanging then Exit;
      FShowDown := Value;
      vChanging := True;
      if FShowDown then begin
        vOffset := -cOffset;
        vStart := ImageDown.Top;
        vEnd := ImageDown.Top - ImageDown.Height + 20;
      end else begin
        vOffset := +cOffset;
        vStart := ImageDown.Top;
        vEnd := ImageDown.Top + ImageDown.Height - 20;
      end;
      I := vStart;
      while Abs(I - vEnd) > Abs(vOffset) do begin
        ImageDown.Top := I;
        MemoDown.Top := I + 1;
        SpeedButtonDown.Top := I + 95;
        Application.ProcessMessages;
        OffsetRgn(FRGNDown, 0, vOffset); //偏移区域
        ShowFormRgn;
        ClientHeight := I + ImageDown.Height + 2; //宽度改变
        Update;
        I := I + vOffset;
      end;
      vChanging := False;
    end;procedure TForm1.FormDestroy(Sender: TObject);
    begin
      DeleteObject(FRGNRight);
      DeleteObject(FRGNDown);
      DeleteObject(FRGNCenter);
      DeleteObject(FRGNForm);
    end;procedure TForm1.ShowFormRgn;
    begin
      ///////Begin 清除区域
      DeleteObject(FRGNForm);
      FRGNForm := CreateRectRgn(0, 0, 0, 0);
      ///////End 清除区域
      CombineRgn(FRGNForm, FRGNCenter, FRGNRight, RGN_OR);
      CombineRgn(FRGNForm, FRGNForm, FRGNDown, RGN_OR);
      SetWindowRgn(Handle, FRGNForm, True);
    end;procedure TForm1.ImageCenterMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      ReleaseCapture;
      Perform(WM_SYSCOMMAND, SC_MOVE + 1, 0);
    end;procedure TForm1.SpeedButtonCloseClick(Sender: TObject);
    begin
      Close;
    end;end.//------------------------------------------------------------------------object Form1: TForm1
      Left = 97
      Top = 22
      BorderStyle = bsNone
      Caption = 'Form1'
      ClientHeight = 486
      ClientWidth = 602
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      OldCreateOrder = False
      OnCreate = FormCreate
      OnDestroy = FormDestroy
      PixelsPerInch = 96
      TextHeight = 13
      object ImageRight: TImage
        Left = 408
        Top = 36
        Width = 190
        Height = 263
      end
      object ImageDown: TImage
        Left = 64
        Top = 368
        Width = 294
        Height = 115
      end
      object SpeedButtonRight: TSpeedButton
        Left = 576
        Top = 140
        Width = 17
        Height = 33
        OnClick = SpeedButtonRightClick
      end
      object SpeedButtonDown: TSpeedButton
        Left = 192
        Top = 464
        Width = 41
        Height = 17
        OnClick = SpeedButtonDownClick
      end
      object MemoDown: TMemo
        Left = 83
        Top = 369
        Width = 256
        Height = 80
        BevelKind = bkFlat
        Lines.Strings = (
          'MemoDown')
        TabOrder = 2
      end
      object MemoRight: TMemo
        Left = 410
        Top = 52
        Width = 156
        Height = 225
        BevelKind = bkFlat
        Lines.Strings = (
          'MemoRight')
        TabOrder = 1
      end
      object PanelCenter: TPanel
        Left = 0
        Top = 0
        Width = 409
        Height = 369
        BevelOuter = bvNone
        TabOrder = 0
        object ImageCenter: TImage
          Left = -2
          Top = 0
          Width = 411
          Height = 369
          ParentShowHint = False
          ShowHint = False
          OnMouseDown = ImageCenterMouseDown
        end
        object SpeedButtonClose: TSpeedButton
          Left = 380
          Top = 5
          Width = 23
          Height = 22
          OnClick = SpeedButtonCloseClick
        end
      end
    end
    没试过,不知可不可以
      

  2.   

    我试了楼上的代码,挺好玩的,但我要的不是这个功能。我想要就象你浏览器上邮件的功能。但不许用toolbar,CoolBar1,
      

  3.   

    做一张带三角的图片:在OnMouseDown中加入PopupMenu.Popup的代码!当然你单独做个带三角的按钮,要封装成一个类都随便!只是一种形式!