画图时候，拖动虚框怎么处理？ (100分)

一个控件拖拉，拖动中虚框大小随着鼠标而变，到释放后就是其最终尺寸。

怎么处理onMouseMove事件及其相关处理？

上下左右移动，上下左右外扩，上下左右内收

我也想要
帮你顶

我也曾经研究过，最后没办法，用了个特别笨的方法，效果也不好：
你的需要拖动的肯定都在一个容器里面吧，我用的是Panel，自己继承写的
TMyPanel.Canvas.DrawFocusRect
但外框都是随着控件走的

>hongxing_dl

是的哦，请仔细一点说。。。

再问一下，怎么加这个问题的分数？

昨天下班后写了个这样的控件 kangkangto@sunlight.bz

{
在窗体中创建
TDragShadow.Create(self).DragCtl := 控件名 //要想拖的控件
}
unit DragShadow;

interface

uses
Controls, Messages, Classes, Dialogs, windows, ExtCtrls, SysUtils,
Graphics, Forms;

type
TParent = class(TCustomControl)
end;

TDragShadow = class(TControl)
private
fDragCtl : TWinControl;
fPreCtlWndProc : Pointer;

procedure SetDragCtl(ADragCtl : TWinControl);
procedure NewCtlWndProc(var Msg : TMessage);
//procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
protected

public
constructor Create(AComponent : TComponent); override;
property DragCtl : TWinControl read fDragCtl write SetDragCtl;
end;

implementation

{ TDragShadow }

constructor TDragShadow.Create;
begin
inherited;
Width := 1;
Height := 1;

if csDesigning in ComponentState then
begin

end else
begin

end;
end;

procedure TDragShadow.NewCtlWndProc(var Msg: TMessage);
const
{$J+}
PreX : integer=0;
PreY : integer=0;
fDragPrepared : Boolean=False;
{$J-}
var
cvs : TCanvas;
oldPen : TPen;
TagLeft , TagTop : integer;
rc : TRect;
begin
if Msg.Msg = WM_LButtonUp then
begin
if fDragPrepared = True then
begin
fDragCtl.Left := Left;
fDragCtl.Top := Top;
Parent.Invalidate;
ClipCursor(0);
end;
fDragPrepared := False;
end else if Msg.Msg = WM_MouseMove then
//end else if Msg.Msg = WM_MouseLeave then
//end else if Msg.Msg = WM_MOUSEHOVER then
//end else if Msg.Msg = WM_MOUSEFIRST then
begin
if TWMMouse(Msg).Keys = MK_LBUTTON then
begin
if fDragPrepared = True then
begin
if Parent is TForm then
begin
TForm(Parent).Repaint;
cvs := TForm(Parent).Canvas;
end else
begin
TParent(Parent).Repaint;
cvs := TParent(Parent).Canvas;
end;

TagLeft := Left - PreX + TWMMouse(Msg).XPos;
TagTop := Top - PreY + TWMMouse(Msg).YPos;

if (TagLeft > -(Width div 3)) and
(TagLeft < (Parent.Width - Width div 3)) then Left := TagLeft;
if (TagTop > -(Height div 3)) and
(TagTop < (Parent.Height - Height div 3)) then Top := TagTop;

oldPen := TPen.Create;
try
oldPen.Assign(cvs.Pen);
cvs.Pen.Color := clBlack;
//cvs.Pen.Width := 2;
cvs.Rectangle(BoundsRect);
cvs.Pen.Assign(oldPen);
finally
FreeAndNil(oldPen);
end;
PreX := TWMMouse(Msg).XPos;
PreY := TWMMouse(Msg).YPos;
end else
//fDragPrepared = False 第一次拖动，设置初始值
begin
fDragPrepared := True;
Left := fDragCtl.Left;
Top := fDragCtl.Top;
PreX := TWMMouse(Msg).XPos;
PreY := TWMMouse(Msg).YPos;
rc := Parent.ClientRect;
MapWindowPoints(Parent.Handle, 0, rc, 2);
ClipCursor(@rc);
//BringToFront;
//fDragCtl.BringToFront;
end;
end;
end;

Msg.Result := CallWindowProc(fPreCtlWndProc, fDragCtl.Handle,
Msg.Msg, Msg.WParam, Msg.LParam);
end;


procedure TDragShadow.SetDragCtl(ADragCtl : TWinControl);
var
p : Pointer;
begin
fDragCtl := ADragCtl;
Parent := fDragCtl.Parent;
Width := fDragCtl.Width;
Height := fDragCtl.Height;
Hide;
fPreCtlWndProc := Pointer(GetWindowLong(fDragCtl.Handle, GWL_WNDPROC));

p := MakeObjectInstance(NewCtlWndProc);

SetWindowLong(fDragCtl.Handle, GWL_WNDPROC, LongInt(p));

end;


end.

>baseyueliang

好像不灵哦
我是stringgrid做容器，panel做拖拉块的，空白处拖拉则创建一块
请再多多指导一下

stringgrid 能作为控件容器吗，这倒不大清楚了，反正我用Form和panel做容器可行的
（只实现了移动位置，而没有实现尺寸大小变化，道理差不多的，多加一下边界判断）

原来是容器不可行？但是我这里的确要用到，因为要处理行列，用panel不太方便，做控件,form就更不行了.
除了虚线框，其他倒都实现得差不多了
再帮个忙？

呵呵，也许我误解了你想要什么了

估计你的stringgrid 覆盖了你拖拉块Panel.Parent了，所以我在Parent画出的虚诓看不见了

非得用stringgrid话，我觉得画虚诓是不行了，画实诓吧，呵呵

在TPanel的基础上继承一个TMyPanel，目的是多一个Canvas属性，以便引用Canvas.DrawFocusRect！
这些需要拖动的控件的坐标你应该是知道的……(例如：Label)
procedure TForm1.DrawFocus;
var
ARect:TRect;
lTop,lLeft,lWidth,lHeight:Integer;
begin
MyPanel.Repaint;
lTop:=Label.Top;
lLeft:=Label.Left;
lWidth:=Label.Width;
lHeight:=Label.Height;
ARect:=Rect(lLeft-1,lTop-1,lLeft+lWidth+1,lTop+lHeight+1);
MyPanel.Canvas.DrawFocusRect(ARect);
end;

看了stringgrid,其实他也有Canvas的，所以我前面认为画不出虚诓是错误的，只要在我上面的代码中更改canvas和相对应的坐标就可搞定了

多人接受答案了。