让 Anchor 属性拥有设计时行为

最新推荐文章于 2023-06-26 22:23:49 发布

都市夜猫

最新推荐文章于 2023-06-26 22:23:49 发布

阅读量2k

点赞数 3

分类专栏： VFP9 文章标签： vfp anchor

本文链接：https://blog.csdn.net/dkfdtf/article/details/54799861

版权

VFP9 专栏收录该内容

16 篇文章 7 订阅

订阅专栏

用过 vfp9 的人都知道这个好用的新属性，宿主控件大小变化时，其内部控件可以用这个属性来自动调整它们的位置和大小，不用再像 vfp6 中要写代码来调整；不过，大家也看到了，这个属性只是一个运行时行为，设计时是不起作用的。

趁着春节休息，想试试是否有办法，能使这个属性在设计时也起作用。这就想起以前有老外写过的一个，设计时可以让内部控件随容器自动调整的示例，网上是找不到了，幸运的是还有咱们万能的百事通 xinjie，要来了这个示例。

研究了半天得出以下结论：

1. 任意控件的某个属性，如果其值是一个表达式（例如：=myfunc() ），vfp 在打开前都会先计算其值；这就给控件设计者一个干涉的机会！（重要：如果这个表达式无法计算（例如：函数不存在或者找不到），vfp 不会报错，仅简单的忽略它），所以，要想达到目的，这个函数必须在 curdir() 指向的路径上，或者 vfp 可以成功调用到这个函数，才会起作用

2. 这个表达式函数可以使用 This 将控件对象传递到表达式指向的函数中，这也是要达到目的的充要条件之一，注意这个 This 指向的对象是在设计时，而非运行时

做以下试验来验证：

1. 新建一个项目
2. 粘贴下列代码并保存为 test.prg

Lparameters toCtrl

m.toCtrl.Caption = Sys(2015)
Return Rgb(255, 0, 0)

3. 再新建一表单，将 BackColor 属性改成 = test(This)

表单背景色和标题是否变了?

什么！没变 ???

那就对了，因为没找到 test.prg

先关闭表单 ...

在命令窗口中键入 set deafult to ?

回车，找到你刚才保存 test.prg 所在的文件夹

重新打开表单

要是你还是没发现有变化，下面的内容可以不用看了 ...

如果你幸运的看到类似下面的样子，恭喜你！可以继续

（图一）

这个实验验证了上面的两点：

1. test.prg 必须在当前路径上

2. = test(This) 中的 This 传递给了 test 函数的 toCtrl 参数，它成功的用 toCtrl.Caption = sys(2015) 改变了表单的 Caption

做一个实用的工具

既然可以传入对象，那么就可以获取和设置对象的属性。本文开始时指出，vfp 控件的 anchor 属性仅在运行时才起作用，设计时时这样的：

（图二）

我们把它拖到一个新建的表上，一开始是这样：

（图三）

当我们将这个容器拉大后，仅容器变大了，里面的按钮并未按 anchor 属性设置的值那样自动调整到右下角：

（图四）

我们希望的 anchor 设计时行为，其结果应该是这样：

（图五）

现在，我们来添加一些代码，让它达到我们期望的结果

1. 设计我们的 resizer：新建一个 prg，贴入下列代码，并保存为 resizer.prg

Public goResizer
m.goResizer = NewObject('resizer')

Define Class resizer as Custom
	Dimension aCtrls[1]
	resizing = .f.
	
	Procedure Hook(toCtrl)
		Local cClass, ii
		If This.resizing
			Return
		EndIf
		
		m.cClass = Lower(m.toCtrl.BaseClass)
		If InList(m.cClass, 'container')	&& , pageframe, page, optiongroup, commandgroup, grid
			If Alen(This.aCtrls) == 1
				m.ii = 1
			Else
				m.ii = 1 + Alen(This.aCtrls, 1)
			EndIf
			Dimension This.aCtrls[m.ii, 3]
			This.aCtrls[m.ii, 1] = This.GetFullPath(m.toCtrl)
			This.aCtrls[m.ii, 2] = m.toCtrl.Width
			This.aCtrls[m.ii, 3] = m.toCtrl.Height
			BindEvent(m.toCtrl, 'resize', This, 'resize')
			BindEvent(m.toCtrl, 'destroy', This, 'destroy')
		EndIf
	EndProc
	
	Procedure Destroy
		Dimension This.aCtrls[1]
		This.aCtrls = .f.
	EndProc
	
	Procedure resize
		If This.resizing
			Return
		EndIf
		This.resizing = .t.
		
		Local ii, nw, nh, cc, c1, o1
		Local oo as Container
		Local oForm as Form
		Local array aTemp[1]
		
		AEvents(m.aTemp, 0)
		m.oo = m.aTemp[1]
		m.ii = Ascan(This.aCtrls, This.GetFullPath(m.oo), 1, -1, 1, 1+2+4+8)
		If m.ii > 0
			m.c1 = m.oo.ReadExpression('zzz_hook')
			m.oo.WriteExpression('zzz_hook', '')
			m.nw = m.oo.Width
			m.nh = m.oo.Height
			m.oo.Width  = This.aCtrls[m.ii, 2]
			m.oo.Height = This.aCtrls[m.ii, 3]
			m.cc = Sys(2015)
			m.oo.SaveAsClass(m.cc, m.cc)
			m.oForm = NewObject('Form')
			m.oForm.NewObject(m.cc, m.cc, m.cc)
			With GetPem(m.oForm, m.cc)
				.Move(0, 0, m.nw, m.nh)
				.Visible = .t.
				For each m.o1 in .Controls
					With GetPem(m.oo, m.o1.name)
						.Move(m.o1.Left, m.o1.Top, m.o1.Width, m.o1.Height)
					EndWith
				EndFor
			EndWith
			m.o1 = Null
			m.oForm = Null
			
			This.aCtrls[m.ii, 2] = m.nw
			This.aCtrls[m.ii, 3] = m.nh
			m.oo.Width  = m.nw
			m.oo.Height = m.nh
			m.oo.WriteExpression('zzz_hook', m.c1)
			
			Clear Class (m.cc)
			Erase (m.cc + '.vc?')
		EndIf
		
		This.resizing = .f.
	EndProc
	
	Procedure GetFullPath(toCtrl)
		Local oo, cc
		
		m.oo = m.toCtrl
		m.cc = m.oo.name
		Do while PemStatus(m.oo, 'Parent', 5) and !(m.oo.BaseClass == 'Form')
			Try
				m.oo = m.oo.Parent
				m.cc = m.oo.name + '.' + m.cc
			Catch
			EndTry
		EndDo
		Return Lower(m.cc)
	EndProc
EndDefine

说明一下：

A. 这个 resizer.resize 方法中的变量命名很没规矩，不要学

B. 一开始的试验，验证了属性表达式中调用的函数必须在当前路径下，或者 vfp 可以找到（例如，你可以启动 vfp 后运行一个单独的 prg 来 set default to ...，或用 set proc to ... 或 set path to ... 将这 resizer.prg 放置在可搜索的过程或路径中）；我们这里使用另外一种方式，定义一个设计时用的全局变量 goResizer，并让它在 vfp 启动时自动加载到设计环境中，这样就可以不再受 curdir() 的影响，因为它已在内存中了。