设为首页收藏本站每日签到
切换到宽版

宝峰科技

 找回密码
 注册

QQ登录

只需一步，快速开始

宝峰科技»网站 › 程序设计 › Visual Basic › 用VB6和GDI技术实现的3D文字按钮
智能终端设备维修查询系统注册会员邮箱认证须知！
返回列表 发新帖
查看: 8041|回复: 4

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

[复制链接]
  • TA的每日心情
    开心
    2024-12-9 18:45

    • 签到天数: 124 天

    [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

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

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

    149.   '恢复 DC
    150.   SetBkMode MemDC, OldBKMode
    151.   DeleteObject (SelectObject(MemDC, pOldFont))
    152.   SetTextColor MemDC, textColor
    153.   pFont = 0
    154.   pOldFont = 0
    155.   DeleteObject (SelectObject(MemDC, OldMB))
    156.   DeleteObject MemBitmap
    157.   DeleteDC MemDC
    158.   
    159. 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 | 显示全部楼层
    很不错的。学习了。谢谢
    回复 支持 反对

    使用道具 举报

    返回列表 发新帖
    高级模式
    B Color Image Link Quote Code Smilies
    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    免责声明

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

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

    Copyright © 2001-2023 Discuz! Team. GMT+8, 2025-5-7 07:07 , File On Powered by Discuz! X3.49

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