Controles móviles en una gridpanel con Delphi

Question

En una pregunta anterior aquí, pregunté sobre Drag n Drop dentro del GridPanel.

Arrastrar y soltar controles en una gridpanel

La pregunta que tengo a continuación es que estoy teniendo un comportamiento extraño cada vez que trato de mover los controles diagonalmente cuando están cerca de otros controles. Los controles que no se suponen que deben moverse son células cambiantes. Arriba y abajo, de lado está bien. Pero los movimientos diagonales, cuando el contenido de la celda movido está en la misma fila/columna con otras celdas que contienen controles causarán cambios inesperados. He intentado BeginUpdate/Endupdate Los cambios aún ocurren. Hay una función de bloqueo para el plidpanel pero bloquea cualquier cosa. Ocurre cuando la caída está en una celda vacía e incluso celdas que ya tienen contenido.

Aquí está el proyecto de prueba (Delphi 2010 sin 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;

Answer 1

No se trata de arrastrar, cuando la columna y la fila de un elemento están cambiando el cambio ocurre en dos pasos. Con su código, primero la columna, luego la fila. Si en el cambio de columna, FI, ya que ya hay otro control, este otro control se deja a un lado, incluso si su celda no es la ubicación final de la celda objetivo del control móvil.

Begin/Endupdate no funcionará, la colección de control nunca verifica el recuento de actualizaciones. Lo que puede hacer es usar un truco protegido para acceder al elemento de control InternalSetLocation método. Este método tiene un parámetro 'Moveexisting' que puede pasar 'falso'.

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;

Es posible que deba probar si la celda objetivo está vacía o no antes de llamar a 'InternalSetLocation' dependiendo de lo que espere que sea el movimiento de control correcto.

Answer 2

Utilizo una forma bastante diferente de hacer el trabajo ... crea una unidad completa solo para agregar un método a ExtCtrls.TControlCollection sin tocar la unidad ExtCtrls (primer hack) y hacer que dicho método se use InternalSetLocation (Segundo hack). También explico ambos hacks en esta publicación.

Entonces solo necesito agregar dicha unidad a la sección Usos de implementación (antes de la declaración de GridPanel) y llamar al método que creé ... muy simple de usar.

Así es como lo hago, paso a paso:

1. Incluyo dicha unidad que enloquecí para ese trabajo en el proyecto (agregar archivo)
2. Agrego a mi interfaz TForm usa la sección dicha unidad (o donde la necesito)
3. Yo uso mi método AddControlAtCell en vez de ExtCtrls.TControlCollection.AddControl

Aquí está la unidad que había creado para ese trabajo, guárdela como 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.

Espero que los comentarios sean suficientes claros, por favor léelos para comprender por qué y cómo lo hago.

Luego, cuando necesito agregar un control al GridPanel en una celda especificada, hago la siguiente llamada simple:

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

Un ejemplo muy básico de agregar un tiempo de ejecución recién creado TCheckbox en una celda específica podría ser así:

// 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

Tenga en cuenta que uso estos dos hacks:

1. type THackControlItem Déjame acceder al método InternalSetLocation.
2. type TGridPanel=class(ExtCtrls.TGridPanel) Déjame agregar un método a ExtCtrls.TGridPanel sin siquiera tocar (ni necesito una fuente de ExtCtrls)

IMPORTANTE: Tenga en cuenta que menciono que requiere agregar la unidad a los usos de la interfaz de cada formulario donde desea usar el método AddControlAtCell; Eso es para personas normales, las personas avanzadas también podrían crear otra unidad, etc. el 'concepto' es tener la unidad de los usos antes de la declaración del GridPanel donde debe usarla ... Puso en el momento de diseño en un formulario ... debe seguir los usos de implementación de dicha unidad de formulario.

Espero que esto ayude a alguien más.

Answer 3

La siguiente solución funciona sin ningún tipo de piratería.

Mi código está en C ++ Builder, pero creo que es simplemente comprender para los usuarios de Delphi porque solo confía en las funciones de VCL. PD: Tenga en cuenta que arrasto los tpanels en lugar de tbutton (un cambio muy menor).

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;
                }
           }
        }
     }
}