2017年9月7日 星期四

PageControl Tab Drag 頁籤拖曳

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


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;

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



轉貼至 http://www.swissdelphicenter.ch/en/showcode.php?id=963

沒有留言:

張貼留言