Comctl32控件外观技巧

微凉

在这里我用Comctl32 5.0控件来完成,因为6.0的控件我感觉变了很多,而且使用起来要比6.0控件的灵活很多,一般对Win32控件较熟悉的高手都会有所查觉,至于改变了哪些,你们可以用6.0的控件对比5.0的控件试试,这里不再叙述.

需要用到的几个API及常量：
  Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Public 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
  Public 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 GWL_EXSTYLE = (-20)
  Public Const GWL_STYLE = (-16)

一、Listview控件外观

  '需要用到的常量
  Public Const LVM_FIRST As Long = &H1000
  Public Const LVM_GETHEADER = (LVM_FIRST + 31)
  Public Const LVM_SETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 54)
\\n
  Public Const LVM_GETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 55)
\\n
  Public Const LVS_EX_FLATSB As Long = &H100&         '平面滚动条
  Public Const LVS_EX_GRIDLINES As Long = &H1         '网格
  Public Const LVS_EX_FULLROWSELECT As Long = &H20&   '整行选择
  Public Const LVS_EX_CHECKBOXES As Long = &H4&       '选择框
  Public Const LVS_EX_TWOCLICKACTIVATE = &H80         '热跟踪
\\n

  Public Const LVM_GETITEMSTATE = (LVM_FIRST + 44)
  Public Const LVM_SETITEMSTATE = (LVM_FIRST + 43)

  Public Type LVITEM
    mask       As Long
    iItem      As Long
    iSubItem   As Long
    State      As Long
    stateMask  As Long
    pszText    As String
    cchTextMax As Long
    iImage     As Long
    lParam     As Long
    iIndent    As Long
  End Type

  'Listview外观设置（注：平面滚动条方法只适合5.0控件，经测试6.0无法通过！）

  Dim LVStyle As Long
  LVStyle = SendMessage(Listview1.hWnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, ByVal 0&)
\\n
  LVStyle = LVStyle or LVS_EX_FLATSB '其实项目可以自己添加，如：LVStyle or LVS_EX_FLATSB or LVS_EX_GRIDLINES
  SendMessage Listview1.hWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal LVStyle&
\\n

  'Listview 5.0 的CheckBox（注：在5.0中Listview并不存在该项，所以实现起来还是需要代码来完成）

  '获取Check状态（注：i是从0开始）
  Public Function ItemCheck(ByVal hWnd As Long, ByVal i As Integer) As Boolean
    ItemCheck = ((SendMessage(hWnd, LVM_GETITEMSTATE, i, &HF000) And &H2000&) = &H2000&)
  End Function
  '设置Check状态
  Public Function SetCheck(ByVal hWnd As Long, ByVal i As Integer, ByVal Checked As Boolean) As Long
    Dim LVI As LVITEM
   
    With LVI
        .stateMask = &HF000
        .State = &H1000& * (1 - Checked)
        .mask =  &H8
    End With
   
    SendMessage hWnd, LVM_SETITEMSTATE, i, LVI
  End Function

  'Listview的Header平面外观
  Dim LvHeaderhWnd As Long, lvHeaderStyle As Long
  LvHeaderhWnd = SendMessage(Listview.hWnd, LVM_GETHEADER, 0, ByVal 0&)
  lvHeaderStyle = GetWindowLong(LvHeaderhWnd, GWL_STYLE)
  SetWindowLong LvHeaderhWnd, GWL_STYLE, lvHeaderStyle And Not &H2

二、Toolbar控件外观

  '需要用到的常量
  Public Const WM_USER = &H400
  Public Const TB_SETSTYLE = WM_USER + 56
  Public Const TB_GETSTYLE = WM_USER + 57
  Public Const TBSTYLE_FLAT = &H800                   '平面
  Public Const TBSTYLE_LIST = &H1000                  '字符向右显示

  'Toolbar外观设置
  Dim TBhWnd As Long, TStyle As Long
  TBhWnd = FindWindowEx(Toolbar1.hWnd, 0, "ToolbarWindow32", vbNullString) '5.0的类名为ToolbarWindow32,6.0的就不一样了
  TStyle = SendMessage(TBhWnd, TB_GETSTYLE, 0, ByVal 0&)
  TStyle = TStyle or TBSTYLE_FLAT '其它自己添加
  SendMessage TBhWnd, TB_SETSTYLE, 0, ByVal TStyle&

三、TabStrip控件外观

  '需要用到的常量
  Public Const TCS_HOTTRACK = &H40               '热跟踪
  Public Const TCS_FLATBUTTONS = &H8             '平面
  Public Const TCS_MULTILINE = &H200             '当宽度很小时,以垂直显示

  'TabStrip外观设置  
  Dim TabStyle As Long
  TabStyle = GetWindowLong(hWnd, GWL_STYLE)
  TabStyle = TabStyle Or TCS_HOTTRACK '其它自己添加
  SetWindowLong hWnd, GWL_STYLE, TabStyle

四、ProgressBar控件外观

  '需要用到的常量
  Public Const WM_USER = &H400
  Public Const PBM_SETBARCOLOR = WM_USER+9        '前景颜色
  Public Const PBM_SETBKCOLOR = &H2000 + 1        '背景颜色

  'Progressbar外观设置
  SendMessage ProgressBar1.hwnd, PBM_SETBARCOLOR, 0, ByVal RGB(100, 100, 100) 'RGB为你所要设置的前景颜色
  SendMessage ProgressBar1.hwnd, PBM_SETBKCOLOR, 0, ByVal RGB(100, 100, 100)  'RGB为你所要设置的背景颜色

五、Treeview控件外观

  '需要用到的常量
  Public Const TV_FIRST = &H1100
  Public Const TVS_TRACKSELECT = &H200            '热跟踪
  Public Const TVS_CHECKBOXES = &H100             'CheckBox
  Public Const TVS_NOSCROLL = &H2000              '隐藏滚动条
  '还有很多，由于时间关系，这里不再叙述
  Public Const TVM_SETBKCOLOR = TV_FIRST + 29     '背景颜色
  Public Const TVM_SETTEXTCOLOR = TV_FIRST + 30   '字体颜色
  Public Const TVM_SETLINECOLOR = TV_FIRST + 40   '线条颜色

  'TreeView外观设置
  dim wStyle As Long
  wStyle = GetWindowLong(TreeView1.hwnd, GWL_STYLE)
  SetWindowLong TreeView1.hwnd, GWL_STYLE, wStyle Or TVS_TRACKSELECT '其实项目自己添加

  SendMessage TreeView1.hwnd, TVM_SETBKCOLOR, 0, ByVal RGB(100, 100, 100)    'RGB为你所要设置的背景颜色
  SendMessage TreeView1.hwnd, TVM_SETTEXTCOLOR, 0, ByVal RGB(100, 100, 100)  'RGB为你所要设置的字体颜色
  SendMessage TreeView1.hwnd, TVM_SETLINECOLOR, 0, ByVal RGB(100, 100, 100)  'RGB为你所要设置的线条颜色

以上就Comctl控件举了几个例子，希望能给你以启发。

下面我再举几个窗口外观实例，可以应用到任何具有HWND句柄的窗口控件：

一、窗口外观
  
  '需要用到的常量
  Public Const WS_BORDER = &H800000
  Public Const WS_EX_STATICEDGE As Long = &H20000     '二维
  Public Const WS_EX_CLIENTEDGE As Long = &H200&      '三D

  '无边框窗口
  Dim wStyle As Long
  wStyle = GetWindowLong(hWnd, GWL_STYLE)
  SetWindowLong hWnd, GWL_STYLE, wStyle And Not WS_BORDER

  '2维边框,要和上面的一起用
  Dim wExStyle As Long
  wExStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
  wExStyle = wExStyle Or WS_EX_STATICEDGE '三D窗口与此相同，自己添加
  SetWindowLong hWnd, GWL_EXSTYLE, wExStyle

  '如果想它立即生效，可以用SetWindowPos API函数设置

二、按钮外观
  这里我举两个例子，代码如下：
  
  '需要用到的常量
  Public Const SWP_FRAMECHANGED = &H20
  Public Const SWP_NOSIZE = &H1
  Public Const SWP_NOMOVE = &H2
  Public Const SWP_NOZORDER = &H4

  Public Const BS_FLAT = &H8000     '平面按钮
  Public Const WS_GROUP = &H20000   '我也不知道该叫什么按钮

  '平面按钮
  Dim BStyle As Long
  BStyle = GetWindowLong(Command1.hwnd, GWL_STYLE)
  SetWindowLong Command1.hwnd,GWL_STYLE,BStyle or BS_FLAT
  SetWindowPos Command1.hwnd,0,0,0,0,0,SWP_FRAMECHANGED or SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER

  '别一种按钮
  Dim BStyle As Long
  BStyle = GetWindowLong(Command1.hwnd, GWL_EXSTYLE)
  SetWindowLong Command1.hwnd, GWL_EXSTYLE, BStyle Or WS_GROUP
  SetWindowPos Command1.hwnd,0,0,0,0,0,SWP_FRAMECHANGED or SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER


其实还有很多各种外观实现技巧，由于时间关系我不得不停止下来，以上几个例子供大家学习之用，尤其是初学者。好了，就到这里，下次来的时候再带些好东东过来！