AppleVB.com

首页->技巧->控件->详细内容

'在form中放一个textBox两个label
Const EM_GETSEL = &HB0
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Public Sub GetCaretPos(ByVal hwnd5 As Long, LineNo As Long, ColNo As Long)
Dim i As Long, j As Long
Dim lParam As Long, wParam As Long
Dim k As Long
i = SendMessage(hwnd5, EM_GETSEL, wParam, lParam)
j = i / 2 ^ 16 '取得目前Caret所在前面有多少个byte
LineNo = SendMessage(hwnd5, EM_LINEFROMCHAR, j, 0) '取得前面有多少行
LineNo = LineNo + 1
k = SendMessage(hwnd5, EM_LINEINDEX, -1, 0)
'取得目前caret所在行前面有多少个byte
ColNo = j - k + 1
End Sub

Private Sub Form_Load()
Dim LineNo As Long, ColNo As Long

Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
Label1.Caption = LineNo
Label2.Caption = ColNo

End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim LineNo As Long, ColNo As Long

Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
Label1.Caption = LineNo
Label2.Caption = ColNo

End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim LineNo As Long, ColNo As Long

Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
Label1.Caption = LineNo
Label2.Caption = ColNo

End Sub
返回

Change ProgressBar Orientation at Run-Time

PRODUCT :Microsoft Visual Basic for Windows
PROD/VER:WINDOWS:6.0
OPER/SYS:WINDOWS
KEYWORDS:

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

- Microsoft Visual Basic Learning, Professional, and Enterprise Editions
for Windows, version 6.0
---------------------------------------------------------------------

SUMMARY
=======

When changing the Orientation property of a ProgressBar, the bar changes
position on the form. If this Orientation is changed at run-time, it could
overlap other controls or be displayed off the visible portion of the form.
This article describes how to change the Orientation and keep the control
in the same position.

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

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

1. Start a new Visual Basic project. Form1 is created by default.

2. Select Components from the Project menu. Check "Microsoft Windows Common
Controls 6.0" and click OK.

3. Add a Progress Bar, ProgessBar1, to Form1.

4. Add a CommandButton, Command1, to Form1.

5. Add the following code to Form1's code window:

Private Sub Command1_Click()
Dim iWidth As Integer
Dim iHeight As Integer
Dim iLeft As Integer
Dim iTop As Integer

' Store the current position
iWidth = ProgressBar1.Width
iHeight = ProgressBar1.Height
iLeft = ProgressBar1.Left
iTop = ProgressBar1.Top

' This only works with Smooth Scrolling
ProgressBar1.Scrolling = ccScrollingSmooth

' Change the Orientation to the opposite
If ProgressBar1.Orientation = ccOrientationVertical Then
ProgressBar1.Orientation = ccOrientationHorizontal
Else
ProgressBar1.Orientation = ccOrientationVertical
End If

' Reset the new position with the old position
ProgressBar1.Width = iWidth
ProgressBar1.Height = iHeight
ProgressBar1.Left = iLeft
ProgressBar1.Top = iTop

DoEvents
Form1.Refresh
ProgressBar1.Value = 0
ProgressBar1.Max = 1000
For i = 1 To 1000
ProgressBar1.Value = i
Next i
End Sub

5. Run the Project and click Command1 multiple times to see vertical and
horizontal scrolling.

Additional query words: kbControl kbVBp kbdsd kbDSupport kbVBp600
======================================================================
Version : WINDOWS:6.0
Platform : WINDOWS
Issue type : kbhowto

=============================================================================
返回

Read Extender Properties from a UserControl

Dynamically Add Controls to a Form with Visual Basic 6.0

PRODUCT :Microsoft Visual Basic for Windows
PROD/VER:
OPER/SYS:WINDOWS
KEYWORDS:

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

- Microsoft Visual Basic Learning, Professional, and Enterprise Editions
for Windows, version 6.0
---------------------------------------------------------------------

SUMMARY
=======

Visual Basic 6.0 allows you to dynamically add control to a form at run-
time using the new Add method of the Controls collection. This article
shows how to dynamically add intrinsic and ActiveX controls.

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

The following example dynamically adds two intrinsic and one ActiveX
control to an application at run-time. The sample shows how to program the
events of a dynamically added control. If you are dynamically adding a
control that is not referenced in the project, you may need to add the
control's License key to the Licenses collection. For more information on
the Licenses collection, please see the REFERENCES section of this article.

When you reference properties of the dynamically-added control, you must
use the Object keyword to access the properties of the control. If you
don't use the Object keyword, you will only be able to access the extender
properties of the control.

When an ActiveX control is dynamically added using the VBControlExtender
object and WithEvents in the declare statement, you will need to use the
ObjectEvent method to code all of the control's events. If you declare an
intrinsic control WithEvents, you will get all the standard event methods
for the type of control you declared. You can see this by adding the
following declare statement in the Code window and then checking the Events
dropdown for the declared variable in the Code window:

Dim WithEvents cmdMyCommand as VB.CommandButton

Steps to Create Sample Project
------------------------------

1. Create a new Standard EXE project. Form1 is created by default.

2. Add the following code to the code window of Form1:

Option Explicit
' If you are adding an ActiveX control at run-time that is
' not referenced in your project, you need to declare it
' as VBControlExtender.
Dim WithEvents ctlDynamic As VBControlExtender
Dim WithEvents ctlText As VB.TextBox
Dim WithEvents ctlCommand As VB.CommandButton

Private Sub ctlCommand_Click()
ctlText.Text = "You Clicked the Command button"
End Sub

Private Sub ctlDynamic_ObjectEvent(Info As EventInfo)
' test for the click event of the TreeView
If Info.Name = "Click" Then
ctlText.Text = "You clicked " _
& ctlDynamic.object.selecteditem.Text
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
' Add the license for the treeview to the license collection.
' If the license is already in the collection you will get
' the run-time error number 732.
Licenses.Add "MSComctlLib.TreeCtrl"
' Dynamically add a TreeView control to the form.
' If you want the control to be added to a different
' container such as a Frame or PictureBox, you use the third
' parameter of the Controls.Add to specify the container.
Set ctlDynamic = Controls.Add("MSComctlLib.TreeCtrl", _
"myctl", Form1)
' set the location and size of the control.
ctlDynamic.Move 1, 1, 2500, 3500
' Add some nodes to the control.
For i = 1 To 10
ctlDynamic.object.nodes.Add Key:="Test" & Str(i), Text:="Test" _
& Str(i)
ctlDynamic.object.nodes.Add Relative:="Test" & Str(i), _
Relationship:=4, Text:="TestChild" & Str(i)
Next i
' Make the control visible.
ctlDynamic.Visible = True
' add a textbox
Set ctlText = Controls.Add("VB.TextBox", "ctlText1", Form1)
' Set the location and size of the textbox
ctlText.Move (ctlDynamic.Left + ctlDynamic.Width + 50), _
1, 2500, 100
' Change the backcolor.
ctlText.BackColor = vbYellow
' Make it visible
ctlText.Visible = True
' Add a CommandButton.
Set ctlCommand = Controls.Add("VB.CommandButton", _
"ctlCommand1", Form1)
' Set the location and size of the CommandButton.
ctlCommand.Move (ctlDynamic.Left + ctlDynamic.Width + 50), _
ctlText.Height + 50, 1500, 500
' Set the caption
ctlCommand.Caption = "Click Me"
' Make it visible
ctlCommand.Visible = True
End Sub

3. Save and run the project. Try clicking the CommandButton and on
different Nodes in the TreeView. The TextBox will show what you click.

REFERENCES
==========

For additional information, please see the following article in the
Microsoft Knowledge Base:

ARTICLE-ID: Q188577
TITLE : HOWTO: What is the Licenses Collection Used For?

Also search On-line Help for the following topics:

Add Method (Controls Collection)
Add Method (Licenses Collection)

Additional query words: kbDSupport kbDSD kbCtrlCreate kbVBp kbVBp600
kbActiveX
(c) Microsoft Corporation 1998. All Rights Reserved.
Contributions by Brian Combs, Microsoft Corporation
======================================================================
Platform : WINDOWS
Issue type : kbhowto

=============================================================================
返回

更新工程文件以便在VB6中使用MSCCOMCTL.OCX控件

PRODUCT :Microsoft Visual Basic for Windows
PROD/VER:
OPER/SYS:WINDOWS
KEYWORDS:

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

- Microsoft Visual Basic Learning, Professional, and Enterprise Editions
for Windows, version 6.0
---------------------------------------------------------------------

SUMMARY
=======

The following controls are not automatically updated when a Visual Basic
5.0 project is loaded by Visual Basic 6.0:

COMCLTL32.OCX, COMCT232.OCX, and MSCHART.OCX

The project must be manually upgraded to the new Visual Basic 6.0 controls:
MSCOMCTL.OCX, MSCOMCT2.OCX, and MSCHRT20.OCX, respectively.

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

The new controls are not backward compatible with the older versions and,
in accordance with the rules of COM, were given new file names and new
GUIDs. This prevents your application from breaking existing applications
that use the older controls. Because the new controls have new names and
GUIDs, they also have new Typelibs. When you load a Visual Basic project,
it checks the Typelib version. However, Visual Basic does not know the
Controls were updated because the Typelib for the new controls have a
different GUID than the Typelib for the old controls.

To upgrade a project to the newer version, you must do the following:

1. Open the VBP file in a text editor, such as Notepad, and change the
line(s) that reference the old version of the OCX to the following:

Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCT2.OCX
Object={65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0; MSCHRT20.OCX

Save and close the VBP file.

2. Open any FRM file (or CTL file) that uses one of the above controls
in a text editor, and change the line(s) that reference the old
version of the OCX to the following:

Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{65E121D4-0C60-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCHRT20.OCX"

3. Change all text that references the old libraries to the new library
names. This means that you need to replace ComCtlLib, Comctl2, and
MSChartLib with MSComCtlLib, MSComCtl2, and MSChart20Lib. For example,
change:

ComctlLib.ImageList

to:

MSComctlLib.ImageList

4. Save and close the file. When you open the project in Visual Basic 6.0,
it will use the new MSCOMCTL.OCX, MSCOMCT2.OCX and/or MSCHRT20.OCX
controls.

NOTE:

1. IMPORTANT: Before you edit your VBP, FRM, or CTL files, you should
backup all of the files in your project.

2. While the objects listed in step 1 and 2 are very similar, they are not
identical and the upgrade will not work properly if each is not copied
exactly to the correct file.

3. If you get a message stating that the header is corrupt when you attempt
to load the project, you have probably made a copy error. Please go to
your backup and repeat the process.

4. If you prefer to continue using the older versions of these controls,
comctl32.ocx and comct232.ocx are included on the Visual Basic 6.0
product CD-ROM in the \OS\System directory. Mschart32.ocx resides in the
\Common\Tools\VB\Controls directory.

(c) Microsoft Corporation 1998. All Rights Reserved.
Contributions by Brian Combs, Microsoft Corporation.

Additional query words: kbVBp kbdsd kbDSupport kbVBp600 kbComCtrls
======================================================================
Platform : WINDOWS
Issue type : kbhowto

=============================================================================
返回

快速选择全部项目

我们在使用 List 控件时，经常需要全部选择其中的项目，在项目较少时，我们可以逐项设置 Selected 来选择全部的项目，但当项目较多时，这样做就比较费时，其实，我们可以用 API 函数来简单实现此功能：
Dim nRet As Long
Dim bState as Boolean
bState=True
nRet = SendMessage(lstList.hWnd, LB_SETSEL, bState, -1)
函数声明：
Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" ( ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WM_USER = &H400
Public Const LB_SETSEL = (WM_USER + 6)
返回

改变 ListIndex而不发生 Click 事件

在修改 Combo 或 Listview 的ListIndex 时，会发生 Click 事件，下面的函数可以阻止该事件。
声明：
Private Declare Function SendMessage Lib _
"user32" Alias "SendMessageA" (ByVal _
hWnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, lParam As Any) As Long
Const CB_GETCURSEL = &H147
Const CB_SETCURSEL = &H14E
Const LB_SETCURSEL = &H186
Const LB_GETCURSEL = &H188
函数：
Public Function SetListIndex(lst As Control, _
ByVal NewIndex As Long) As Long

If TypeOf lst Is ListBox Then
Call SendMessage(lst.hWnd, _
LB_SETCURSEL, NewIndex, 0&)
SetListIndex = SendMessage(lst.hWnd, _
LB_GETCURSEL, NewIndex, 0&)
ElseIf TypeOf lst Is ComboBox Then
Call SendMessage(lst.hWnd, _
CB_SETCURSEL, NewIndex, 0&)
SetListIndex = SendMessage(lst.hWnd, _
CB_GETCURSEL, NewIndex, 0&)
End If
End Function
返回

调整 Combo 下拉部分的宽度

声明：
Private Declare Function SendMessage Lib _
"USER32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As _
Long) As Long
Private Const CB_GETDROPPEDWIDTH = &H15F
Private Const CB_SETDROPPEDWIDTH = &H160
Private Const CB_ERR = -1
函数：
' 取得 Combo 下拉的宽度
' 可以利用该函数比例放大或缩小宽度
Public Function GetDropdownWidth(cboHwnd As Long) As Long
Dim lRetVal As Long
lRetVal = SendMessage(cboHwnd, CB_GETDROPPEDWIDTH, 0, 0)
If lRetVal <> CB_ERR Then
GetDropdownWidth = lRetVal
'单位为 pixels
Else
GetDropdownWidth = 0
End If
End Function
'设置 Combo 下拉的宽度
'单位为 pixels
Public Function SetDropdownWidth(cboHwnd As _
Long, NewWidthPixel As Long) As Boolean
Dim lRetVal As Long
lRetVal = SendMessage(cboHwnd, _
CB_SETDROPPEDWIDTH, NewWidthPixel, 0)
If lRetVal <> CB_ERR Then
SetDropdownWidth = True
Else
SetDropdownWidth = False
End If
End Function
返回

把所有的字体名称放到 ComboBox

For I = 0 To Screen.FontCount - 1
cboFont.AddItem Screen.Fonts(I)
Next I

Combo的自动查询技术
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const CB_FINDSTRING = &H14C

Private Sub Combo1_Change()
Dim iStart As Integer
Dim sString As String
Static iLeftOff As Integer

iStart = 1
iStart = Combo1.SelStart

If iLeftOff <> 0 Then
Combo1.SelStart = iLeftOff
iStart = iLeftOff
End If

sString = CStr(Left(Combo1.Text, iStart))
Combo1.ListIndex = SendMessage(Combo1.hwnd, _
B_FINDSTRING, -1, ByVal CStr(Left( _
ombo1.Text, iStart)))

If Combo1.ListIndex = -1 Then
iLeftOff = Len(sString)
combo1.Text = sString
End If

Combo1.SelStart = iStart
iLeftOff = 0
End Sub

静态变量 iLeftOff 指定了字符长度。
返回

改变 TreeView 的背景

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_STYLE = -16&
Private Const TVM_SETBKCOLOR = 4381&
Private Const TVM_GETBKCOLOR = 4383&
Private Const TVS_HASLINES = 2&

Dim frmlastForm As Form

Private Sub Form_Load()
Dim nodX As Node
Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
nodX.EnsureVisible
TreeView1.style = tvwTreelinesText ' Style 4.
TreeView1.BorderStyle = vbFixedSingle
End Sub

Private Sub Command1_Click()
Dim lngStyle As Long
Call SendMessage(TreeView1.hWnd, TVM_SETBKCOLOR, 0, ByVal RGB(255, 0, 0))
'改变背景到红色

lngStyle = GetWindowLong(TreeView1.hWnd, GWL_STYLE)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle)
End Sub
返回

对ListView中的列排序

设置 ListView 控件到 report 视图。下面的代码允许你使用
任何的列进行排序，主要在列头上点击。
如果已经排序，顺序将反一下。

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
With ListView1
If (ColumnHeader.Index - 1) = .SortKey Then
.SortOrder = (.SortOrder + 1) Mod 2
Else
.Sorted = False
.SortOrder = 0
.SortKey = ColumnHeader.Index - 1
.Sorted = True
End If
End With
End Sub
返回