界面开发之Flat3DButton

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

自己是否想过重画控件,现在用强大的VB来实现吧。

下例就是简单的利用VB中的CommandButton改变成Flat3DButton风格。其实就是利用VB的SubClass去处理父窗口的WM_DRAWITEM消息。

1. 建立一个标准EXE工程,加入Command1和Command2,将Command1的Style属性设为Graphical。

2. 加入模块,取名SubClass_Flat3DButton,贴进代码:

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Copyright 2002 40Star, All Rights Reserved.

'

'E-Mail :40Star@163.com

'Distribution:你可以完全自由随便的使用这段代码,不管你用于任何目的

' 程序在于交流和学习

' 如有任何BUG请和我联系

'

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function GetParent Lib "user32" _

(ByVal hWnd 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 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

(Destination As Any, Source As Any, ByVal Length As Long)

Const GWL_WNDPROC = (-4&)

Dim PrevWndProc&

Private Const WM_DESTROY = &H2

Private Const WM_DRAWITEM = &H2B

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Type DRAWITEMSTRUCT

CtlType As Long

CtlID As Long

itemID As Long

itemAction As Long

itemState As Long

hwndItem As Long

hdc As Long

rcItem As RECT

itemData As Long

End Type

' Owner draw constants

Private Const ODT_BUTTON = 4

' Owner draw actions

Private Const ODA_DRAWENTIRE = &H1

Private Const ODA_SELECT = &H2

Private Const ODA_FOCUS = &H4

' Owner draw state

Private Const ODS_SELECTED = &H1

Private Const ODS_GRAYED = &H2

Private Const ODS_DISABLED = &H4

Private Const ODS_CHECKED = &H8

Private Const ODS_FOCUS = &H10

Private Declare Function GetWindowText Lib "user32" Alias _

"GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _

ByVal cch As Long) As Long

'Various GDI painting-related functions

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

' Color Types

Const CTLCOLOR_MSGBOX = 0

Const CTLCOLOR_EDIT = 1

Const CTLCOLOR_LISTBOX = 2

Const CTLCOLOR_BTN = 3

Const CTLCOLOR_DLG = 4

Const CTLCOLOR_SCROLLBAR = 5

Const CTLCOLOR_STATIC = 6

Const CTLCOLOR_MAX = 8 ' three bits max

Const COLOR_SCROLLBAR = 0

Const COLOR_BACKGROUND = 1

Const COLOR_ACTIVECAPTION = 2

Const COLOR_INACTIVECAPTION = 3

Const COLOR_MENU = 4

Const COLOR_WINDOW = 5

Const COLOR_WINDOWFRAME = 6

Const COLOR_MENUTEXT = 7

Const COLOR_WINDOWTEXT = 8

Const COLOR_CAPTIONTEXT = 9

Const COLOR_ACTIVEBORDER = 10

Const COLOR_INACTIVEBORDER = 11

Const COLOR_APPWORKSPACE = 12

Const COLOR_HIGHLIGHT = 13

Const COLOR_HIGHLIGHTTEXT = 14

Const COLOR_BTNFACE = 15

Const COLOR_BTNSHADOW = 16

Const COLOR_GRAYTEXT = 17

Const COLOR_BTNTEXT = 18

Const COLOR_INACTIVECAPTIONTEXT = 19

Const COLOR_BTNHIGHLIGHT = 20

Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush 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 RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long

'pen Api

Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

' Pen Styles

Const PS_SOLID = 0

Const PS_DASH = 1 ' -------

Const PS_DOT = 2 ' .......

Const PS_DASHDOT = 3 ' _._._._

Const PS_DASHDOTDOT = 4 ' _.._.._

Const PS_NULL = 5

Const PS_INSIDEFRAME = 6

Const PS_USERSTYLE = 7

Const PS_ALTERNATE = 8

Const PS_STYLE_MASK = &HF

Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Type POINTAPI

x As Long

y As Long

End Type

Private Declare Function DrawText Lib "user32" Alias "DrawTextA" _

(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _

lpRect As RECT, ByVal wFormat As Long) As Long

Private Const DT_SINGLELINE = &H20

Private Const DT_CENTER = &H1

Private Const DT_VCENTER = &H4

Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _

ByVal crColor As Long) As Long

Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, _

ByVal nBkMode As Long) As Long

Private Const TRANSPARENT = 1

Private Sub DrawButton(ByVal hWnd As Long, ByVal hdc As Long, _

rct As RECT, ByVal nState As Long)

Dim P As POINTAPI

Dim s As String

Dim hbr As Long

Dim hpen As Long

hbr = CreateSolidBrush(GetSysColor(COLOR_BTNFACE))

SelectObject hdc, hbr

FillRect hdc, rct, hbr

DeleteObject hbr

'画文字时背景为透明状

SetBkMode hdc, TRANSPARENT

'得到Button的Caption

s = String$(255, 0)

GetWindowText hWnd, s, 255

s = Left$(s, InStr(s, Chr$(0)) - 1)

'根据Button的Enabled状态进行重画

If (nState And ODS_DISABLED) = ODS_DISABLED Then

'画内侧3D效果->亮色

hpen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT))

SelectObject hdc, hpen

MoveToEx hdc, rct.Left, rct.Top, P

LineTo hdc, rct.Right, rct.Top

MoveToEx hdc, rct.Left, rct.Top, P

LineTo hdc, rct.Left, rct.Bottom

DeleteObject hpen

'画内侧3D效果->暗色

hpen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))

SelectObject hdc, hpen

MoveToEx hdc, rct.Left, rct.Bottom - 1, P

LineTo hdc, rct.Right, rct.Bottom - 1

MoveToEx hdc, rct.Right - 1, rct.Top, P

LineTo hdc, rct.Right - 1, rct.Bottom

DeleteObject hpen

'画阴影文字

rct.Left = rct.Left + 1

rct.Right = rct.Right + 1

rct.Bottom = rct.Bottom + 1

rct.Top = rct.Top + 1

SetTextColor hdc, GetSysColor(COLOR_BTNHIGHLIGHT)

DrawText hdc, s, Len(s), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER

rct.Left = rct.Left - 1

rct.Right = rct.Right - 1

rct.Bottom = rct.Bottom - 1

rct.Top = rct.Top - 1

SetTextColor hdc, GetSysColor(COLOR_GRAYTEXT)

DrawText hdc, s, Len(s), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER

Exit Sub

End If

'按下Button时重画

If (nState And ODS_SELECTED) = ODS_SELECTED Then

'画外围黑框

hbr = CreateSolidBrush(GetSysColor(COLOR_BTNTEXT))

SelectObject hdc, hbr

FrameRect hdc, rct, hbr

DeleteObject hbr

hbr = CreateSolidBrush(GetSysColor(COLOR_BTNSHADOW))

SelectObject hdc, hbr

rct.Left = rct.Left + 1

rct.Right = rct.Right - 1

rct.Bottom = rct.Bottom - 1

rct.Top = rct.Top + 1

FrameRect hdc, rct, hbr

DeleteObject hbr

rct.Left = rct.Left + 1

rct.Right = rct.Right + 1

rct.Bottom = rct.Bottom + 1

rct.Top = rct.Top + 1

SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)

DrawText hdc, s, Len(s), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER

Exit Sub

End If

'Button得到焦点时重画

If (nState And ODS_FOCUS) = ODS_FOCUS Then

'画外围黑框

hbr = CreateSolidBrush(GetSysColor(COLOR_BTNTEXT))

SelectObject hdc, hbr

FrameRect hdc, rct, hbr

DeleteObject hbr

'画内侧3D效果->亮色

hpen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT))

SelectObject hdc, hpen

MoveToEx hdc, rct.Left + 1, rct.Top + 1, P

LineTo hdc, rct.Right - 1, rct.Top + 1

MoveToEx hdc, rct.Left + 1, rct.Top + 1, P

LineTo hdc, rct.Left + 1, rct.Bottom - 1

DeleteObject hpen

'画内侧3D效果->暗色

hpen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))

SelectObject hdc, hpen

MoveToEx hdc, rct.Left + 1, rct.Bottom - 2, P

LineTo hdc, rct.Right - 1, rct.Bottom - 2

MoveToEx hdc, rct.Right - 2, rct.Top + 1, P

LineTo hdc, rct.Right - 2, rct.Bottom - 1

DeleteObject hpen

SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)

DrawText hdc, s, Len(s), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER

Else

'画内侧3D效果->亮色

hpen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT))

SelectObject hdc, hpen

MoveToEx hdc, rct.Left, rct.Top, P

LineTo hdc, rct.Right, rct.Top

MoveToEx hdc, rct.Left, rct.Top, P

LineTo hdc, rct.Left, rct.Bottom

DeleteObject hpen

'画内侧3D效果->暗色

hpen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))

SelectObject hdc, hpen

MoveToEx hdc, rct.Left, rct.Bottom - 1, P

LineTo hdc, rct.Right, rct.Bottom - 1

MoveToEx hdc, rct.Right - 1, rct.Top, P

LineTo hdc, rct.Right - 1, rct.Bottom

DeleteObject hpen

'画阴影文字

SetTextColor hdc, GetSysColor(COLOR_BTNTEXT)

DrawText hdc, s, Len(s), rct, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER

End If

End Sub

Private Function SubWndProc(ByVal hWnd As Long, ByVal Msg As Long, _

ByVal wParam As Long, ByVal lParam As Long) _

As Long

Dim di As DRAWITEMSTRUCT

If Msg = WM_DESTROY Then Terminate (hWnd)

'处理自画消息

If Msg = WM_DRAWITEM Then

CopyMemory di, ByVal lParam, Len(di)

'判断是自画Button

If di.CtlType = ODT_BUTTON Then

DrawButton di.hwndItem, di.hdc, di.rcItem, di.itemState

'不返回VB的默认Button绘制过程

SubWndProc = 1

Exit Function

End If

End If

SubWndProc = CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)

End Function

Public Sub Init(hWnd As Long)

PrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubWndProc)

End Sub

Public Sub Terminate(hWnd As Long)

Call SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)

End Sub

' -- 模块结束 -- '

3. Form1中的代码:

Option Explicit

Private Sub Form_Load()

Call Init(Me.hWnd)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call Terminate(Me.hWnd)

End Sub

4. 结束语

怎么样,看到两个Button之间的不同了么

本程序在Win2000 + Vb6中调试通过。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航