Recent

Author Topic: Tpagecontrol drag and dropping tabs  (Read 8960 times)

Andyk

  • Jr. Member
  • **
  • Posts: 65
Tpagecontrol drag and dropping tabs
« on: June 18, 2012, 01:17:07 pm »
I am trying to write code so that the end user can reorder the tabs in a page control.

I have tried these methods which works in delphi.

Code: [Select]
procedure TMainform.PagesDragDrop(Sender, Source:TObject; X,Y:Integer);
const TCM_GETITEMRECT = $130A;
var TabRect:TRect; j,k1:Integer;
begin
  if (Sender is TPageControl) then
   for j := 0 to Pages.PageCount - 1 do
   begin
     Pages.Perform(TCM_GETITEMRECT, j, longint(@TabRect)) ;
     if PtInRect(TabRect, Point(X, Y)) then
     begin
       k1:=pages.Activepage.imageindex;
       if Pages.ActivePage.PageIndex <> j then
         Pages.ActivePage.PageIndex := j;
       Exit;
     end;
   end;
end;


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

procedure TMainform.PagesMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbleft then
  Pages.BeginDrag(False);
end;

In LCL there are a couple of problems,

1- The X,Y coordinates sent to these event handlers seems wrong, the Y coordinate is negative when inside the page tab.

2-A temp fix of the above can be implemented by using abs(Y), it only works for a single line of tabs. However this makes the drag and drop work but, if the tabs have images associated, then the image does not follow the tab when it is relocated and I can't find any way to reassign the imageindex of a moved tab at runtime, it always keeps the original image.

Any clues whats going on?

Lazarus is still on WIN32 BTW.

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 6823
  • Debugger - SynEdit - and more
    • wiki
Re: Tpagecontrol drag and dropping tabs
« Reply #1 on: June 18, 2012, 01:49:25 pm »
Install the pckage LazControls

it has TExtendedNotebook (which iirc is a PageControl now) and that has tab drag and drop (as used by the IDE itself)

Andyk

  • Jr. Member
  • **
  • Posts: 65
Re: Tpagecontrol drag and dropping tabs
« Reply #2 on: June 18, 2012, 02:06:00 pm »
Install the pckage LazControls

it has TExtendedNotebook (which iirc is a PageControl now) and that has tab drag and drop (as used by the IDE itself)

Just tried that !

It does exactly the same, I can drag the page but the sheet image index remains incorrect.

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 6823
  • Debugger - SynEdit - and more
    • wiki
Re: Tpagecontrol drag and dropping tabs
« Reply #3 on: June 18, 2012, 02:19:15 pm »
Oh, I see. Sems to be a bug.

Even happens, if pages a reordered in the designer

Andyk

  • Jr. Member
  • **
  • Posts: 65
Re: Tpagecontrol drag and dropping tabs
« Reply #4 on: June 18, 2012, 02:27:31 pm »
Oh, I see. Sems to be a bug.

Even happens, if pages a reordered in the designer

I didn't think to try that, yes you are correct.

Well at least I'm glad its not me doing something stupid. :D

joseme

  • Full Member
  • ***
  • Posts: 128
    • Logosoft sistemas
Re: Tpagecontrol drag and dropping tabs
« Reply #5 on: June 18, 2012, 02:31:10 pm »
I just did a fast test with Lazarus 1.1, revision 37429. It seems the bug has been resolved, I was able to drag tabs without troubles.
un aporte a la comunidad:
http://pascalylazarus.blogspot.com/

KpjComp

  • Hero Member
  • *****
  • Posts: 680
Re: Tpagecontrol drag and dropping tabs
« Reply #6 on: June 18, 2012, 02:47:15 pm »
As a quick hack.

Put this on the TabEndDrag event.

Code: [Select]
procedure TForm1.ExtendedNotebook1TabEndDrag(Sender, Target: TObject; X,
  Y: Integer);
var
  i:integer;
  p:integer;
  e:TExtendedNotebook;
begin
  e := Sender as TExtendedNotebook;
  for p := 0 to e.PageCount-1 do
    with e.page[p] do
    begin
      i := ImageIndex;
      ImageIndex:=i+1;
      ImageIndex:=i;
    end;
end;   

Andyk

  • Jr. Member
  • **
  • Posts: 65
Re: Tpagecontrol drag and dropping tabs
« Reply #7 on: June 18, 2012, 02:54:47 pm »
I just did a fast test with Lazarus 1.1, revision 37429. It seems the bug has been resolved, I was able to drag tabs without troubles.

I'm using revision 37629 !

Its due to the setimageindex routine thinking its value is not being changed, I did this hack in custompage.inc which fixes it.

procedure TCustomPage.SetImageIndex(const AValue: TImageIndex);
begin
//  if FImageIndex = AValue then Exit;
  FImageIndex := AValue;
  if not HandleAllocated or (csLoading in ComponentState) then Exit;
  TWSCustomPageClass(WidgetSetClass).UpdateProperties(Self);
end;

KpjComp

  • Hero Member
  • *****
  • Posts: 680
Re: Tpagecontrol drag and dropping tabs
« Reply #8 on: June 18, 2012, 05:11:40 pm »
Code: [Select]
//  if FImageIndex = AValue then Exit;
  FImageIndex := AValue;

Be careful of removing this check, if setImageIndex is called often, there could be a performance loss as the WidgetSet is updated more than required.

Seen as it's setting the PageIndex that gets the Images out of sync, I'd say the best place to implement the change would be on the DoSendPageIndex method.

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 6823
  • Debugger - SynEdit - and more
    • wiki
Re: Tpagecontrol drag and dropping tabs
« Reply #9 on: June 18, 2012, 05:32:00 pm »
The issue is in the w32 widget code (gtk2 and qt work)

win32 calls a function to get an index, but it works on outdated data.

I am currently checking, how to best fix that

Andyk

  • Jr. Member
  • **
  • Posts: 65
Re: Tpagecontrol drag and dropping tabs
« Reply #10 on: June 18, 2012, 10:22:43 pm »
The issue is in the w32 widget code (gtk2 and qt work)

win32 calls a function to get an index, but it works on outdated data.

I am currently checking, how to best fix that

Yeah, I realise that wasn't a real fix because I still need to explicitly set the imagindex of the page after it gets moved to make it update.

This is supposed to happen automatically as the image belongs to the page.

It does get it working for the moment though.

Ericktux

  • Full Member
  • ***
  • Posts: 230
Re: Tpagecontrol drag and dropping tabs
« Reply #11 on: January 11, 2021, 06:19:58 am »
hello friends I just found this solution to move the tabs of the pagecontrol with the mouse.
the good news is that it respects the order of the images on the tabs.
Here I share, code, project and image  :)

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   windows,
  9.   Classes,
  10.   SysUtils,
  11.   Forms,
  12.  
  13.   //CommCtrl,
  14.  
  15.   Controls,
  16.   Graphics,
  17.   Dialogs,
  18.   ComCtrls, StdCtrls;
  19.  
  20. type
  21.  
  22.   { TForm1 }
  23.  
  24.   TForm1 = class(TForm)
  25.     Button1: TButton;
  26.     Button2: TButton;
  27.     Button3: TButton;
  28.     Button4: TButton;
  29.     Button5: TButton;
  30.     ImageList1: TImageList;
  31.     PageControl1: TPageControl;
  32.     TabSheet1: TTabSheet;
  33.     TabSheet2: TTabSheet;
  34.     TabSheet3: TTabSheet;
  35.     TabSheet4: TTabSheet;
  36.     TabSheet5: TTabSheet;
  37.     procedure FormCreate(Sender: TObject);
  38.     procedure PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer);
  39.     procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
  40.       State: TDragState; var Accept: Boolean);
  41.     procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
  42.       Shift: TShiftState; X, Y: Integer);
  43.   private
  44.         //function GetDroppedIndex(X, Y: Integer): Integer;
  45.         //function GetTabIndex(APageControl:TPageControl;X, Y: Integer): Integer;
  46.  
  47.   public
  48.  
  49.   end;
  50.  
  51. var
  52.   Form1: TForm1;
  53.  
  54. implementation
  55. uses CommCtrl;
  56.  
  57. {$R *.lfm}
  58.  
  59. { TForm1 }
  60.  
  61. function GetTabIndex(APageControl:TPageControl;X, Y: Integer): Integer;
  62. var TabRect: TRect;
  63. begin
  64.   {Le résultat de cette fonction
  65.   nous donne l'index de l'onglet qui se trouve aux coordonnées X,Y
  66.   (le repère de référence étant la fenêtre du TPageControl)}
  67.   Result := APageControl.IndexOfTabAt(X,Y);
  68.   // Si la souris se trouve au dessus d'un onglet
  69.   if Result>-1 then
  70.   begin
  71.     // On récupère le rectangle de l'onglet visé
  72.     TabRect:=APageControl.TabRect(Result);
  73.     // Si on est dans la partie droite de ce rectangle
  74.     if x>((TabRect.Left+TabRect.Right) div 2)
  75.     // Alors l'index d'insertion est (Index de l'onglet visé)+1
  76.     then Inc(Result);
  77.   end;
  78. end;
  79.  
  80.  
  81. {  I have commented on this code because I cannot find a solution for "APageControl.Canvas"  (ericktux 2021)
  82. procedure DrawInsertionPoint(APageControl:TPageControl;X,Y:integer);
  83. var TabRect: TRect;
  84.     TabIndex:integer;
  85.     X1,X2,Y1,Y2:integer;
  86. begin
  87.   // On obtient l'index où serait éventuellement inséré notre onglet
  88.   TabIndex:=GetTabIndex(APageControl,x,y);
  89.   // La petite ligne indicatrice sera rouge
  90.   //APageControl.Canvas.Pen.Color:=clRed;   // COMMENTED for me ericktux
  91.  
  92.   if (TabIndex<APageControl.PageCount)
  93.   // Si l'onglet ne serait pas déposé en dernière place
  94.   then begin
  95.          // On prend les coordonnées du "rectangle" de dessin de l'onglet qu'il
  96.          // peut remplacer
  97.          TabRect:=APageControl.TabRect(TabIndex);
  98.          // À partir de là, on calcule les coordonnées (X1,Y1)--(X2,Y2) de
  99.          // notre ligne qui sera tracée sur son bord gauche
  100.          X1:=TabRect.Left;
  101.          X2:=X1;
  102.          Y1:=TabRect.Top;
  103.          Y2:=TabRect.Bottom;
  104.         end
  105.   // Si l'onglet serait déposé en dernière place (TabIndex<APageControl.PageCount)
  106.    else begin
  107.           // On prend les coordonnées du "rectangle" de dessin du dernier onglet
  108.           TabRect:=APageControl.TabRect(TabIndex-1);
  109.           // Puis on calcule les coordonnées (X1,Y1)--(X2,Y2) de
  110.           // notre ligne qui sera tracée sur son bord droit
  111.           X1:=TabRect.Right;
  112.           X2:=X1;
  113.           Y1:=TabRect.Top;
  114.           Y2:=TabRect.Bottom;
  115.          end;
  116.    // On trace notre petite ligne
  117.     //APageControl.Canvas.MoveTo(X1,Y1);  // COMMENTED for me ericktux
  118.     //APageControl.Canvas.LineTo(X2,Y2);  // COMMENTED for me ericktux
  119.  
  120. end;
  121. }
  122.  
  123. // Procedure chargée de déposer un onglet à la fin d'un glissé-déposé
  124. procedure DoTabDragDrop(Sender, Source: TPageControl; X,
  125.   Y: Integer);
  126. const TCM_GETITEMRECT = $130A;
  127. var i: Integer;
  128.     SourceIndex,TargetIndex:Integer;
  129.     ATabSheet:TTabSheet;
  130. begin
  131.    if Sender=Source
  132.    // Si le glissé-déposé concerne un TPageControl sur lui même
  133.    then begin
  134.            {On détermine la nouvelle valeur d'index de l'onglet que l'on dépose}
  135.            TargetIndex:=GetTabIndex(Sender,x,y);
  136.            {Si on ne le dépose pas "dans le vide"}
  137.            if (TargetIndex>-1)
  138.            {L'onglet déposé, celui qui est actif (ActivePage), prend sa nouvelle
  139.             valeur d'index (PageIndex)}
  140.            then begin
  141.                   // Si le nouvel index est supérieur à l'ancien index,
  142.                   // on le décrémente, sinon l'onglet est "mal déplacé"
  143.                   if (TargetIndex>Sender.ActivePage.PageIndex) then dec(TargetIndex);
  144.                   Sender.ActivePage.PageIndex:=TargetIndex;
  145.                 end;
  146.         end
  147.    // Si le glissé-déposé s'effectue entre deux TPageControl différents...
  148.    else begin
  149.            {On détermine l'index de l'onglet que l'on dépose}
  150.            SourceIndex:=Source.ActivePage.PageIndex;
  151.            {On détermine la nouvelle valeur d'index de l'onglet que l'on dépose}
  152.            TargetIndex:=GetTabIndex(Sender,x,y);
  153.            {Si on ne le dépose pas "dans le vide"}
  154.            if TargetIndex>-1 then
  155.            begin
  156.               // On récupère la référence de notre onglet
  157.               ATabSheet:=Source.Pages[SourceIndex];
  158.               // On l'affecte à son nouveau TPageControl
  159.               ATabSheet.PageControl:=Sender;
  160.               // Et on lui assigne son nouvel index
  161.               ATabSheet.PageIndex:=TargetIndex;
  162.            end;
  163.         end;
  164. end;
  165.  
  166. // Événement OnMouseDown de votre TPageControl
  167. // (début du glissé-déposé : on commence le glissement de l'onglet)
  168. procedure TForm1.PageControl1MouseDown(Sender: TObject;
  169.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  170. begin
  171.   if (Sender is TPageControl)
  172.   {On active la fonctionnalité de glissé-déposé (Drag And Drop)
  173.    le paramètre "False" de la fonction BeginDrag() signifie que le pointeur
  174.    de la souris ne change pas et que le glissement ne commence que
  175.    lorsque l'utilisateur déplace la souris sur une courte distance (1 pixel).}
  176.   then (Sender as TPageControl).BeginDrag(False);
  177. end;
  178.  
  179. // Événement OnDragDrop de votre TPageControl
  180. // (fin du glissé-déposé : on dépose l'onglet)
  181. procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X,
  182.   Y: Integer);
  183. begin
  184.    if (Sender is TPageControl) and (Source is TPageControl) then
  185.    begin
  186.      // Utilisation de notre procedure chargée de déposer
  187.      // un onglet à la fin d'un glissé-déposé
  188.      DoTabDragDrop((Sender as TPageControl), (Source as TPageControl),X,Y);
  189.      {Fin du glissé-déposé --> passage de True en paramètre}
  190.      (Source as TPageControl).EndDrag(True);
  191.    end;
  192. end;
  193.  
  194. procedure TForm1.FormCreate(Sender: TObject);
  195. begin
  196.  
  197. end;
  198.  
  199. // Événement OnDragOver de votre TPageControl
  200. // (Le glissé-déposé est en train de se faire :
  201. // la souris passe au-dessus du TPageControl)
  202. procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X,
  203.   Y: Integer; State: TDragState; var Accept: Boolean);
  204. begin
  205.    if (Sender is TPageControl) then
  206.    begin
  207.      //On redessine notre TPageControl (pour effacer notre ligne d'insertion)
  208.      (Sender as TPageControl).Repaint;  // If you get "error exception" or "access violation" here you comment (ericktux 2021)
  209.      //Si la souris quitte notre cible de glissé-déposé on ignore ce qui suit
  210.      if State<>dsDragLeave
  211.      then begin
  212.             Accept := True;
  213.             //On dessine le point d'insertion
  214.             //DrawInsertionPoint((Sender as TPageControl),X,Y);
  215.  
  216.           end;
  217.    end;
  218. end;
  219. end.
  220.  
  221. end.

for the moment it works perfect for me in windows  :)
« Last Edit: January 11, 2021, 07:19:17 am by Ericktux »

 

TinyPortal © 2005-2018