Moving controls in a gridpanel with Delphi

Question

In a previous question here I asked about drag n drop within the gridpanel.

Drag N Drop controls in a GridPanel

The question I have next is that I am having weird behavior whenever I try to move controls diagonally when they are near other controls. Controls that not suppose to move are shifting cells. Up and down, sideways it is fine. But diagonal moves, when the moved cell contents are on the same row/column with other cells which hold controls will cause unexpected shifts. I have tried beginupdate/endupdate the shifts still happen. There is a LOCK function for the gridpanel but lock anything. It happens when the drop is on an empty cell, and even cells that already have contents.

here is the test project (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;

Answer 1

The solution below works without any kind of hacking.

My code is in C++ Builder but i think it is simply to understand for Delphi users because it rely only on VCL functions. PS: note that I drag TPanels instead of TButtons (a very minor change).

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

Answer 2

I use a quite different way to do the Job... Create a whole unit just to add a method to ExtCtrls.TControlCollection without touching unit ExtCtrls (first hack) and make such method use InternalSetLocation (second hack). I also explain both hacks on this post.

Then i only need to add such unit to implementation uses section (before gridpanel declaration) and call the method i created... very simple to use.

Here is how i do it, step by step:

1. I include such unit i maded for such job to the project (add file)
2. I add to my TForm interface uses section such unit (or where i need it)
3. I use my method AddControlAtCell instead of ExtCtrls.TControlCollection.AddControl

Here is the unit i had created for such job, save it as 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.

I hope the comments are enough clear, please read them to understand why and how i do it.

Then, when i need to add a control to the gridpanel at a specified cell i do the next simple call:

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

A very, very basic example of adding a runtime newly created TCheckBox at a specific cell could be like this:

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

Please Note that i use this two Hacks:

1. type THackControlItem let me access the method InternalSetLocation.
2. type TGridPanel=class(ExtCtrls.TGridPanel) let me add a method to ExtCtrls.TGridPanel without even touching (neither needing source of ExtCtrls)

Important: Also note that i mention it requieres to add the unit to the uses of the interface of each form where you want to use the method AddControlAtCell; that is for normal people, advanced people could also create another unit, etc... the 'concept' is to have the unit on the uses before the declaration of the GridPanel where you wnat to use it... example: if GridPanel is putted at design time on a form... it must go on implementation uses of such form unit.

Hope this helps some one else.

Answer 3

This is not about dragging, when an item's both column and row are changing the change occurs in two steps. With your code, first the column, then the row. If in the column change, f.i., there happens to be already an other control, this other control is pushed aside, even if its cell is not the ultimate location of the target cell of the moving control.

Begin/EndUpdate will not work, the control collection never checks the update count. What can you do is to use a protected hack to access the control item's InternalSetLocation method. This method has a 'MoveExisting' parameter which you can pass 'False'.

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;

You might need to test if the target cell is empty or not before calling 'InternalSetLocation' depending on what you expect to be the correct control movement.