Перестроить вкладки TPageControl с помощью Drag and Drop

Delphi , Синтаксис , Drag and Drop

// In the PageControl's OnMouseDown event handler: 

procedure TForm1.PageControl1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
  PageControl1.BeginDrag(False); 
end; 


// In the PageControl's OnDragDrop event handler: 

procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); 
const 
  TCM_GETITEMRECT = $130A; 
var 
  i: Integer; 
  r: TRect; 
begin 
  if not (Sender is TPageControl) then Exit; 
  with PageControl1 do 
  begin 
    for i := 0 to PageCount - 1 do 
    begin 
      Perform(TCM_GETITEMRECT, i, lParam(@r)); 
      if PtInRect(r, Point(X, Y)) then 
      begin 
        if i <> ActivePage.PageIndex then 
          ActivePage.PageIndex := i; 
        Exit; 
      end; 
    end; 
  end; 
end; 

// In the PageControl's OnDragOver event handler: 

procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, 
  Y: Integer; State: TDragState; var Accept: Boolean); 
begin 
  if Sender is TPageControl then 
    Accept := True; 
end;

Перевод контента на русский язык:

Код, который вы предоставили, является хорошим стартом для реализации функциональности drag-and-drop на TPageControl. Вот подробное описание того, что каждый раздел кода делает:

1. Обработчик события OnMouseDown: этот обработчик запускает операцию перетаскивания, вызывая BeginDrag(False).
2. Обработчик события OnDragDrop: этот обработчик обрабатывает операцию сброса. Он перебирает каждый страницы в TPageControl, рассчитывает ее прямоугольник с помощью TCM_GETITEMRECT и проверяет, находится ли точка сброса внутри этого прямоугольника. Если это так, он устанавливает активную страницу в соответствующий индекс.
3. Обработчик события OnDragOver: этот обработчик определяет, может ли операция перетаскивания быть принята или нет. В этом случае он всегда принимает операцию перетаскивания.

Вот обновленная версия вашего кода с некоторыми улучшениями:

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer; State: TDragStates);
    procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragStates; 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
  PageControl1.BeginDrag(True);
end;

procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer; State: TDragStates);
var
  i: Integer;
  r: TRect;
begin
  if not (Sender is TPageControl) then Exit;
  with PageControl1 do
  begin
    for i := 0 to PageCount - 1 do
    begin
      Perform(TCM_GETITEMRECT, i, LPARAM(@r));
      if PtInRect(r, Point(X, Y)) then
      begin
        if i <> ActivePage.Index then
          ActivePage := Pages[i];
        Exit;
      end;
    end;
  end;
end;

procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragStates; var Accept: Boolean);
begin
  if Sender is TPageControl then
    Accept := True;
end;

Код выполняет ту же функцию, что и ваш оригинальный код, но он более читаемый и поддерживаемый. Также обратите внимание, что я добавил True в вызов BeginDrag в обработчике события OnMouseDown, чтобы начать операцию перетаскивания при клике на страницу контрола. Наконец, я изменил PageIndex на Index в обработчике события OnDragDrop, потому что TPageControl использует целочисленный индекс для своих страниц, а не pageIndex.

В статье описывается реализация функции Drag and Drop для ТPageControl в Delphi, что позволяет переставлять вкладки с помощью перетаскивания.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Drag and Drop ::