使用 Delphi 在网格面板中移动控件
在上一个问题中,我询问了有关网格面板内的拖放的问题。
我接下来的问题是每当我尝试在控件靠近其他控件时对角移动控件时,我都会出现奇怪的行为。不应该移动的控件正在移动细胞。上下、侧面都可以。但是对角线移动,当移动的单元格内容与其他包含控件的单元格位于同一行/列时,将导致意外的移动。我已经尝试过开始更新/结束更新,但转变仍然发生。网格面板有一个 LOCK 功能,但可以锁定任何东西。当水滴落在空单元格上时,甚至已经有内容的单元格上时,就会发生这种情况。
这是测试项目(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;
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;
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(3)
这与拖动无关,当项目的列和行都发生更改时,更改会分两步发生。使用您的代码,首先是列,然后是行。如果在列变化 fi 中,碰巧已经存在另一个控件,则该另一个控件将被推到一边,即使其单元格不是移动控件的目标单元格的最终位置。
Begin/EndUpdate 不起作用,控制集合从不检查更新计数。您可以做的是使用受保护的 hack 来访问控制项的
InternalSetLocation
方法。此方法有一个“MoveExisting”参数,您可以传递“False”。在调用“InternalSetLocation”之前,您可能需要测试目标单元格是否为空,具体取决于您期望的正确控制移动。
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'.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.
我使用一种完全不同的方式来完成这项工作...创建一个整个单元,只是为了向 ExtCtrls.TControlCollection 添加一个方法,而不接触单元 ExtCtrls(第一个黑客)并制作这种方法使用
InternalSetLocation
(第二个黑客)。我还在这篇文章中解释了这两种技巧。然后我只需要将这样的单元添加到实现使用部分(在 gridpanel 声明之前)并调用我创建的方法......使用起来非常简单。
以下是我的做法,一步一步:
AddControlAtCell
而不是ExtCtrls.TControlCollection.AddControl
这是我为此类作业创建的单元,将其另存为
unitTGridPanel_WithAddControlAtCell
:我希望注释足够清晰,请阅读它们以了解我这样做的原因和方式。
然后,当我需要在指定单元格的网格面板中添加控件时,我会执行下一个简单的调用:
在特定单元格添加运行时新创建的 TCheckBox 的非常非常基本的示例可能如下所示:
请注意,我使用这两个 Hacks:
type THackControlItem
让我访问方法InternalSetLocation
。type TGridPanel=class(ExtCtrls.TGridPanel)
让我向ExtCtrls.TGridPanel
添加一个方法,甚至无需触摸(不需要ExtCtrls
的源代码)重要:另请注意,我提到需要将单元添加到要使用方法
AddControlAtCell
的每个表单的接口的使用中;这是针对普通人的,高级人员也可以创建另一个单元,等等...“概念”是在声明 GridPanel 之前使用该单元,您希望在其中使用它...例如:如果 GridPanel 是在设计时放在表单上...它必须继续实现此类表单单元的使用。希望这对其他人有帮助。
I use a quite different way to do the Job... Create a whole unit just to add a method to
ExtCtrls.TControlCollection
without touching unitExtCtrls
(first hack) and make such method useInternalSetLocation
(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:
AddControlAtCell
instead ofExtCtrls.TControlCollection.AddControl
Here is the unit i had created for such job, save it as
unitTGridPanel_WithAddControlAtCell
: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:
A very, very basic example of adding a runtime newly created TCheckBox at a specific cell could be like this:
Please Note that i use this two Hacks:
type THackControlItem
let me access the methodInternalSetLocation
.type TGridPanel=class(ExtCtrls.TGridPanel)
let me add a method toExtCtrls.TGridPanel
without even touching (neither needing source ofExtCtrls
)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.
下面的解决方案无需任何黑客攻击即可工作。
我的代码是在 C++ Builder 中,但我认为它对于 Delphi 用户来说很容易理解,因为它只依赖于 VCL 函数。
PS:请注意,我拖动的是 TPanels 而不是 TButtons(一个非常小的变化)。
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).