VB 设置控件边框颜色(如:List、Text、Picture)

本文介绍如何使用VB来设置控件如List、Text、Picture的边框颜色,通过修改控件的窗口过程实现自定义边框绘制,涉及API函数调用和窗口消息处理。
 VB 设置控件边框颜色,比如:ListBox、TextBox、PictureBox、ComboBox等等….
调用方法:

'setBorderColor (控件句柄,颜色值)  setBorderColor Text1.hWnd, vbRed

Option Explicit
Private Type RECTW
    Left                As Long
    Top                 As Long
    Right               As Long
    Bottom              As Long
    Width               As Long
    Height              As Long
End Type

Private Type RECT
    Left        As Long
    Top         As Long
    Right       As Long
    Bottom      As Long
End Type

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Private Const WM_DESTROY        As Long = &H2
Private Const WM_PAINT          As Long = &HF
Private Const WM_NCPAINT        As Integer = &H85
Private Const GWL_WNDPROC = (-4)
Private Color As Long

Public Sub setBorderColor(hWnd As Long, Color_ As Long)
    Color = Color_
    If GetProp(hWnd, "OrigProcAddr") = 0 Then
        SetProp hWnd, "OrigProcAddr", SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    End If
End Sub

Public Sub UnHook(hWnd As Long)
    Dim OrigProc As Long
    OrigProc = GetProp(hWnd, "OrigProcAddr")
    If Not OrigProc = 0 Then
        SetWindowLong hWnd, GWL_WNDPROC, OrigProc
        OrigProc = SetWindowLong(hWnd, GWL_WNDPROC, OrigProc)
        RemoveProp hWnd, "OrigProcAddr"
    End If
End Sub
Private Function OnPaint(OrigProc As Long, hWnd As Long, uMsg As Long, wParam As Long, lParam As Long) As Long
    Dim m_hDC       As Long
    Dim m_wRect     As RECTW
    OnPaint = CallWindowProc(OrigProc, hWnd, uMsg, wParam, lParam)
    Call pGetWindowRectW(hWnd, m_wRect)
    m_hDC = GetWindowDC(hWnd)
    Call pFrameRect(m_hDC, 0, 0, m_wRect.Width, m_wRect.Height)
    Call ReleaseDC(hWnd, m_hDC)
End Function
Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim OrigProc As Long
    Dim ClassName As String
    If hWnd = 0 Then Exit Function
    OrigProc = GetProp(hWnd, "OrigProcAddr")
    If Not OrigProc = 0 Then
        If uMsg = WM_DESTROY Then
            SetWindowLong hWnd, GWL_WNDPROC, OrigProc
            WindowProc = CallWindowProc(OrigProc, hWnd, uMsg, wParam, lParam)
            RemoveProp hWnd, "OrigProcAddr"
        Else
            If uMsg = WM_PAINT Or WM_NCPAINT Then

                WindowProc = OnPaint(OrigProc, hWnd, uMsg, wParam, lParam)
            Else
                WindowProc = CallWindowProc(OrigProc, hWnd, uMsg, wParam, lParam)
            End If
        End If
    Else
        WindowProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
    End If
End Function

Private Function pGetWindowRectW(ByVal hWnd As Long, lpRectW As RECTW) As Long
    Dim TmpRect As RECT
    Dim Rtn     As Long
    Rtn = GetWindowRect(hWnd, TmpRect)
    With lpRectW
        .Left = TmpRect.Left
        .Top = TmpRect.Top
        .Right = TmpRect.Right
        .Bottom = TmpRect.Bottom
        .Width = TmpRect.Right - TmpRect.Left
        .Height = TmpRect.Bottom - TmpRect.Top
    End With
    pGetWindowRectW = Rtn
End Function

Private Function pFrameRect(ByVal hDC As Long, ByVal x As Long, y As Long, ByVal Width As Long, ByVal Height As Long) As Long
    Dim TmpRect     As RECT
    Dim m_hBrush    As Long
    With TmpRect
        .Left = x
        .Top = y
        .Right = x + Width
        .Bottom = y + Height
    End With
    m_hBrush = CreateSolidBrush(Color)
    pFrameRect = FrameRect(hDC, TmpRect, m_hBrush)
    DeleteObject m_hBrush
End Function

摘自:网络整理

相关参考


关于三个概念:ActiveXOLECOM

注册ActiveX控件的几种方法() 分享

VB 单击ListView控件某列表头进行排序


控件关文章:


VB表格控件总览与例程分析

VB 设置控件边框颜色(如:ListTextPicture)

VB控件注册 - 利用资源文件将dllocx打包进exe文件

VB的,经常注册和反注册OCX控件和DLL

VB表格控件总览与例程分析

根据窗体自动调整窗体内控件大小 注:实用,可以直接引用

用户控件制作讲解与实例

VB制作OCX控件的步骤

【引用】窗口处理技巧大全 vb(窗体控件)

VB让控件可以当标题栏拖动

VB 调用腾讯截图控件CameraDLL.dll

VB表格控件总览与例程分析

VB表格控件总览与例程分析

Mp3Play.ocx控件让音乐之声响起来

为系统加载右键注册控件选项【VB 注册控件】

VBMsFlexGrid控件的使用细则

点击MSFlexGrid数据控件的标题进行数据排序


评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值