Public Function AbsoluteTop(ctlContl As Control) As Single
Dim wrkContl As Control
Dim wrkTopPos As Single
'
On Error GoTo AbsoluteTopError
' 初始
Set wrkContl = ctlContl
wrkTopPos = 0
' 循环
Do
If (wrkContl.Container.Name = ctlContl.Parent.Name) Then Exit Do
wrkTopPos = wrkTopPos + wrkContl.Top ' 计算位置
Set wrkContl = wrkContl.Container ' 下个控件
Loop

AbsoluteTop = wrkTopPos + ctlContl.Parent.Top
Exit Function
'
AbsoluteTopError:
AbsoluteTop = ctlContl.Top + ctlContl.Parent.Top
Exit Function
End Function
返回

下面是成组更新 Enabled 属性的例子：
Sub EnableAll(Enabled As Boolean, ParamArray objs() As Variant)
Dim obj As Variant
For Each obj In objs
obj.Enabled = Enabled
Next obj
End Sub
应用：
EnableAll True, Text1, Text2, Command1, Command2
返回

用API 可以轻松改变 ToolBar 的风格。需要 4.70 或其以上版本的 comctl32.dll 支持。
声明：
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 _
As Long, ByVal lpsz1 As String, ByVal lpsz2 As _
String) As Long
Private Const WM_USER = &H400
Private Const TB_SETSTYLE = WM_USER + 56
Private Const TB_GETSTYLE = WM_USER + 57
Private Const TBSTYLE_FLAT = &H800
Private Const TBSTYLE_LIST = &H1000
函数：
' tlbToolbarStyle :
'1 为 Office97 风格
'2 为 IE4 风格
Public Sub ToolbarStyle(tlb As Toolbar, _
tlbToolbarStyle As Long)
Dim lngStyle As Long
Dim lngResult As Long
Dim lngHWND As Long

' Find child window and get style bits
lngHWND = FindWindowEx(tlb.hwnd, 0&, _
"ToolbarWindow32", vbNullString)
lngStyle = SendMessage(lngHWND, _
TB_GETSTYLE, 0&, 0&)

' Use a case statement to get the effect
Select Case tlbToolbarStyle
Case 1:
' Creates an Office 97 like toolbar
lngStyle = lngStyle Or TBSTYLE_FLAT
Case 2:
' Creates an Explorer 4.0 like toolbar,
' with text to the right
' of the picture. You must provide text
' in order to get the effect.
lngStyle = lngStyle Or TBSTYLE_FLAT _
Or TBSTYLE_LIST
Case Else
lngStyle = lngStyle Or TBSTYLE_FLAT
End Select

' Use the API call to change the toolbar
lngResult = SendMessage(lngHWND, _
TB_SETSTYLE, 0, lngStyle)

' Show the effects
tlb.Refresh
End Sub

在 Form 装入时调用:
Private Sub Form_Load()
Call ToolbarStyle(Me.Toolbar1, 2)
' …
End Sub

更新：关于ToolBar 风格的说明：
Office 风格的 Toolbar 是指在鼠标移动到 ICON 后，
会出现边框。如我们在 VB5 中用的一样。
而comctl的ToolBar是没有该效果的。
IE4 风格的 Toolbar 可以在ICON 下面出现文字，
如同 IE4 中的Toolbar 一样。(可能是反一下。。。。)
返回

声明：
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const CB_SHOWDROPDOWN = &H14F
使用：
'程序控制显示下拉条
r = SendMessageLong(Combo1.hWnd, CB_SHOWDROPDOWN, True, 0)
'程序控制隐藏下拉条
r = SendMessageLong(Combo1.hWnd, CB_SHOWDROPDOWN, False, 0)

确定 TextBox 有几行
声明：
Public Declare Function SendMessageLong Lib _ "user32" Alias "SendMessageA" (ByVal hwnd As Long, _ ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const EM_GETLINECOUNT = &HBA
使用：
lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)

TextBox 中英文输入方法切换 98-7-22
IMEMode 属性可以方便地控制输入方法：
Text1.IMEMode = 0 '初始值
Text1.IMEMode = 1 '中文输入
Text1.IMEMode = 2 '英文输入
Text1.IMEMode = 3 '禁止中文输入
返回

声明：
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Const WM_USER = &H400
Const EM_SETREADONLY = (WM_USER + 31)
使用：
' 例如使 TEXT1 只读
Dim RetVal As Long
RetVal = SendMessage(Text1.hwnd, EM_SETREADONLY, True, ByVal 0&)
与设置DISABLE 属性不同的是，TEXT1 只读后光标还是可以定位，并能支持多行的移动。
98-7-22 更新： 其实在 VB5 中的 Locked 属性也有类似的效果，更方便。

在 Textbox 中，录入 N 个字符后移到下栏
在 Textbox 的 Change 中加入：
IF (LEN(TEXT1)) >= N THEN
SENDKEY "{TAB}"
END IF
返回

MaskEdit 中 9 的问题

如果你希望使用 "129.137.###.###" 作为 Mask，可能会出现你不希望的：

12_.137.___.___

解决方法如下:

MaskEdBox1.Text = "129.137.___.___"
MaskEdBox1.Mask = "129.137.###.###"
MaskEdBox1.SelStart = 8
返回

在使用 VFP 的应用进行录入时，每进入一个录入框，就自动选择该框中的所有内容。利用以下的代码，也可实现类似的功能。

Private Sub MyTextBox_GotFocus()
AutoSelect MyTextBox
End Sub

Sub AutoSelect(SelObject As Control)
SelObject.SelStart = 0
If TypeOf SelObject Is MaskEdBox Then
SelObject.SelLength = Len(SelObject.FormattedText)
Else
If TypeOf SelObject Is TextBox Then
SelObject.SelLength = Len(SelObject.Text)
End If
End If
End Sub
返回

当 Combo 的 Style 属性设置为 '2 - Dropdown List' 时，是只读的。这就意味着象 MyCombo.Text = "列表内容外" 这样的语句将可能导致一个错误。如果出现这样的情况时，能自动把 ListIndex 属性设置为 -1，而不是出错就好了。下面的代码完成这样的工作:

Function SetComboText(MyCombo as ComboBox, MyItem as String) as Integer
Dim I as Integer

For I = 0 to MyCombo.ListCount - 1
If MyCombo.List(I) = MyItem Then
SetComboText = I
Exit Function
End If
Next I

SetComboText = - 1
End Function

使用该函数:
AnyCombo.ListIndex = SetComboText(AnyCombo, "Any String")
如果 "Any String" 在列表中， ListIndex 将到正确的位置， 如果不在，自动把 ListIndex 属性设置为 -1。在 SetComboText = - 1 这行里，你可以增加你任何自己的处理代码。

自定义Text的pop-up菜单
在 Windows 95, 右击 Textbox 将出现基本的编辑菜单。如果你想改变该菜单，可将以下的代码放到 Textbox 的 MouseDown 事件中。

If Button = vbRightButton Then
Text1.Enabled = False
Text1.Enabled = True
Text1.SetFocus
PopUpMenu Menu1
End If
返回

1. 放一个 ComboBox 到表单.
2. 放一个 Toolbar 在表单.
3. 增加下面的代码到 Form1 :

Private Sub Form_Load()
Dim btn As Button
Me.Show
Set btn = Toolbar1.Buttons.Add()
btn.Style = tbrSeparator
Set btn = Toolbar1.Buttons.Add()
btn.Style = tbrPlaceholder
btn.Key = "ComboBox"
btn.Width = 2000
With Combo1
.ZOrder 0
.Width = Toolbar1.Buttons("ComboBox").Width
.Top = Toolbar1.Buttons("ComboBox").Top
.Left = Toolbar1.Buttons("ComboBox").Left
End With
End Sub
返回

声明（在本例子里使用的是 ComCtl32.OCX，如果是其他，使用相应的名称）：
Declare Function RegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllRegisterServer" () As Long
Declare Function UnRegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllUnregisterServer" () As Long
Const ERROR_SUCCESS = &H0

使用：

If RegComCtl32 = ERROR_SUCCESS Then
MsgBox "Registration Successful"
Else
MsgBox "Registration Unsuccessful"
End If

If UnRegComCtl32 = ERROR_SUCCESS Then
MsgBox "UnRegistration Successful"
Else
MsgBox "UnRegistration Unsuccessful"
End If
返回

例如在 BorderStyle 中有以下的四个选择：
0 - None
1 - Dashed
2 - Single Line
3 - Double Line
4 - 3D
首先在控件中定义以下的集合：
Enum BorderType
None
Dashed
[Single Line]
[Double Line]
[3D]
End Enum
然后就可以把属性的类型设置好：
Public Property Get BorderStyle() As BorderType
Border = m_BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As BorderType)
m_BorderStyle = New_BorderStyle
PropertyChanged "BorderStyle"
End Property
返回

VB5 加强了函数参数方面，可用以下的代码实现参数缺省：

Property Get Value(Optional index As Long = 1)
...
End Property
也可使用另一个方法（慢）：

Property Get Value(Optional index As Long)
If IsMissing(index) Then index = 1
...
End Property
返回

在自制的控件中，可能需要对某个属性传递多个值：

Property Let Test (arg1 As String, arg2 As String, arg3 As Integer)
End Property

'用以下的方法传递参数：
Test(arg1,arg2) = arg3
返回

定义一个 variant 类型的属性，即可用它来做数组。
下面定义了一个 CArray 类。

Private m_MyArray As Variant

Public Property Get MyArray() As Variant
MyArray = m_MyArray
End Property

Public Property Let MyArray(a As Variant)
m_MyArray = a
End Property

可用以下的方法使用：

Private m_Array As CArray
Private mArr(3) As String

Private Sub Form_Load()
Set m_Array = New CArray
mArr(1) = "One"
mArr(2) = "Two"
mArr(3) = "Three"
m_Array.MyArray = mArr()
'或者
'm_Array.MyArray = Array("One", "Two", "Three")
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
For i = 1 To UBound(m_Array.MyArray)
MsgBox m_Array.MyArray(i)
Next
End Sub
返回

'make a new project
'with a toolbar on it (name = toolbar1)
'insert the next code
'press F5

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Const WM_USER = &H400
Const TB_SETSTYLE = WM_USER + 56
Const TB_GETSTYLE = WM_USER + 57
Const TBSTYLE_FLAT = &H800

Private Sub SetToolBarFlat(tlbTemp As Toolbar)
Dim lngStyle As Long
Dim lngResult As Long
Dim lngHWND As Long

lngHWND = FindWindowEx(tlbTemp.HWnd, 0&, "ToolbarWindow32", vbNullString)
lngStyle = SendMessage(lngHWND, TB_GETSTYLE, &O0, &O0)
lngStyle = lngStyle Or TBSTYLE_FLAT
lngResult = SendMessage(lngHWND, TB_SETSTYLE, 0, lngStyle)
tlbTemp.Refresh

End Sub

Private Sub Form_Load
Call SetToolbarFlat(Toolbar1)

End Sub
(在VB6以上版本中ToolBar已经可以设置成平面的了，所以上面的范例不再起作用)
返回

PRODUCT :Microsoft Visual Basic for Windows
PROD/VER:5.0
OPER/SYS:WINDOWS
KEYWORDS:kbusage vb5all vb5howto VBKBAX VBKBComp VBKBCtrl kbhowto

======================================================================
-----------------------------------------------------------------------
The information in this article applies to:

- Control Creation, Professional, and Enterprise Editions of
Microsoft Visual Basic, 16-bit and 32-bit, for Windows, version 5.0
-----------------------------------------------------------------------

SUMMARY
=======

An ActiveX control typically exposes an About property to allow developers
to see extra information concerning the author of the control. Microsoft
Visual Basic Control Creation, Professional, and Enterprise Editions for
Windows, version 5.0 allow the creation of this About property for ActiveX
controls (UserControls) created in these editions of Visual Basic 5.0.

MORE INFORMATION
================

Step-by-Step Example
--------------------

1. Open your ActiveX Control project or start a new ActiveX Control
project.

2. In the Project window, right-click your ActiveX control (UserControl)
object. Click Add, and then click Form.

3. In the Professional and Enterprise Editions, double-click "About Dialog"
in the list of form templates. In the Control Creation Edition, there is
no "About Dialog" form template. Use the following steps instead:

a. Double-click "Form" in the list of form templates.

b. Change the Name of the form to "frmAbout" and the Caption to "About
MyApp," where MyApp is the name of your application.

c. Add a CommandButton control to the form and change its Caption to
"OK" and its Default property to "True".

d. Add the following code to the CommandButton control's Click event
procedure:

Private Sub Command1_Click()
Unload Me
End Sub

e. Add other controls to the form to give it the appearance you desire.
Label controls with the application's title, version, description,
and disclaimers are common, as is a PictureBox control for
displaying the application's icon and a CommandButton control for
displaying "System Information."

4. In the Project window, right-click your ActiveX control (UserControl)
object. Click View Code and add the following code to your ActiveX
control (UserControl):

Sub ShowAboutBox()
frmAbout.Show vbModal
Unload frmAbout
Set frmAbout = Nothing
End Sub

5. From the Tools menu, click Procedure Attributes.

6. Select the ShowAboutBox procedure in the Name field, and then click
"Advanced>>."

7. Select AboutBox from the Procedure ID field and click OK.

8. Close all of the windows for the ActiveX control (UserControl) project.
This will put the control in run mode.

9. Add a "Standard EXE" project (using Add Project in the File menu) and
place the ActiveX control (UserControl) on the form. The About property
is shown in the control's property list. If you click on the ellipses
for this property, the frmAbout dialog box appears.
返回

SUMMARY
=======

You can create a default property for your User Control. A default
property is the property selected when you select the control in Design
Mode. For example, when you select a Label, the highlighted property is
Caption. Therefore, Caption is the default property for the Label. This
article will explain how to create a default property for a User Control
that you create.

MORE INFORMATION
================

After the property is created, follow these steps to make the property the
default property:

1. From the Tools menu, select "Procedure Attributes."

2. In the "Procedure Attributes" dialog box, select the property name you
previously created.

3. Add a Description, if desired, and select the "Advanced>>" button.

4. Select the "User Interface Default" checkbox in the Attributes frame.

When using the User Control in designing a Visual Basic form, the
default property will be highlighted when the User Control is selected.

You can only have one default Property for each Control. Therefore, you can
only select the "User Interface Default" checkbox for one property. If you
select this checkbox for another property, it will ask you if you want to
make the newly-selected property the Default property.
返回

Abstract
Many Windows厝based applications allow you to move a control, such as
a window, to a new position on the screen. This is accomplished by
clicking the left mouse button on the control and, while holding the
mouse button down, dragging the object to a new location on the
screen. When you release the mouse button, the object remains at the
new screen position. This article explains how you can add this
functionality to your own Visual Basic applications.

Moving Forms and Other Controls
When you click the mouse button, Visual Basic triggers its MouseDown
or MouseUp events. When you press the mouse button down, a MouseDown
event is invoked; similarly, when you release the mouse button, a
MouseUp event is invoked. At run time, you can allow a user to
position controls at new locations on the screen by trapping the
MouseDown event for each control.
Each time a control receives the focus or detects mouse movement,
Windows calls the SetCapture or ReleaseCapture function. The Windows
application programming interface (API) SetCapture and ReleaseCapture
functions set or release the mouse capture, which tells the system
which object is currently being manipulated. These functions can be
used in conjunction with the SendMessage function to position a
control at a new location on the screen.

When an object, such as a form, is moved at run time, Windows
generates a MOVE message. By trapping the MouseDown event for a
control, you can tell Visual Basic to issue a move command to the
operating system. This system command (MOVE) tells Windows to move the
window to the new position.
In the example program below, the user can move both the form and
command button to new locations. When the MouseDown event is triggered
for the control, the ReleaseCapture function is called. Next, the
SendMessage function tells Windows to actually execute the MOVE
command. This anchors the object at its new position on the screen.

Example Program
The example program below shows how to drag a control, such as a form
or command button, to a new position on the screen.

1. Create a new project in Visual Basic. Form1 is created by default.
2. Add the following Constant and Declare statements to the General
Declarations section of Form1 (note that each Declare statement
must be typed as a single line of code):

Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF012

Declare Sub ReleaseCapture Lib "User" ()
Declare Sub SendMessage Lib "User" (ByVal hWnd As Integer,
ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Long)

3. Add the following code to the MouseDown event for Form1:

Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single)
ReleaseCapture
SendMessage Form1.hWnd, WM_SYSCOMMAND, SC_MOVE, 0
End Sub

4. Add a Command Button control to Form1. Command1 is created by
default.
5. Add the following code to the MouseDown event for Command1:

Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single)
ReleaseCapture
SendMessage Command1.hWnd, WM_SYSCOMMAND, SC_MOVE, 0
End Sub
返回

Back to top