Do you want to have a heavy call control, now use powerful VB to implement it.
The next example is to make a simple change to the Flat3DButton style using CommandButton in VB. In fact, using VB's subclass to process the WM_DRAWITEM message of the parent window.
1. Establish a standard EXE project, add Command1 and Command2, and set the STYLE attribute of Command1 to Graphical.
2. Add the module, name Subclass_FLAT3DBUTTON, put into the code:
Option expedition
'' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' ', 40STAR @ 163.com'Distribution: You can use this code completely freely, no matter any purpose 'program lies in communicating and learning', if you have any bug, please contact me '' '' '' '' '' '.' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '''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 LongPrivate 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, BYVALLENGTH AS Long const GWL_WNDPROC = (-4&)
DIM PrevwndProc &
Private const wm_destroy = & h2private const wm_drawitem = & h2b
Private Type Rect Left As Long Top As Long Right As Long Bottom As LONGEND TYPE
Private Type DrawItemstruct CTLTYPE AS Long CTLID AS Long ItemState As Long HwndItem As Rect ItemData As LONGEND TYPE
'Owner draw constantsPrivate Const ODT_BUTTON = 4' Owner draw actionsPrivate Const ODA_DRAWENTIRE = & H1Private Const ODA_SELECT = & H2Private Const ODA_FOCUS = & H4 'Owner draw statePrivate Const ODS_SELECTED = & H1Private Const ODS_GRAYED = & H2Private Const ODS_DISABLED = & H4Private Const ODS_CHECKED = & H8Private 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 functionsPrivate 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 TypesConst CTLCOLOR_MSGBOX = 0Const CTLCOLOR_EDIT = 1Const CTLCOLOR_LISTBOX = 2Const CTLCOLOR_BTN = 3Const CTLCOLOR_DLG = 4Const CTLCOLOR_SCROLLBAR = 5Const CTLCOLOR_STATIC = 6Const CTLCOLOR_MAX = 8' three bits max
Const COLOR_SCROLLBAR = 0Const COLOR_BACKGROUND = 1Const COLOR_ACTIVECAPTION = 2Const COLOR_INACTIVECAPTION = 3Const COLOR_MENU = 4Const COLOR_WINDOW = 5Const COLOR_WINDOWFRAME = 6Const COLOR_MENUTEXT = 7Const COLOR_WINDOWTEXT = 8Const COLOR_CAPTIONTEXT = 9Const COLOR_ACTIVEBORDER = 10Const COLOR_INACTIVEBORDER = 11Const COLOR_APPWORKSPACE = 12Const COLOR_HIGHLIGHT = 13Const COLOR_HIGHLIGHTTEXT = 14Const COLOR_BTNFACE = 15Const COLOR_BTNSHADOW = 16Const color_graytext = 17const color_btntext = 18const color_inactivecaptiontext = 19const 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 LongPrivate 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 ApiPrivate Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long' Pen StylesConst PS_SOLID = 0Const PS_DASH = 1 '------- Const PS_DOT = 2' ....... const ps_dashdot = 3 '_._._._ const ps_dashdotdot = 4' _.._.._ const ps_null = 5const PS_ISIDEFRAME = 6const PS_USERSTYLE = 7Const PS_Alternate = 8const PS_Style_Mask = & HF
Private Declare Function MoveToex Lib "GDI32" (Byval X As Long, Byval Y As Long, LPPOINT AS POINTAPI) AS Long
Private Declare Function Lineto Lib "GDI32" (Byval X as long, Byval Y as long) As long
Private Type Pointapi X As Long Y As Longend Type
Private Declare Function DrawText Lib "User32" ALIAS "DrawTexta" _ (Byval HDC As Long, Byval Ncount As long, _ lpRect As Rect, Byval WFORMAT AS long) As long
Private const dt_singleline = & h20private const dt_center = & h1private 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 = 1Private 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 'when drawing the text background transparent SetBkMode hdc, TRANSPARENT' Get button (255, 0) getWindowText HWnd, S, 255 S = Left $ (S, 255 S = LEFT $ (S, INSTR (s, chr $ (0)) - 1) 'According to the button's Enabled status ( nState And ODS_DISABLED) = ODS_DISABLED Then '3D effect inside Videos -> bright hpen = CreatePen (PS_SOLID, 1, GetSysColor (COLOR_BTNHIGHLIGHT)) SelectObject hdc, hpen MoveToEx hdc, rct.Left, rct.Top, P LineTo hdc, rct.Right , Rct, Rct, RctoEx HDC, Rct, Rct, Rct, Rct, Rct.Bottom DeleteObject HPEN 'Pictures -> Dark 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, R CT.BOTTOM DELETEOBJECT HPEN 'painted shadow text rct.right = rct.right 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_SINGLINE 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_SINGLINE OR DT_VCENTER EXIT SUB End if 'Press Button to Heavy IF (NState and ODS_SELECTED) =
ODS_SELECTED Then 'black box Videos peripheral 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.right = 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 ' redrawing the focus obtained Button If (nState And ODS_FOCUS) = ODS_FOCUS Then 'black box Videos peripheral hbr = CreateSolidBrush (GetSysColor (COLOR_BTNTEXT)) SelectObject hdc, hbr frameRect hdc, rct, hbr DeleteObject hbr' 3D effect inside Videos -> bright hpen = Createpen (ps_solid, 1, getsyscolor (color_btnhighlight) SELECT Object 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 'Painting Interior 3D Effect -> Dark 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 'Videos medial 3D effect - > bright 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 effect inside Videos -> dark 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 'Draws Shadow Text SetTextColor HDC , GetSysColor (color_btntext) DrawText HDC, S, Len (s), RCT, DT_Center OR DT_SINGLINE OR DT_VCENTER End IFEND Subprivate Function SubwndProc (BY Val 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) 'process from Videos message If Msg = WM_DRAWITEM Then CopyMemory di, ByVal LPARAM, LEN (DI) 'judgment is self-drawn button if di.ctltype = odt_button dam, di.rwnditem, di.hdc, di.rcitem, di.itemstate' does not return VB default Button Drawing Process SubWndProc = 1 EXIT FUNCTION END IF End if SubwndProc = CallWindowProc (Prevwindproc, HWND, MSG, WPARAM, LPARAM) End Function
Public Sub Init (hWnd As Long) PrevWndProc = SetWindowLong (hWnd, GWL_WNDPROC, AddressOf SubWndProc) End SubPublic Sub Terminate (hWnd As Long) Call SetWindowLong (hWnd, GWL_WNDPROC, PrevWndProc) End Sub '- end of the module -'
3. The code in Form1:
Option expedition
PRIVATE SUB FORM_LOAD () CALL INIT (ME.HWND) End Sub
Private Sub Form_Unload (Cancel As Integer) Call Terminate (Me.hwnd) End Sub
4 Conclusion
How, see the difference between the two button?
This program is debugged in Win2000 VB6.
