你正在 VB 加油站!

最近更新

加油站台

下载区域

文档资料收集

写流言

瞧瞧流言

友情连接

写信给俺啦

 

E  控件

B  框

011 Office或IE4风格的ToolBar 98-9-03

用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

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

010 显示 Combo 的下拉条 98-8-11

声明:
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)到页首

009  确定 TextBox 有几行 98-8-11

声明:
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&)
到页首

008 TextBox 中英文输入方法切换 98-7-22

IMEMode 属性可以方便地控制输入方法:
  Text1.IMEMode = 0   '初始值
  Text1.IMEMode = 1   '中文输入
  Text1.IMEMode = 2   '英文输入
    Text1.IMEMode = 3   '禁止中文输入到页首

007 利用API 使Text框只读 98-7-22

声明:
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 属性也有类似的效果,更方便。到页首

006 在 Textbox 中,录入 N 个字符后移到下栏

在 Textbox  的 Change 中加入:
IF (LEN(TEXT1))  >= N THEN
  SENDKEY "{TAB}"
END IF
如果为中文和英文字符混合的情况,参见:AB010 到页首

005  MaskEdit 中 9 的问题

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

12_.137.___.___

解决方法如下:

MaskEdBox1.Text = "129.137.___.___"
MaskEdBox1.Mask = "129.137.###.###"
MaskEdBox1.SelStart = 8到页首

004 自动选择 Text 的内容

在使用 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到页首

003 处理 Dropdown List型 Combo的录入问题

当 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 这行里,你可以增加你任何自己的处理代码。 到页首

002 自定义Text的pop-up菜单

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

If Button = vbRightButton Then
Text1.Enabled = False
Text1.Enabled = True
Text1.SetFocus
PopUpMenu Menu1
End If 到页首

001  放一个Combo到Toolbar中

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到页首

 

知/的/更/多 做/的/更/好