le déplacement des contrôles dans un GridPanel avec Delphi

StackOverflow https://stackoverflow.com/questions/5369419

  •  27-10-2019
  •  | 
  •  

Question

Dans une question précédente ici j'ai demandé glisser n déposer dans le GridPanel.

Faites glisser N commandes goutte dans un GridPanel

La question que j'ai à côté est que j'ai un comportement bizarre chaque fois que je tente de déplacer les commandes en diagonale quand ils sont à proximité d'autres contrôles. Les contrôles qui supposent de ne pas bouger les cellules se déplacent. Haut et en bas, sur le côté, il est très bien. Mais en diagonale se déplace, lorsque le contenu des cellules sont déplacés sur la même ligne / colonne avec d'autres cellules qui contiennent des contrôles provoquent des changements inattendus. J'ai essayé BeginUpdate / EndUpdate les changements se produisent encore. Il y a une fonction de verrouillage pour le GridPanel mais quoi que ce soit serrure. Il arrive lorsque la chute est sur une cellule vide, et les cellules qui ont même déjà le contenu.

ici est le projet de test (Delphi 2010 w / o exe) http://www.mediafire.com/?xmrgm7ydhygfw2r 

type
  TForm1 = class(TForm)
    GridPanel1: TGridPanel;
    btn1: TButton;
    btn3: TButton;
    btn2: TButton;
    lbl1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure GridPanelDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure btnDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure btnDragDrop(Sender, Source: TObject; X, Y: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SetColumnWidths(aGridPanel: TGridPanel);
var
  i,pct: Integer;
begin
  aGridPanel.ColumnCollection.BeginUpdate;
  pct:=Round(aGridPanel.ColumnCollection.Count/100);
  for i := 0 to aGridPanel.ColumnCollection.Count - 1 do begin
    aGridPanel.ColumnCollection[i].SizeStyle := ssPercent;
    aGridPanel.ColumnCollection[i].Value     := pct;
  end;
  aGridPanel.ColumnCollection.EndUpdate;
end;

procedure SetRowWidths(aGridPanel: TGridPanel);
var
  i,pct: Integer;
begin
  aGridPanel.RowCollection.BeginUpdate;
  pct:=Round(aGridPanel.RowCollection.Count/100);
  for i := 0 to aGridPanel.RowCollection.Count - 1 do begin
    aGridPanel.RowCollection[i].SizeStyle := ssPercent;
    aGridPanel.RowCollection[i].Value     := pct;
  end;
  aGridPanel.RowCollection.EndUpdate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  btn1.OnDragOver := btnDragOver;
  btn2.OnDragOver := btnDragOver;
  btn3.OnDragOver := btnDragOver;
  GridPanel1.OnDragOver := btnDragOver;
  GridPanel1.OnDragDrop := GridPanelDragDrop;

  btn1.OnDragDrop := btnDragDrop;
  btn2.OnDragDrop := btnDragDrop;
  btn3.OnDragDrop := btnDragDrop;

  SetColumnWidths(GridPanel1);
  SetRowWidths(GridPanel1);
end;

procedure TForm1.btnDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := (Source is TButton);
end;

procedure TForm1.btnDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  src_x,src_y, dest_x, dest_y: Integer;
  btnNameSrc,btnNameDest: string;
  src_ctrlindex,dest_ctrlindex:integer;
begin
  if Source IS tBUTTON then
  begin
    //GridPanel1.ColumnCollection.BeginUpdate;
    btnNameSrc := (Source as TButton).Name;
    btnNameDest := (Sender as TButton).Name;
    src_ctrlindex := GridPanel1.ControlCollection.IndexOf(Source as tbutton);
    src_x := GridPanel1.ControlCollection.Items[src_ctrlindex].Column;
    src_y := GridPanel1.ControlCollection.Items[src_ctrlindex].Row;

    dest_ctrlindex := GridPanel1.ControlCollection.IndexOf(Sender as tbutton);
    dest_x := GridPanel1.ControlCollection.Items[dest_ctrlindex].Column;
    dest_y := GridPanel1.ControlCollection.Items[dest_ctrlindex].Row;

    GridPanel1.ControlCollection[src_ctrlindex].Column := dest_x;
    GridPanel1.ControlCollection[src_ctrlindex].Row := dest_y;
    //GridPanel1.ColumnCollection.EndUpdate;

    lbl1.Caption := Format('"%s" from cell %d:%d to Cell %s=%d:%d', [btnNameSrc,src_x,src_y,btnNameDest,dest_x,dest_y]);

  end;
end;

procedure TForm1.GridPanelDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  DropPoint: TPoint;
  CellRect: TRect;
  i_col, i_row, src_x,src_y, dest_x, dest_y: Integer;
  btnNameSrc,btnNameDest: string;
  src_ctrlindex:integer;
begin
  if Source is tbutton then
  begin
    btnNameSrc := (Source as TButton).Name;
    btnNameDest := '';
    src_ctrlindex := GridPanel1.ControlCollection.IndexOf(Source as tbutton);
    src_x := GridPanel1.ControlCollection.Items[src_ctrlindex].Column;
    src_y := GridPanel1.ControlCollection.Items[src_ctrlindex].Row;

    DropPoint := Point(X, Y);
    for i_col := 0 to GridPanel1.ColumnCollection.Count-1 do
      for i_row := 0 to GridPanel1.RowCollection.Count-1 do
      begin
        CellRect := GridPanel1.CellRect[i_col, i_row];
        if PtInRect(CellRect, DropPoint) then
        begin
          // Button was dropped over Cell[i_col, i_row]
          dest_x := i_col;
          dest_y := i_row;
          Break;
        end;
      end;
    lbl1.Caption := Format('"%s" from cell %d:%d to Cell %s=%d:%d', [btnNameSrc,src_x,src_y,btnNameDest,dest_x,dest_y]);

    GridPanel1.ControlCollection[src_ctrlindex].Column := dest_x;
    GridPanel1.ControlCollection[src_ctrlindex].Row := dest_y;
  end;
end;
Était-ce utile?

La solution

Cela n'a rien à faire glisser, quand un élément est à la fois la colonne et rangée sont en train de changer le changement se produit en deux étapes. Avec votre code, d'abord la colonne, puis la ligne. Si dans le changement de la colonne, f.i., il se trouve être déjà un autre contrôle, cette autre contrôle est mis de côté, même si la cellule est pas l'endroit ultime de la cellule cible du contrôle en mouvement.

Début / EndUpdate ne fonctionnera pas, la collecte de contrôle ne vérifie jamais le nombre de mise à jour. Que pouvez-vous faire est d'utiliser un hack protégé pour accéder à la méthode de InternalSetLocation de l'élément de commande. Cette méthode a un paramètre « MoveExisting » que vous pouvez passer « Faux ». 

type
  THackControlItem = class(TControlItem);

procedure TForm1.GridPanelDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  [...]
begin
  if Source is tbutton then
  begin

    [...]

    lbl1.Caption := Format('"%s" from cell %d:%d to Cell %s=%d:%d', [btnNameSrc,src_x,src_y,btnNameDest,dest_x,dest_y]);

    THackControlItem(GridPanel1.ControlCollection[src_ctrlindex]).
        InternalSetLocation(dest_x, dest_y, False, False);
//    GridPanel1.ControlCollection[src_ctrlindex].Column := dest_x;
//    GridPanel1.ControlCollection[src_ctrlindex].Row := dest_y;
  end;
end;

Vous pourriez avoir besoin de tester si la cellule cible est vide ou pas avant d'appeler « InternalSetLocation » en fonction de ce que vous attendez d'être le mouvement de contrôle correct.

Autres conseils

J'utilise une façon tout à fait différente de faire le travail ... Créer une unité entière juste pour ajouter une méthode à ExtCtrls.TControlCollection sans unité toucher ExtCtrls (première entaille) et de faire une telle utilisation de la méthode InternalSetLocation (deuxième bidouille). J'explique également les hacks sur ce poste.

Alors je ne dois ajouter cette unité à section uses de mise en œuvre (avant la déclaration de GridPanel) et appeler la méthode que j'ai créé ... très simple à utiliser.

Voici comment je le fais, étape par étape:

  1. j'inclure une telle unité i maded pour un tel travail au projet (fichier add)
  2. ajouter à mon interface TForm utilise une section telle unité (ou si je en ai besoin)
  3. J'utilise ma méthode AddControlAtCell au lieu de ExtCtrls.TControlCollection.AddControl

Voici l'unité que j'avais créé pour un tel travail, l'enregistrer comme unitTGridPanel_WithAddControlAtCell: 

unit unitTGridPanel_WithAddControlAtCell;

interface

uses
    Controls
   ,ExtCtrls
   ;

type TGridPanel=class(ExtCtrls.TGridPanel)
   private
   public
     procedure AddControlAtCell(AControl:TControl;AColumn:Integer;ARow:Integer); // Add Control on specifed cell, if there already exists a Control it will be deleted
 end;

implementation

uses
    SysUtils
   ;

type
    THackControlItem=class(TControlItem); // To get internal access to InternalSetLocation procedure
procedure TGridPanel.AddControlAtCell(AControl:TControl;AColumn:Integer;ARow:Integer);
var
   TheControlItem:TControlItem; // To let it be added in a specified cell, since ExtCtrls.TControlCollection.AddControl contains multiply BUGs
begin // Add Control on specifed cell, if there already exists a Control it will be deleted
     if   (-1<AColumn)and(AColumn<ColumnCollection.Count) // Cell with valid Column
       and // Cell inside valid range
          (-1<ARow)and(ARow<RowCollection.Count) // Cell with valid Row
     then begin // Valid cell, must check if there is already a control
               if   (Nil<>ControlCollection.ControlItems[AColumn,ARow]) // Check if there are any controls
                 and // A control is already on the cell
                    (Nil<>ControlCollection.ControlItems[AColumn,ARow].Control) // Check if cell has a control
               then begin // There is already a control, must be deleted
                         ControlCollection.Delete(ControlCollection.IndexOf(ControlCollection.ControlItems[AColumn,ARow].Control)); // Delete the control
                    end;
               TheControlItem:=ControlCollection.Add; // Create the TControlItem
               TheControlItem.Control:=TControl(AControl); // Put the Control in the specified cell without altering any other cell
               THackControlItem(ControlCollection.Items[ControlCollection.IndexOf(AControl)]).InternalSetLocation(AColumn,ARow,False,False); // Put the ControlItem in the cell without altering any other cell
          end
     else begin // Cell is out of range
               raise Exception.CreateFmt('Cell [%d,%d] out of range on ''%s''.',[AColumn,ARow,Name]);
          end;
end;

end.

J'espère que les commentaires sont assez clairs, s'il vous plaît les lire pour comprendre pourquoi et comment je le fais.

Alors, quand je dois ajouter un contrôle à la GridPanel à une cellule spécifiée je fais le prochain appel simple: 

TheGridPanel.AddControlAtCell(TheControl,ACloumn,ARow); // Add it at desired cell without affecting other cells

Un très, très exemple de base de l'ajout d'un nouveau moteur d'exécution TCheckBox à une cellule spécifique pourrait ressembler à ceci: 

// AColumn      is of Type Integer
// ARow         is of Type Integer
// ACheckBox    is of Type TCheckBox
// TheGridPanel is of Type TGridPanel
ACheckBox:=TCheckBox.Create(TheGridPanel); // Create the Control to be added (a CheckBox)
ACheckBox.Visible:=False; // Set it to not visible, for now (optimization on speed, e tc)
ACheckBox.Color:=TheGridPanel.Color; // Just to use same background as on the gridpanel
ACheckBox.Parent:=TheGridPanel; // Set the parent of the control as the gridpanel (mandatory)
TheGridPanel.AddControlAtCell(ElCheckBox,ACloumn,ARow); // Add it at desired cell without affecting other cells
ElCheckBox.Visible:=True; // Now it is added, make it visible
ElCheckBox.Enabled:=True; // And of course, ensure it is enabled if needed

S'il vous plaît noter que j'utiliser ces deux Hacks:

  1. type THackControlItem me permettent d'accéder à la méthode InternalSetLocation.
  2. type TGridPanel=class(ExtCtrls.TGridPanel) laissez-moi ajouter une méthode à ExtCtrls.TGridPanel sans même toucher (ni source de besoin ExtCtrls)

Important: Notez également que je le mentionne requieres ajouter l'unité à l'utilisation de l'interface de chaque formulaire où vous souhaitez utiliser la méthode AddControlAtCell; qui est pour les gens normaux, les gens avancés pourraient également créer une autre unité, etc ... le « concept » est d'avoir l'unité sur les usages avant la déclaration du GridPanel où vous WNAT l'utiliser ... Exemple: si GridPanel est puttée au moment de la conception sur une forme ... il faut aller sur les utilisations de mise en œuvre d'une telle unité de forme.

Espérons que cela aide quelqu'un d'autre.

La solution ci-dessous fonctionne sans aucune sorte de piratage.

Mon code est dans C ++ Builder, mais je pense qu'il est tout simplement de comprendre pour les utilisateurs Delphi, car il repose uniquement sur les fonctions VCL. PS: Notez que je fais glisser TPanels au lieu de TButtons (un changement très mineur). 

void TfrmVCL::ButtonDragDrop(TObject *Sender, TObject *Source, int X, int Y)
{
  TRect CurCellRect;
  TRect DestCellRect;
  int Col;
  int Row;
  int destCol; int destRow;
  int srcIndex; int destIndex;
  TPanel *SrcBtn;
  TPanel *DestBtn;

  SrcBtn = dynamic_cast<TPanel *>(Source);
  if (SrcBtn)
     {
     int ColCount = GridPnl->ColumnCollection->Count ;
     int RowCount = GridPnl->RowCollection->Count ;

     // SOURCE
     srcIndex = GridPnl->ControlCollection->IndexOf( SrcBtn );

     // DESTINATION
     // we get coordinates of the button I drag onto
     DestBtn= dynamic_cast<TPanel *>(Sender);
     if (!DestBtn) return;
     destIndex    = GridPnl->ControlCollection->IndexOf( DestBtn );
     destCol      = GridPnl->ControlCollection->Items[ destIndex ]->Column;  // the column for the dragged button
     destRow      = GridPnl->ControlCollection->Items[ destIndex ]->Row;
     DestCellRect = GridPnl->CellRect[ destCol ][ destRow ];

     // Check all cells
     for ( Col = 0 ; Col < ColCount ; Col++ )
        {
        for ( Row = 0 ; Row < RowCount ; Row++ )
           {
             // Get the bounding rect for this cell
             CurCellRect = GridPnl->CellRect[ Col ][ Row ];

             if (IntersectRect_ForReal(DestCellRect, CurCellRect))
                {
                GridPnl->ControlCollection->Items[srcIndex]->SetLocation(Col, Row, false);
                return;
                }
           }
        }
     }
}
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top