delphi vcl 的 TPageControl 控件，实现对页签的拖动-木庄网络博客

本文整理自网络，侵删。
 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
delphi vcl 的 TPageControl 控件，实现对页签的拖动

相关推荐

评论
