与德尔福

Question

一个GridPanel中前一个问题中移动控件在这里，我问了一下的GridPanel中拖动ñ下降。

Drag N Drop controls in a GridPanel

我接下来的问题是，我有每当我尝试当他们靠近其他控件角移动控制怪异的行为。不假设移动的控件正在移动单元格。上下，横向很好。但对角移动，当所述移动单元格内容是与该保持控制将导致意外的移位其它细胞相同的行/列。我试过beginupdate/endupdate这些转换依然发生。网格面板有一个LOCK函数，但可以锁定任何东西。这种情况发生在一个空单元上，以及已经有内容的单元上时。

这里是测试项目（德尔福2010瓦特/ 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

这不是拖，当一个项目的两列和行正在改变分两步发生变化。用你的代码，首先是列，然后是行。如果在列变化，f.i.，也恰好是已经是其他控制，这种控制的其他被推开，即使它的电池是不能移动的控制的靶细胞的最终位置。

BEGIN/EndUpdate将无法正常工作，控制集合从不检查更新计数。你可以做的是使用受保护的黑客来访问控制项的InternalSetLocation方法。此方法有一个'MoveExisting'参数，您可以通过'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; 

您可能需要测试，如果目标单元格为空或不叫“InternalSetLocation”这取决于你所期望的是正确的控制动作之前。

Answer 2

我用完全不同的方式做工作......创建一个整体单元只是一个方法添加到ExtCtrls.TControlCollection不接触单元ExtCtrls（第一黑客），使这种方法使用InternalSetLocation（第二黑客）。我也解释了这个帖子的两个黑客。

然后我只需要这样的单位都增加了实施使用（GridPanel中声明之前）部分，并调用我创建的方法......使用起来非常简单。

这里是我如何做到这一点，一步一步：

1. 我有这样的单位我maded这类工作到项目（添加文件）
2. 我添加到我的TForm的接口使用了部分这样的单元（或者我需要它）
3. 我用我的方法AddControlAtCell，而不是ExtCtrls.TControlCollection.AddControl

这里是我已经为这样的作业创建单元，将其保存为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. 

我希望评论是不够清晰，请阅读他们明白，为什么我是怎么做的。

然后，当我需要控制在一个指定单元格添加到的GridPanel我做下简单的调用：

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

在特定添加新创建TCheckBox运行时的一个非常，非常基本的例子细胞可能是这样的：

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

请注意，我用这个两黑客：

1. type THackControlItem让我访问方法InternalSetLocation。
2. type TGridPanel=class(ExtCtrls.TGridPanel)让我添加一个方法来ExtCtrls.TGridPanel，甚至没有接触（既不需要的ExtCtrls源）

重要提示：另请注意，我说出来，requieres到单元添加到每个形式，其中的接口的用途你想使用方法AddControlAtCell;对于普通人来说，高级人员也可以创建另一个单元，等等......'概念'是在GridPanel的声明之前使用该单元的地方，例如：如果GridPanel是在设计时刻把它放在一个表格上...它必须继续用于这种表单单元的实现。

希望这可以帮助别人。