求运行期可改变控件大小、位置的源码（想QQ截图的那样） ( 积分: 100 )

周边有8个点可改变大小（最好拉的点是一个小矩形，中空），要求要平滑（不能鼠标按住点拖拉放开后才显示改变的大小），我在大富翁找了很久也找了好几个例子，但都不能满足我的要求，要拉的时候就能看见改变的大小不要等放开，delphi窗体设计器的那个也不合要求，要源码，控件也行（那个delphiDesigner也不符合要求），至于闪烁可以用双缓冲比较不要紧。具体请参考QQ的截图程序，说实在的QQ截图这方面做得很好！

周边有8个点可改变大小（最好拉的点是一个小矩形，中空），要求要平滑（不能鼠标按住点拖拉放开后才显示改变的大小），我在大富翁找了很久也找了好几个例子，但都不能满足我的要求，要拉的时候就能看见改变的大小不要等放开，delphi窗体设计器的那个也不合要求，要源码，控件也行（那个delphiDesigner也不符合要求），至于闪烁可以用双缓冲比较不要紧。具体请参考QQ的截图程序，说实在的QQ截图这方面做得很好！

是用句柄吧！

我要用image哪来的句柄

估计不行。。。
我在做视频监控时。。。
要调用API，，，做

加我QQ： 46810878
给你一份！！

很遗憾告诉你这个我早就有了，我见过的也就这个做得比较好，但就是拖动的时候，刷新慢会产生很多小点，所以才要找更好的，还有就是你发到我邮箱的压缩文件不完全或是因为网络传输坏了，我下载了两次都解压到一半出错，我还是看到UDragPoint.pas，比较代码才知道和我的一样。

我以前在网上看到有一个叫做啥热点控件（里面有个Hot）的，你可以在网上找找

LMD控件组可以实现的。但动态设置事件比较有难度。
可以参考
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3140347

Delphi盒子上就有你要的
http://www.2ccc.com/article.asp?articleid=2334
http://www.2ccc.com/article.asp?articleid=2865
还有我说的那个啥Hot类的控件

和AJ的一样，继续期待
————————————————
写几个字就说我灌水，我***

什么hot类，名称给不全找不到

帮顶

看看这个行不行:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2973982

怎么用啊？也不说明一下

原来是这样
aa:=TCustomImageEx.Create(self);
aa.Parent:=self;
aa.SetBounds(5,5,100,100);
aa.show;
试了半天还以为是粘在在其他控件上的，不过问题多多啊，
比如：右下点移到左上点，就移不下来了，还有要拖很长距离才移动，再就是不合我的要求（拉动的时候会产生虚筐，我要的是平滑），不过这个总体还是比较好的

可以任意拖动,没有问题的,还有要拖很长距离才移动这是因为我在procedure TCustomImageEx.WMLButtonUp(var Message: TWMLButtonUp);消息中,进行了网格对齐的视觉效果的处理,你可以去掉这段代码:
procedure TCustomImageEx.WMLButtonUp(var Message: TWMLButtonUp);
var
iLeft, iTop: Integer;
I: Integer;
begin
inherited;

//网格对齐的视觉效果
iLeft := Left mod Width;
if iLeft < Width div 2 then
Left := Left div Width * Width
else
Left := Left div Width * Width + Width;

iTop := Top mod Height;
if iTop < Height div 2 then
Top := Top div Height * Height
else
Top := Top div Height * Height + Height;

for I := 0 to FLine.Count - 1 do
SendMessage(TPuckerLineEx(FLine.Items).Handle,
WM_WINCONTROLUP, 0, 0);
end;

这是我的测试工程,使用TScrollBox作为Parent:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons, ImgList, ExtCtrls, ImageEx, DB,
ADODB, RbsWiredEdit, ToolWin;

type
TImageExDemo = class(TForm)
ImgLstBea: TImageList;
Splitter: TSplitter;
ScrollBox: TScrollBox;
Panel1: TPanel;
ListBox: TListBox;
Panel2: TPanel;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
chkVisible: TCheckBox;
chkReadOnly: TCheckBox;
StatusBar: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListBoxClick(Sender: TObject);
procedure chkVisibleClick(Sender: TObject);
procedure chkReadOnlyClick(Sender: TObject);
private
{ Private declarations }
CustomImageEx : array of TCustomImageEx;
PuckerLineEx: array of TPuckerLineEx;
IsClick: Boolean;

procedure ImageExOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ImageExOnEnter(Sender: TObject);
procedure ImageExOnExit(Sender: TObject);
procedure ImageExOnDblClick(Sender: TObject);
procedure ImageExOnMove(Sender: TObject; X, Y: Integer);

public
{ Public declarations }
end;

var
ImageExDemo: TImageExDemo;

implementation

{$R *.dfm}

procedure TImageExDemo.FormCreate(Sender: TObject);
var
I : Integer;
begin
IsClick := False;

SetLength(CustomImageEx, ListBox.Items.Count);

for I := low(CustomImageEx) to high(CustomImageEx) do
begin
CustomImageEx := TCustomImageEx.Create(Self);
CustomImageEx.Parent := ScrollBox;
CustomImageEx.SetBounds(10, 50 * I, 100, 100);
CustomImageEx.Images := ImgLstBea;
CustomImageEx.ImageDefaultIndex := 0;
CustomImageEx.ImageActivateIndex := 1;
CustomImageEx.Transparent := true;
CustomImageEx.Stretch := true;
CustomImageEx.AutoSize := true;
CustomImageEx.Text := ListBox.Items.Strings;
CustomImageEx.Font.Color := clBlue;
//CustomImageEx.ReadOnly := True;
CustomImageEx.OnMouseMove := ImageExOnMouseMove;
CustomImageEx.OnEnter := ImageExOnEnter;
CustomImageEx.OnExit := ImageExOnExit;
CustomImageEx.OnDblClick := ImageExOnDblClick;
CustomImageEx.OnMove := ImageExOnMove;
CustomImageEx.Show;
end;

end;

procedure TImageExDemo.FormClose(Sender: TObject; var Action: TCloseAction);
var
I : Integer;
begin
for I := low(CustomImageEx) to high(CustomImageEx) do
FreeAndNil(CustomImageEx);

for I := low(PuckerLineEx) to high(PuckerLineEx) do
if Assigned(PuckerLineEx) then
FreeAndNil(PuckerLineEx);
end;

procedure TImageExDemo.ImageExOnMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
//labX.Caption := 'X: ' + IntToStr(X);
//labY.Caption := 'Y: ' + IntToStr(Y);
end;

procedure TImageExDemo.ListBoxClick(Sender: TObject);
begin
CustomImageEx[ListBox.ItemIndex].SetFocus;
end;

procedure TImageExDemo.ImageExOnEnter(Sender: TObject);
var
I : Integer;
begin
for I := low(CustomImageEx) to high(CustomImageEx) do
if CustomImageEx.Focused then
CustomImageEx.Font.Color := clRed;

StatusBar.Panels.Items[0].Text := '与之关联的线条数量：'
+ IntToStr((Sender as TCustomImageEx).LineCount);
end;

procedure TImageExDemo.ImageExOnExit(Sender: TObject);
var
I : Integer;
begin
for I := low(CustomImageEx) to high(CustomImageEx) do
if not CustomImageEx.Focused then
CustomImageEx.Font.Color := clBlue;
end;

procedure TImageExDemo.ImageExOnDblClick(Sender: TObject);
begin
IsClick := not IsClick;

if IsClick then
begin
SetLength(PuckerLineEx, High(PuckerLineEx) + 2);
PuckerLineEx[High(PuckerLineEx)] := TPuckerLineEx.Create(Self);
PuckerLineEx[High(PuckerLineEx)].Parent := ScrollBox;
PuckerLineEx[High(PuckerLineEx)].BeginBit := (Sender as TCustomImageEx);
(Sender as TCustomImageEx).Line.Add(Pointer(PuckerLineEx[High(PuckerLineEx)]));
end else
begin
PuckerLineEx[High(PuckerLineEx)].EndBit := (Sender as TCustomImageEx);
(Sender as TCustomImageEx).Line.Add(Pointer(PuckerLineEx[High(PuckerLineEx)]));
if Assigned(PuckerLineEx[High(PuckerLineEx)]) then
begin
PuckerLineEx[High(PuckerLineEx)].Show;
end;
end;
end;

procedure TImageExDemo.ImageExOnMove(Sender: TObject; X, Y: Integer);
begin

end;

procedure TImageExDemo.chkVisibleClick(Sender: TObject);
var
I: Integer;
begin
for I := Low(PuckerLineEx) to High(PuckerLineEx) do
PuckerLineEx.Visible := chkVisible.Checked;
end;

procedure TImageExDemo.chkReadOnlyClick(Sender: TObject);
var
I: Integer;
begin
for I := Low(PuckerLineEx) to High(PuckerLineEx) do
PuckerLineEx.ReadOnly := not chkReadOnly.Checked;
end;

end.

www.2ccc.com 有实现这个功能的控件~!!

给你吧。给分啦。

//==============================================================================
//任意摆布一个控件（拖动、放大、缩小）******************************************
//==============================================================================
procedure ManipulateControl(Control: TControl; Shift: TShiftState; X, Y, Precision: integer);
var SC_MANIPULATE: Word;
begin
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最左侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if (X<=Precision) and (Y>Precision) and (Y<Control.Height-Precision)
then begin
SC_MANIPULATE := $F001;
Control.Cursor := crSizeWE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最右侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>=Control.Width-Precision) and (Y>Precision) and (Y<Control.Height-Precision)
then begin
SC_MANIPULATE := $F002;
Control.Cursor := crSizeWE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最上侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>Precision) and (X<Control.Width-Precision) and (Y<=Precision)
then begin
SC_MANIPULATE := $F003;
Control.Cursor := crSizeNS;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的左上角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X<=Precision) and (Y<=Precision)
then begin
SC_MANIPULATE := $F004;
Control.Cursor := crSizeNWSE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的右上角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>=Control.Width-Precision) and (Y<=Precision)
then begin
SC_MANIPULATE := $F005;
Control.Cursor := crSizeNESW ;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的最下侧**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>Precision) and (X<Control.Width-Precision) and (Y>=Control.Height-Precision)
then begin
SC_MANIPULATE := $F006;
Control.Cursor := crSizeNS;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的左下角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X<=Precision) and (Y>=Control.Height-Precision)
then begin
SC_MANIPULATE := $F007;
Control.Cursor := crSizeNESW;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的右下角**********************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>=Control.Width-Precision) and (Y>=Control.Height-Precision)
then begin
SC_MANIPULATE := $F008;
Control.Cursor := crSizeNWSE;
end
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//光标在控件的客户区（移动整个控件）******************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
else if (X>5) and (Y>5) and (X<Control.Width-5) and (Y<Control.Height-5)
then begin
SC_MANIPULATE := $F009;
Control.Cursor := crSizeAll;
end
else begin
SC_MANIPULATE := $F000;
Control.Cursor := crDefault;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if Shift=[ssLeft] then
begin
ReleaseCapture;
Control.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);
end;
end;



ｅｘａｍｐｌｅ：

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm_Main.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
Caption := IntToStr(X) + '/' + IntToStr(Y);
ManipulateControl((Sender as TControl), Shift, X, Y, 10);
end;


10为精度

to:寻路
能不能拖动的时候就改变大小，而不要有那个虚筐放开时才改变
to:hzjone
这个我很早就有了，你有没有看三楼我的注释啊