再问一问? 不用delphi自带的toolbar,CoolBar1,怎样让speedbutton的右边有一个下拉的三解,可以下拉菜单 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 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 endend没试过,不知可不可以 我试了楼上的代码,挺好玩的,但我要的不是这个功能。我想要就象你浏览器上邮件的功能。但不许用toolbar,CoolBar1, 做一张带三角的图片:在OnMouseDown中加入PopupMenu.Popup的代码!当然你单独做个带三角的按钮,要封装成一个类都随便!只是一种形式! delphi 窗口调用问题讨论 关于RAVE的问题!!!! 全局变量声明引用 关于有序类型 如何取得ie窗口的句柄? 急!!! 关于excel问题? 有没有让delphi7支持officeXP的插件啊? min()的用法。 关于一个按钮的Click事件执行时,另外按钮有效的方法? 怎么连接到DB2? paradox问题 如何在DELPHI中使用DBF数据库呀???
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
没试过,不知可不可以