與德爾福

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是在設計時刻把它放在一個表格上...它必須繼續用於這種表單單元的實現。

希望這可以幫助別人。