鼠标要放在控件内边框
总体思路：
一种采用TShape控件，产生一个比控件大写的tshape控件，拖动控件和改变大小的过程
其实是拖动和改变tshape，当触发tshape的mouseup的事件时，再改变控件，可适用与任何
控件。.
另一种:只需将其他控件的mousedowm,mousemove,mouseup事件指向button1的相应事件
1：选定控件后，才可拖动控件；
2：采用api在屏幕上画，当用户将黑框往控件内部拉动时，边线才不会被控件遮住，
3：拖动黑框时，采用xor；
4：框边的黑点可以画成delphi的形式，只需调整一下数据
5：以下代码不适应于combobox, listbox控件，要实现所有的控件拖动还是要采用消息和多线程
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, jpeg, ExtCtrls, AppEvnts;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Image1: TImage;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
ApplicationEvents1: TApplicationEvents;
Edit1: TEdit;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
Procedure APIDrawFrame(P1,P2:TPoint);
Procedure ClearFrame;{消除画点}
Procedure DrawFrame; {描绘画点}
Procedure SaveScreen(FramePoint:tPoint;Count:integer);
Procedure LoadScreen(FramePoint:TPoint;Count:integer);
procedure DrawRectangle(M,N:integer);
end;
var
Form1: TForm1;
OperKind:integer=0; //0:拖动1:改变大小
Drag:Boolean=False; //触发控件拖动或改变大小的判断标记
DrawControl:TControl;//触发拖动的控件
Bmp:Array [0..7] of TBitMap;
Draging:Boolean; //控件处于拖动状态
{控件拖动变量}
oldx1,oldy1,oldx2,oldy2:integer;
CanvaRect:TRect;//旧画布
NewRect:TRect;//新画布坐标
ClearTheFrame:Boolean=False;
FrameLeft,FrameTop,FrameRight,FrameBottom:integer;
{改变控件大小变量}
ConfirmArray:array[0..3,0..2] of Integer;//存储光标位置判断的区域
//ConfirmArray[0,j]:左边,ConfirmArray[1,j]x:右边,ConfirmArray[2,j]:顶部;
//ConfirmArray[3,j]:底部
HalfHeight,HalfWidth:Integer;
NeedConfirm:Boolean=True;
tP1,tP2:TPoint;//画新方框的点
vP1,vP2:TPoint;//画旧方框的点
DragKindOf:integer;//拖动的类型 1:控件的左边;2:控件的右边;3:控件的头部;4:控件的底部;
{键盘微调}
implementation
{$R *.DFM}
//画方块
procedure TForm1.DrawRectangle(M,N:integer);
begin
with canvas do
begin
// Canvas.pen.Mode:=pmCopy;
form1.DoubleBuffered:=True;
pen.Color:=clBlack;
brush.style:=bsSolid;
brush.Color:=clBlack;
RectAngle(M-2,N-2,M+2,N+2);
end;
end;
{截屏}
Procedure TForm1.SaveScreen(FramePoint:TPoint;Count:Integer);
//Function TForm1.SaveScreen(Bmp:array of TBitmap;FramePoint:TPoint;Count:Integer);
var
TempPoint:TPoint;
Dc: HDC;
begin
TempPoint.x:=FramePoint.x-2; //源设备场景
TempPoint.y:=FramePoint.y-2;
Bmp[Count]:= TBitMap.Create; //创建，设置其大小,目标设备场景
Dc:=GetDc(0);
bmp[count].Width:=4;
bmp[Count].Height:=4;
BitBlt(Bmp[Count].Canvas.Handle,0,0,100,100,Dc,TempPoint.x,TempPoint.y,SRCCOPY);
ReleaseDc(0,Dc); //释放DC资源
end;
Procedure TForm1.LoadScreen(FramePoint:TPoint;Count:integer);
var
TempPoint:TPoint;
Dc: HDC;
begin
TempPoint.x:=FramePoint.x-2;
TempPoint.y:=FramePoint.y-2;
Dc:=GetDc(0);
BitBlt(Dc,TempPoint.x,TempPoint.y,4,4,Bmp[Count].Canvas.Handle,0,0, SRCCOPY);
ReleaseDc(0,Dc);
Bmp[Count].free;
end;
Procedure TForm1.APIDrawFrame(P1,P2:TPoint);
var
a:LOGBRUSH;
TempHandle:Integer;
OldHandle,OldHandle1:Integer;
K:hdc;
BrushHandle:Integer;
begin
a.lbStyle:=bs_null;
TempHandle:=CreatePen(PS_SOLID,1,rgb(255,255,255));
k:=GetDc(0);
brushhandle:=CreateBrushIndirect(a);
OldHandle1:=SelectObject(k,brushhandle);
OldHandle:=SelectObject(k,TempHandle);
setrop2(k,R2_XORPEN);
Rectangle(k,P1.x-1,P1.y-1,P2.x+1,P2.y+1);
selectobject(k,oldhandle);
selectObject(k,OldHandle1);
DeleteObject(temphandle);
DeleteObject(brushhandle);
ReleaseDc(0,k);
end;
Procedure TForm1.ClearFrame; {消除画点}
var
i,J,Count:integer;
TempPoint:TPoint;
begin
if ClearTheFrame then
begin
Count:=0;
J:=FrameTop;
I:=FrameLeft;
//清除方框
//顶部
While I<=FrameRight do
begin
TempPoint.x:=i;
tempPoint.y:=j;
tempPoint:=ClientToScreen(TempPoint);
LoadScreen(tempPoint,Count);
I:=I+Trunc((FrameRight-FrameLeft)/2);
Inc(Count);
end;
//中部
J:=FrameTop+Trunc((FrameBottom-FrameTop)/2);
I:=FrameLeft;
While I<=FrameRight do
begin
TempPoint.x:=i;
tempPoint.y:=j;
tempPoint:=ClientToScreen(TempPoint);
LoadScreen(tempPoint,Count);
I:=I+FrameRight-FrameLeft;
Inc(Count);
end;
//底部
J:=FrameBottom;
I:=FrameLeft;
While I<=FrameRight do
begin
TempPoint.x:=i;
tempPoint.y:=j;
tempPoint:=ClientToScreen(TempPoint);
LoadScreen(tempPoint,Count);
I:=I+Trunc((FrameRight-FrameLeft)/2);
Inc(Count);
end;
end;
end;
Procedure TForm1.DrawFrame; {画点}
var
Count,I,j:integer;
TempPoint:TPoint;
begin
//Top
Count:=0;
J:=DrawControl.Top-2;
I:=DrawControl.Left-2;
While I<=DrawControl.Left+DrawControl.Width+2 do
begin
//截屏
TempPoint.x:=i;
tempPoint.y:=j;
tempPoint:=ClientToScreen(TempPoint);
SaveScreen(TempPoint,Count);
//画点
DrawRectAngle(I,J);
I:=I+(DrawControl.width+4) Div 2;
Inc(Count);
end;
//Hight Center
J:=DrawControl.Top-2+(DrawControl.Height+4) Div 2;
I:=DrawControl.Left-2;
While I<=DrawControl.Left+DrawControl.Width+2 do
begin
TempPoint.x:=i;
tempPoint.y:=j;
tempPoint:=ClientToScreen(TempPoint);
SaveScreen(TempPoint,Count);
DrawRectAngle(I,J);
I:=I+DrawControl.width+4;
Inc(Count);
end;
//Bottom
J:=DrawControl.Top+DrawControl.Height+2;
I:=DrawControl.Left-2;
While I<=DrawControl.Left+DrawControl.Width+2 do
begin
TempPoint.x:=i;
tempPoint.y:=j;
tempPoint:=ClientToScreen(TempPoint);
SaveScreen(TempPoint,Count);
DrawRectAngle(I,J);
I:=I+(DrawControl.width+4) Div 2;
Inc(Count);
end;
end;
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
TempControl:TControl;
TempRect:TRect;
begin
label4.Caption := 'MouseDown,清除画点';
TempControl:=(Sender As TControl);
TempControl.ShowHint:=True;
TempControl.Hint:=inttostr(TempControl.left)+','+inttostr(TempControl.Top);
{与拖动相关}
//清除画点
ClearFrame;
drag:=true;
//画框
TempRect.Left:=TempControl.Left;
TempRect.Top:=TempControl.Top;
TempRect.Right:=TempControl.left+TempControl.width;
TempRect.bottom:=TempControl.Top+TempControl.Height;
CanvaRect:=TempRect;
vP1.x:=CanvaRect.Left;
vP1.y:=CanvaRect.Top;
vP2.x:=CanvaRect.Right;
vP2.y:=CanvaRect.Bottom;
vp1:=clienttoscreen(vp1);
vp2:=clienttoscreen(vp2);
//记录鼠标数据与画布的各个点的距离
oldx1:=x;
oldy1:=y;
oldx2:=(Sender As TControl).width-x;
oldy2:=(Sender As TControl).height-y;
APIDrawFrame(ClientToScreen(TempRect.TopLeft),ClientToScreen(TempRect.BottomRight));
{改变控件大小相关}
DrawControl:=(Sender As TControl);
halfHeight:=DrawControl.Top+(DrawControl.Height) Div 2;
halfWidth:=DrawControl.Left+(DrawControl.Width) Div 2;
//存储光标位置判断的区域
ConfirmArray[0,0]:=DrawControl.Left+4;
ConfirmArray[0,1]:=halfHeight-4;
ConfirmArray[0,2]:=halfHeight+4;
ConfirmArray[1,0]:=DrawControl.Left+DrawControl.Width-4;
ConfirmArray[1,1]:=halfHeight-4;
ConfirmArray[1,2]:=halfHeight+4;
ConfirmArray[2,0]:=DrawControl.Top+4;
ConfirmArray[2,1]:=halfWidth-4;
ConfirmArray[2,2]:=halfWidth+4;
ConfirmArray[3,0]:=DrawControl.Top+DrawControl.Height-4;
ConfirmArray[3,1]:=halfWidth-4;
ConfirmArray[3,2]:=halfWidth+4;
end;
procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
CursorPosition:TPoint;//判断位置的点
begin
CursorPosition:=ScreentoClient(Mouse.CursorPos);
//新画布的坐标
if Drag=True then
begin
if ( CursorPosition.x>=CanvaRect.Left+3) and (CursorPosition.x<CanvaRect.Right-3)
and (CursorPosition.y>CanvaRect.Top+3)and (CursorPosition.y<CanvaRect.Bottom-3) and
(OperKind=0) then
begin {拖动控件}
Screen.Cursor:=crDefault;
if (ssLeft In Shift) Then
begin
newRect.Left:=CursorPosition.x-Oldx1;
newRect.Top:=CursorPosition.y-oldy1;
newRect.Right:=oldx2+CursorPosition.x;
newRect.Bottom:=oldy2+CursorPosition.y;
ApiDrawFrame(ClientToScreen(CanvaRect.TopLeft),ClientToScreen(CanvaRect.BottomRight));
DrawControl.Repaint;
ApiDrawFrame(ClientToScreen(newRect.TopLeft),ClientToScreen(newRect.BottomRight));
//旧画布坐标
CanvaRect:=NewRect;
OperKind:=0;
end;
end
else begin {改变控件的大小}
if not Draging then
begin
if NeedConfirm then
begin
if (CursorPosition.x<ConfirmArray[0,0]) and (CursorPosition.y>ConfirmArray[0,1])
and (CursorPosition.y<ConfirmArray[0,2]) Then
begin {控件的左边}
Screen.Cursor:=crSizeWE;
DragKindOf:=1;
end
else begin
if (CursorPosition.x>ConfirmArray[1,0]) and (CursorPosition.y>ConfirmArray[1,1])
and (CursorPosition.y<ConfirmArray[1,2]) Then
begin {控件的右边}
Screen.Cursor:=crSizeWE;
DragKindOf:=2;
end
else begin
if (CursorPosition.y<ConfirmArray[2,0]) and (CursorPosition.x>ConfirmArray[2,1])
and (CursorPosition.x<ConfirmArray[2,2]) Then
begin {控件的顶部}
Screen.Cursor:=crSizeNS;
DragKindOf:=3;
end
else begin
if (CursorPosition.y>ConfirmArray[3,0]) and (CursorPosition.x>ConfirmArray[3,1])
and (CursorPosition.x<ConfirmArray[3,2]) then
begin {控件的底部}
Screen.Cursor:=crSizeNS;
DragKindOf:=4;
end
else
Screen.Cursor:=crDefault;
end;
end;
end;
if (DragKindOf>0) and (DragKindOf<5) then
begin
if (ssLeft In Shift) then
begin
NeedConfirm:=False;
OperKind:=1;
end;
end;
end
else begin
tP1.x:=DrawControl.Left;;
tP1.y:=(DrawControl.Top);
tP2.x:=(DrawControl.left+DrawControl.Width);
tP2.y:=(DrawControl.Top+DrawControl.Height);
Case DragKindOf Of
1: begin //left
tP1.X:=ScreenToClient(Mouse.CursorPos).x;
end;
2: begin //right
tP2.X:=ScreenToClient(Mouse.CursorPos).x;
end;
3: begin //top
tP1.Y:=ScreenToClient(Mouse.CursorPos).Y;
end;
4: begin //bottom
tP2.Y:=ScreenToClient(Mouse.CursorPos).Y;
end;
end;
//Tp1 lefttop //vP1
//tp2 rightbottom //vP1
tP1:=ClientToScreen(tP1);
tP2:=ClientToScreen(tP2);
if Not(NeedConfirm) and (ssLeft In Shift) then
begin
APIDrawFrame(vP1,vP2); //消除旧方框
DrawControl.Repaint;
Application.ProcessMessages;
APIDrawFrame(tP1,tP2); //画新的方框
vP1:=tP1;
vP2:=tP2;
end;
end;
end;
end;
end;
end;
procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
TempControl:TControl;
begin
label4.Caption:= 'MouseUp,画点';
Screen.Cursor:=crDefault;
TempControl:=(Sender As TControl);
if OperKind=0 then
begin
//消除边框
APIDrawFrame(ClientToScreen(CanvaRect.TopLeft),ClientToScreen(CanvaRect.BottomRight));
Tempcontrol.Repaint;
//移动控件
TempControl.Left:=CanvaRect.Left;
TempControl.top:=CanvaRect.Top;
TempControl.Width:=CanvaRect.Right-CanvaRect.Left;
TempControl.Height:=CanvaRect.Bottom-CanvaRect.Top;
end
else begin
if OperKind=1 then
begin
APIDrawFrame(vP1,vP2);
TempControl.Left:=ScreenToClient(vP1).x;
TempControl.Top:=ScreenToClient(vP1).y;
TempControl.Width:=ScreenToClient(vP2).x-ScreenToClient(vP1).x;
TempControl.Height:=ScreenToClient(vP2).y-ScreenToClient(vP1).y;
NeedConfirm:=true;
end;
end;
Application.ProcessMessages;
{描绘画点}
DrawFrame;
{记录画点的位置}
FrameLeft:=(Sender As TControl).Left-2;
FrameTop:=(Sender As TControl).Top-2;
FrameRight:=(Sender As TControl).Left+(Sender As TControl).Width+2;
FrameBottom:=(Sender As TControl).Top+(Sender As TControl).Height+2;
ClearTheFrame:=True;
halfHeight:=DrawControl.Top+(DrawControl.Height) Div 2;
halfWidth:=DrawControl.Left+(DrawControl.Width) Div 2;
//存储光标位置判断的区域
ConfirmArray[0,0]:=DrawControl.Left+3;
ConfirmArray[0,1]:=halfHeight-3;
ConfirmArray[0,2]:=halfHeight+3;
ConfirmArray[1,0]:=DrawControl.Left+DrawControl.Width-3;
ConfirmArray[1,1]:=halfHeight-3;
ConfirmArray[1,2]:=halfHeight+3;
ConfirmArray[2,0]:=DrawControl.Top+3;
ConfirmArray[2,1]:=halfWidth-3;
ConfirmArray[2,2]:=halfWidth+3;
ConfirmArray[3,0]:=DrawControl.Top+DrawControl.Height-3;
ConfirmArray[3,1]:=halfWidth-3;
ConfirmArray[3,2]:=halfWidth+3;
operKind:=0;
Draging:=False;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
screen.Cursor:=crDefault;
end;
