在程序运行时如何实现拖动、调整控件的大小,

zxtyhy 2003-01-07 11:19:08
在程序运行时如何实现拖动、调整控件的大小,
有控件吗?
zxtyhy@163.com
zhangxiaotong@chinajuli.com
(如果解决连同以前的200分一起送上)
...全文
237 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
hjb8000 2003-01-22
  • 打赏
  • 举报
回复
自己编,这个不太难!!就是麻烦点!!1
aiirii 2003-01-22
  • 打赏
  • 举报
回复
我的经验:我先是自己编,已经可用,但后来下载了别人的控件,发觉更好,但,当然,使用中还有些问题,要自己在根据自己的需要改进拉
zxtyhy 2003-01-18
  • 打赏
  • 举报
回复
to: cg1120(代码最优化-§雪是冷的,人是暖的§)

有第三方组件吗?
我的Email: zxtyhy@163.com
zhangXiangTong@chinajuli.com
Billy_Chen28 2003-01-07
  • 打赏
  • 举报
回复
第三方组件:HANDEL或Resizer
Billy_Chen28 2003-01-07
  • 打赏
  • 举报
回复
一段程序:
unit SizerControl;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TSizerControl = class(TCustomControl)
private
FControl: TControl;
FRectList: Array [1..8] of TRect;
FPosList: Array [1..8] of Integer;
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent; AControl: TControl);
procedure CreateParams(var Params: TCreateParams); override;
procedure Createhandle;override;
procedure WmNcHitTest(var Msg: TWmNcHitTest); message wm_NcHitTest;
procedure WmSize(var Msg:TWmSize); message wm_Size;
procedure WmLButtonDown(var Msg: TWmLButtonDown); message wm_LButtonDown;
procedure WmMove(var Msg: TWmMove); message Wm_Move;
procedure Paint; override;
procedure SizeControlExit(Sender: TObject);
{ Public declarations }
published
{ Published declarations }
end;
const
sc_DragMove: Longint = $F012;
procedure Register;
implementation
constructor TSizerControl.Create(AOwner: TComponent; AControl: TControl);
var
R: TRect;
begin
inherited Create(AOwner);
FControl := AControl;
OnExit := SizeControlExit;
R := FControl.BoundsRect;
InflateRect(R, 2, 2);
BoundsRect := R;
Parent := FControl.Parent;
FPosList[1] := htTopLeft;
FPosList[2] := htTop;
FPosList[3] := htTopRight;
FPosList[4] := htRight;
FPosList[5] := htBottomRight;
FPosList[6] := htBottom;
FPosList[7] := htBottomLeft;
FPosList[8] := htLeft;
end;
procedure TSizerControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
//增加透明特性
Params.ExStyle := Params.ExStyle
+ WS_EX_TRANSPARENT;
end;
procedure TSizerControl.Createhandle;
begin
inherited Createhandle;
SetFocus;
end;

procedure TSizerControl.WmNcHitTest(var Msg: TWmNcHitTest);
var
Pt: TPoint;
I: Integer;
begin
Pt := Point(Msg.XPos, Msg.YPos);
Pt := ScreenToClient(Pt);
Msg.Result := 0;
//检测鼠标位置并改变状态
for I := 1 to 8 do
if PtInRect(FRectList[I], Pt) then
Msg.Result := FPosList[I];
if Msg.Result = 0 then
inherited;
end;

procedure TSizerControl.WmSize(var Msg:TWmSize);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.BoundsRect := R;
//计算8个黑方框
FRectList[1] := Rect(0 ,0, 5, 5);
FRectList[2] := Rect(Width div 2 - 3, 0, Width div 2 + 2, 5);
FRectList[3] := Rect(Width - 5, 0, Width, 5);
FRectList[4] := Rect(Width - 5, height div 2 - 3, Width, Height div 2 + 2);
FRectList[5] := Rect(Width - 5, Height - 5, Width, Height);
FRectList[6] := Rect(Width div 2 - 3, Height - 5, Width div 2 + 2, Height);
FRectList[7] := Rect(0, Height -5, 5, Height);
FRectList[8] := Rect(0, Height div 2 - 3, 5, Height div 2 + 2);
end;


procedure TSizerControl.WmLButtonDown(var Msg: TWmLButtonDown);
begin
//执行拖动命令
Perform(Wm_SysCommand, sc_DragMove, 0);
end;

procedure TSizerControl.WmMove(var Msg: TWmMove);
var
R: TRect;
begin
R := BoundsRect;
InflateRect( R, -2, -2);
FControl.Invalidate;
FControl.BoundsRect := R;
end;
procedure TSizerControl.Paint;
var
I: Integer;
begin
Canvas.Brush.Color := clBlack;
for I := 1 to 8 do
with FRectList[I] do
Canvas.Rectangle (Left, Top, Right, Bottom);
end;

procedure TSizerControl.SizeControlExit(Sender: TObject);
begin
Free;
end;
procedure Register;
begin
RegisterNoicon([TSizerControl]);
end;

end
主窗口程序:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
btn: TButton;
GroupBox1: TGroupBox;
procedure btnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses SizerControl;

{$R *.DFM}

procedure TForm1.btnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
SizeControl: TSizerControl;
begin
SizeControl := TSizerControl.Create(self, btn);
end;

procedure TForm1.GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
SizeControl: TSizerControl;
begin
SizeControl := TSizerControl.Create(self, GroupBox1);
end;
end.
作用是在运行时刻自动对其它可视控件进行动态的位置/大小调整.这个控件实现的功能和VB.Net的窗体布局功能类似.比如你的窗体中有一个DBGrid控件,占了很大一部分,下边有几个按钮 现在需要窗体的大小可调,以使DBGrid可以看到更多的数据,这样的话,窗体上的控件就都需要调整,不然只有窗体变化,而控件不动的话就达不到预期效果,而且很难看.原来的方式是在窗口的Resize事件中添加调整控件大小/位置的代码,这样做的话比较麻烦,要自己手动去计算宽度/偏移,然后将这些代码写死在程序中,以后增加控件或者调整布局都需要重新计算/修改代码,不利于维护. 有了这个控件就方便多了,Resize事件中一行代码不用写,只需将这个控件拖动到窗体上,然后设置被调整控件的Tag属性,在运行时刻就可以进行调整了.VB6ResizerLib 2.0 版本新增分隔条控件,运行时可动态调整.同时修改了1.x版本中控件在退出程序前不会被释放及其导致的一系列问题.VB6ResizerLib 2.2 修正了2.0版本中使用DesignTimeInit模式的时候可能会导致VB崩溃的问题.使用说明:启动VB程序,打开一个工程.按Ctrl+T打开部件对话框.找到并选中VB6ResizerLib后点击确定.将工具箱中新出现的VB6Resizer控件拖动到窗体上即可.被调整控件需要使用Tag属性定义调整规则,方式如下:H-调整控件自身高度.W-调整空间自身宽度.T-调整控件与容器顶部距离.L-调整控件与容器左侧距离.例如―HW‖表示自动调整高度和宽度.TL的优先级高于HW,如果Tag同时包含T和H,则仅T有效.
控件是一种图形用户界面元素,用于在应用程序中提供用户交互功能。在图片查看或编辑的应用中,控件通常用于实现图片的各种操作,如放大、缩小和拖动等。 对于双指放大缩小图片的功能,用户可以通过在控件上同时用两个手指进行捏合或展开的手势操作,来实现对图片的缩放。这种操作方式直观且易于使用,使用户能够方便地调整图片的显示大小,以适应不同的查看需求。 而对于单指拖动图片的功能,用户则可以在控件上用一个手指按住图片并拖动,从而改变图片在屏幕上的位置。这种操作方式同样简单直观,使用户能够轻松地移动图片,以便更好地查看或编辑图片中的特定部分。 通过这些控件功能,用户可以更加灵活地操作图片,提高图片查看和编辑的效率,同时也提升了用户体验。 计算机设计 - 控件以及双指放大缩小图片、单指拖动图片,保证可靠运行,计算机专业可参考,免费资源下载! 计算机设计 - 控件以及双指放大缩小图片、单指拖动图片,保证可靠运行,计算机专业可参考,免费资源下载! 计算机设计 - 控件以及双指放大缩小图片、单指拖动图片,保证可靠运行,计算机专业可参考,免费资源下载!

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧