delphi vcl 的 TPageControl 控件,实现对页签的拖动
我们在TPageControl 控件里 放了几个页签,但很多时候我们的需求是把某个页签放前面 和 另一个旁边的方便切换做对比。这个可以有更好的体验,类似Delphi IDE编辑器一样切换页签。
分别 在 DragDrop 、DragOver 、MouseDown 事件写上对应代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label1: TLabel;
TabSheet3: TTabSheet;
Label2: TLabel;
procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//拖动标签
if (Sender is TPageControl) then
if ssLeft in Shift then begin
TPageControl(Sender).BeginDrag(False);
end;
end;
procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
const
TCM_GETITEMRECT = $130A;
var
TabRect: TRect;
Idx: Integer;
begin
//拖动标签
if (Sender is TPageControl) then
for Idx := TPageControl(Sender).PageCount - 1 downto 0 do
begin
TPageControl(Sender).Perform(TCM_GETITEMRECT, Idx, LParam(@TabRect));
if PtInRect(TabRect, Point(X, Y)) then // 搜索 每个Tab的区域并判断鼠标区域
begin
if TPageControl(Sender).ActivePage.PageIndex <> Idx then begin
TPageControl(Sender).ActivePage.PageIndex := Idx;
end;
Exit;
end;
end;
end;
procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
// 判断调用者为 TPageControl 类型可以拖动标签
Accept := (Sender is TPageControl);
end;
end.
运行效果如下
来源:http://www.delphifmx.com/node/69