宝峰科技

 找回密码
 注册

QQ登录

只需一步,快速开始

智能终端设备维修查询系统注册会员邮箱认证须知!
查看: 4355|回复: 4

[VB例程源码] 用VB6和GDI技术实现的3D文字按钮

[复制链接]
  • TA的每日心情
    开心
    2023-11-30 08:27
  • 签到天数: 120 天

    [LV.7]常住居民III

    admin 发表于 2009-12-18 00:26:53 | 显示全部楼层 |阅读模式

    欢迎您注册加入!这里有您将更精采!

    您需要 登录 才可以下载或查看,没有账号?注册

    x
    源代码如下:
    1、新建EXE工程。
    2、添加模块,键入下面代码
    1. ' -------- API 函数声明 -----------------
    2. Option Explicit
    3. Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    4.    Destination As Any, _
    5.    Source As Any, _
    6.    ByVal Length As Long)
    7. Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
    8.    ByVal hwnd As Long, _
    9.    ByVal lpString As String, _
    10.    ByVal cch As Long) As Long
    11. Public Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" ( _
    12.    lpLogFont As logFont) As Long
    13. Public Const LF_FACESIZE As Long = 32
    14. Public Type logFont
    15.   lfHeight As Long
    16.   lfWidth As Long
    17.   lfEscapement As Long
    18.   lfOrientation As Long
    19.   lfWeight As Long
    20.   lfItalic As Byte
    21.   lfUnderline As Byte
    22.   lfStrikeOut As Byte
    23.   lfCharSet As Byte
    24.   lfOutPrecision As Byte
    25.   lfClipPrecision As Byte
    26.   lfQuality As Byte
    27.   lfPitchAndFamily As Byte
    28.   lfFaceName(1 To LF_FACESIZE) As Byte
    29. End Type
    30. Public Declare Function BitBlt Lib "gdi32.dll" ( _
    31.    ByVal hDestDC As Long, _
    32.    ByVal x As Long, _
    33.    ByVal y As Long, _
    34.    ByVal nWidth As Long, _
    35.    ByVal nHeight As Long, _
    36.    ByVal hSrcDC As Long, _
    37.    ByVal xSrc As Long, _
    38.    ByVal ySrc As Long, _
    39.    ByVal dwRop As Long) As Long
    40. Public Declare Function DeleteDC Lib "gdi32.dll" ( _
    41.    ByVal hdc As Long) As Long
    42. Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    43. Public Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    44.      ByVal hdc As Long, _
    45.      ByVal nWidth As Long, _
    46.      ByVal nHeight As Long) As Long
    47. Public Declare Function SelectObject Lib "gdi32.dll" ( _
    48.    ByVal hdc As Long, _
    49.    ByVal hObject As Long) As Long
    50. Public Type Size
    51.   cx As Long
    52.   cy As Long
    53. End Type
    54. Public Declare Function GetTextExtentPoint Lib "gdi32.dll" Alias "GetTextExtentPointA" ( _
    55.    ByVal hdc As Long, _
    56.    ByVal lpszString As String, _
    57.    ByVal cbString As Long, _
    58.    lpSize As Size) As Long
    59. Public Declare Function MulDiv Lib "kernel32.dll" ( _
    60.    ByVal nNumber As Long, _
    61.    ByVal nNumerator As Long, _
    62.    ByVal nDenominator As Long) As Long
    63. Public Declare Function SetBkMode Lib "gdi32.dll" ( _
    64.    ByVal hdc As Long, _
    65.    ByVal nBkMode As Long) As Long
    66. Public Declare Function GetSysColor Lib "user32.dll" ( _
    67.    ByVal nIndex As Long) As Long
    68. Public Declare Function SetTextColor Lib "gdi32.dll" ( _
    69.    ByVal hdc As Long, _
    70.    ByVal crColor As Long) As Long
    71. Public Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" ( _
    72.    ByVal hdc As Long, _
    73.    ByVal x As Long, _
    74.    ByVal y As Long, _
    75.    ByVal lpString As String, _
    76.    ByVal nCount As Long) As Long
    77. Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
    78.    ByVal lpPrevWndFunc As Long, _
    79.    ByVal hwnd As Long, _
    80.    ByVal msg As Long, _
    81.    ByVal wParam As Long, _
    82.    ByVal lParam As Long) As Long
    83. Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    84.    ByVal hwnd As Long, _
    85.    ByVal nIndex As Long, _
    86.    ByVal dwNewLong As Long) As Long
    87. Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
    88.    ByVal hwnd As Long, _
    89.    ByVal nIndex As Long) As Long
    90. Public Type RECT
    91.   Left As Long
    92.   Top As Long
    93.   Right As Long
    94.   Bottom As Long
    95. End Type
    96. Public Type DRAWITEMSTRUCT
    97.   CtlType As Long
    98.   CtlID As Long
    99.   itemID As Long
    100.   itemAction As Long
    101.   itemState As Long
    102.   hwndItem As Long
    103.   hdc As Long
    104.   rcItem As RECT
    105.   itemData As Long
    106. End Type
    107. Public Declare Function DeleteObject Lib "gdi32.dll" ( _
    108.    ByVal hObject As Long) As Long
    109. Public Declare Function FillRect Lib "user32.dll" ( _
    110.    ByVal hdc As Long, _
    111.    lpRect As RECT, _
    112.    ByVal hBrush As Long) As Long
    113. Public Declare Function CreateSolidBrush Lib "gdi32.dll" ( _
    114.    ByVal crColor As Long) As Long
    115. Public Declare Function GetTextMetrics Lib "gdi32.dll" Alias "GetTextMetricsA" ( _
    116.    ByVal hdc As Long, _
    117.    lpMetrics As TEXTMETRIC) As Long
    118. Public Type TEXTMETRIC
    119.   tmHeight As Long
    120.   tmAscent As Long
    121.   tmDescent As Long
    122.   tmInternalLeading As Long
    123.   tmExternalLeading As Long
    124.   tmAveCharWidth As Long
    125.   tmMaxCharWidth As Long
    126.   tmWeight As Long
    127.   tmOverhang As Long
    128.   tmDigitizedAspectX As Long
    129.   tmDigitizedAspectY As Long
    130.   tmFirstChar As Byte
    131.   tmLastChar As Byte
    132.   tmDefaultChar As Byte
    133.   tmBreakChar As Byte
    134.   tmItalic As Byte
    135.   tmUnderlined As Byte
    136.   tmStruckOut As Byte
    137.   tmPitchAndFamily As Byte
    138.   tmCharSet As Byte
    139. End Type
    140.    
    141. Public Const WM_DRAWITEM As Long = &H2B
    142. Public Const GWL_WNDPROC As Long = -4
    143. Public Const ODS_SELECTED As Long = &H1
    144. Public Const COLOR_3DDKSHADOW As Long = 21
    145. Public Const COLOR_BTNFACE As Long = 15
    146. Public Const COLOR_BTNHIGHLIGHT As Long = 20
    147. Public Const COLOR_BTNSHADOW As Long = 16
    148. Public Const COLOR_3DLIGHT As Long = 22
    149. Public Const COLOR_3DHIGHLIGHT As Long = COLOR_BTNHIGHLIGHT
    150. Public Const COLOR_3DFACE As Long = COLOR_BTNFACE
    151. Public Const COLOR_3DHILIGHT As Long = COLOR_BTNHIGHLIGHT
    152. Public Const COLOR_3DSHADOW As Long = COLOR_BTNSHADOW
    153. Public Const ODT_BUTTON As Long = 4
    154. Public Const TRANSPARENT As Long = 1
    155. Public Const ODS_DISABLED As Long = &H4
    复制代码

    3、再添加一个模块,键入下面代码:
    1. '------------------ 应用SubClass处理 -------------------
    2. ' 2003-12-17
    3. ' 作者:任兀(DSclub)
    4. '
    5. '如果有问题
    6. '请E-Mail:dsclub@hotmail.com
    7. '
    8. '--------------------------------------------------------
    9. '----------- 说明 -----------------
    10. '对于想要设置成文字按钮的Command,修改其Style属性为1
    11. '将本模块考入你的程序,然后在你的代码中写入Hook和Unhook即可
    12. '
    13. '----------------------------------------------------------------
    14. Option Explicit
    15. Global lpPrevWndProc As Long
    16. Global gHW As Long
    17. Public Sub Hook()
    18.    lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
    19. End Sub
    20. Public Sub Unhook()
    21.    Dim temp As Long
    22.    temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
    23. End Sub
    24. Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    25. Dim DI As DRAWITEMSTRUCT
    26.   '捕获 WM_DRAWITEM 消息,并处理
    27.   If uMsg = WM_DRAWITEM Then
    28.     CopyMemory DI, ByVal lParam, Len(DI)
    29.    
    30.     '找到是Owner-drawn的按钮
    31.     If DI.itemAction Or ODT_BUTTON = ODT_BUTTON Then
    32.       
    33.       DrawButton DI.hwndItem, DI.hdc, DI.rcItem, DI.itemState
    34.       
    35.       '-------- 取消系统默认的消息处理 --------------
    36.       WindowProc = 1
    37.       Exit Function
    38.     End If
    39.   
    40.   End If
    41.   
    42.   WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    43. End Function

    44. Public Sub DrawButton(ByVal ButtonHW As Long, ByVal DIhDC As Long, RCT As RECT, ByVal State As Long)
    45. Dim ButtonText As String * 255 '必须设置Buffer
    46. Dim pFont As Long
    47. Dim logFont As logFont
    48. Dim pOldFont As Long
    49. Dim SZ As Size
    50. Dim FString As String
    51. Dim ButtonTextBitLength As Integer
    52. Dim s As Integer
    53. Dim textColor As Long
    54. Dim OldBKMode As Long
    55. Dim cx As Integer
    56. Dim cy As Integer
    57. Dim MemDC As Long
    58. Dim MemBitmap As Long
    59. Dim OldMB As Long
    60. Dim TM As TEXTMETRIC

    61.   '使用双缓冲,防止闪烁
    62.   MemDC = CreateCompatibleDC(DIhDC)
    63.   MemBitmap = CreateCompatibleBitmap(DIhDC, RCT.Right - RCT.Left, RCT.Bottom - RCT.Top)
    64.   OldMB = SelectObject(MemDC, MemBitmap)
    65.   
    66.   '得到按钮的初始Caption,并按位计算长度
    67.   GetWindowText ButtonHW, ButtonText, 255
    68.   ButtonTextBitLength = InStrB(1, StrConv(ButtonText, vbFromUnicode), vbNullChar) - 1
    69.   
    70.   '构造逻辑字体
    71.   With logFont
    72.     .lfHeight = 60
    73.     .lfWidth = 0
    74.     .lfWeight = 1000
    75.     .lfEscapement = 0
    76.     .lfOrientation = 0
    77.   End With
    78.   
    79.   pFont = CreateFontIndirect(logFont)
    80.   pOldFont = SelectObject(MemDC, pFont)
    81.   
    82.   GetTextExtentPoint MemDC, ButtonText, ButtonTextBitLength + 2, SZ '加上一个2,以防有中文出错误
    83.   
    84.   '调整字体大小
    85.   If (RCT.Right - RCT.Left) * SZ.cy > (RCT.Bottom - RCT.Top) * SZ.cx Then
    86.     logFont.lfHeight = MulDiv(logFont.lfHeight, (RCT.Bottom - RCT.Top), SZ.cy)
    87.   Else
    88.     logFont.lfHeight = MulDiv(logFont.lfHeight, (RCT.Right - RCT.Left), SZ.cx)
    89.   End If
    90.   
    91.   '恢复DC,并使用新的调整好的字体
    92.   pFont = CreateFontIndirect(logFont)
    93.   DeleteObject (SelectObject(MemDC, pOldFont))
    94.   pOldFont = SelectObject(MemDC, pFont)
    95.   
    96.   GetTextExtentPoint MemDC, ButtonText, ButtonTextBitLength, SZ
    97.   cx = RCT.Left + (RCT.Right - RCT.Left - SZ.cx) / 2
    98.   cy = RCT.Top + (RCT.Bottom - RCT.Top - SZ.cy) / 2
    99.   cx = cx + 2
    100.   cy = cy + 2
    101.   
    102.   
    103.   '处理鼠标按下和抬起的不同消息
    104.   If (State And ODS_SELECTED) = ODS_SELECTED Then
    105.     s = -1
    106.   Else
    107.     s = 1
    108.   End If
    109.   
    110.   OldBKMode = SetBkMode(MemDC, TRANSPARENT)
    111.   
    112.   '先把BG涂上颜色COLOR_3DFACE
    113.   FillRect MemDC, RCT, CreateSolidBrush(GetSysColor(COLOR_3DFACE))
    114.   
    115.   '开始画3D字体边缘
    116.   textColor = SetTextColor(MemDC, GetSysColor(COLOR_3DDKSHADOW))
    117.   TextOut MemDC, cx - s * 2, cy + s * 2, ButtonText, ButtonTextBitLength
    118.   TextOut MemDC, cx + s * 2, cy - s * 2, ButtonText, ButtonTextBitLength
    119.   TextOut MemDC, cx + s * 2, cy + s * 2, ButtonText, ButtonTextBitLength
    120.   
    121.   SetTextColor MemDC, GetSysColor(COLOR_3DHILIGHT)
    122.   TextOut MemDC, cx + s, cy - s * 2, ButtonText, ButtonTextBitLength
    123.   TextOut MemDC, cx - s * 2, cy + s, ButtonText, ButtonTextBitLength
    124.   TextOut MemDC, cx - s * 2, cy - s * 2, ButtonText, ButtonTextBitLength
    125.   
    126.   SetTextColor MemDC, GetSysColor(COLOR_3DSHADOW)
    127.   TextOut MemDC, cx - s, cy + s, ButtonText, ButtonTextBitLength
    128.   TextOut MemDC, cx + s, cy - s, ButtonText, ButtonTextBitLength
    129.   TextOut MemDC, cx + s, cy + s, ButtonText, ButtonTextBitLength
    130.   
    131.   SetTextColor MemDC, GetSysColor(COLOR_3DLIGHT)
    132.   TextOut MemDC, cx, cy - s, ButtonText, ButtonTextBitLength
    133.   TextOut MemDC, cx - s, cy, ButtonText, ButtonTextBitLength
    134.   TextOut MemDC, cx - s, cy - s, ButtonText, ButtonTextBitLength
    135.   '处理按钮的Enanbled状态
    136.   If (State And ODS_DISABLED) = ODS_DISABLED Then
    137.     SetTextColor MemDC, GetSysColor(COLOR_3DSHADOW)
    138.     TextOut MemDC, cx, cy, ButtonText, ButtonTextBitLength
    139.   Else
    140.     SetTextColor MemDC, textColor
    141.     TextOut MemDC, cx, cy, ButtonText, ButtonTextBitLength
    142.   End If
    143.   
    144.   '一次性传输到Button的可视DC
    145.   BitBlt DIhDC, 0, 0, RCT.Right - RCT.Left, RCT.Bottom - RCT.Top, MemDC, 0, 0, vbSrcCopy

    146.   '恢复 DC
    147.   SetBkMode MemDC, OldBKMode
    148.   DeleteObject (SelectObject(MemDC, pOldFont))
    149.   SetTextColor MemDC, textColor
    150.   pFont = 0
    151.   pOldFont = 0
    152.   DeleteObject (SelectObject(MemDC, OldMB))
    153.   DeleteObject MemBitmap
    154.   DeleteDC MemDC
    155.   
    156. End Sub
    复制代码
    4、在Form1窗体上,放入CommmadnButton,并将想变成3D按钮的CommandButton的Style属性设置成1-Graphical。再Form1的代码中输入下面代码启动。
    1. Private Sub Form_Load()
    2. gHW = Me.hwnd
    3. Hook
    4. End Sub
    5. Private Sub Form_Unload(Cancel As Integer)
    6. Unhook
    7. End Sub
    复制代码
    5、运行效果图

    用VB6实现的3D文字按钮

    用VB6实现的3D文字按钮

    游客,如果您要查看本帖隐藏内容请回复

    该用户从未签到

    xueming 发表于 2010-4-10 17:30:02 | 显示全部楼层
    保存下来。

    该用户从未签到

    maowei 发表于 2010-9-29 12:22:41 | 显示全部楼层
    活到老学到老
  • TA的每日心情
    开心
    2012-7-29 00:25
  • 签到天数: 6 天

    [LV.2]偶尔看看I

    花心胡萝卜 发表于 2010-11-22 11:39:06 | 显示全部楼层
    哇,好东西!

    该用户从未签到

    qqxx2424 发表于 2010-11-27 06:45:00 | 显示全部楼层
    很不错的。学习了。谢谢
    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    免责声明

    本站中所有被研究的素材与信息全部来源于互联网,版权争议与本站无关。本站所发布的任何软件编程开发或软件的逆向分析文章、逆向分析视频、补丁、注册机和注册信息,仅限用于学习和研究软件安全的目的。全体用户必须在下载后的24个小时之内,从您的电脑中彻底删除上述内容。学习编程开发技术或逆向分析技术是为了更好的完善软件可能存在的不安全因素,提升软件安全意识。所以您如果喜欢某程序,请购买注册正版软件,获得正版优质服务!不得将上述内容私自传播、销售或者用于商业用途!否则,一切后果请用户自负!

    QQ|Archiver|手机版|小黑屋|联系我们|宝峰科技 ( 滇公网安备 53050202000040号 | 滇ICP备09007156号-2 )

    Copyright © 2001-2023 Discuz! Team. GMT+8, 2024-3-29 12:55 , File On Powered by Discuz! X3.49

    快速回复 返回顶部 返回列表