VB打造超酷个性化菜单（三）--打印文章

VB打造超酷个性化菜单（三）

作者：武汉SEO闵涛文章来源：敏韬网点击数9894 更新时间：2009/4/23 15:44:34 文章录入：mintao 责任编辑：mintao

RedArea = (BarEndColor And &HFF) - (BarStartColor And &HFF)

For i = 0 To BarWidth - 1

red = Int(BarStartColor And &HFF) + Int(i / BarWidth * RedArea)

green = (Int(BarStartColor / &H100) And &HFF) + Int(i / BarWidth * GreenArea)

blue = Int(BarStartColor / &H10000) + Int(i / BarWidth * BlueArea)

hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))

Call SelectObject(.hdc, hPen)

Call MoveToEx(.hdc, i, 0, 0)

Call LineTo(.hdc, i, barRect.Bottom)

Call DeleteObject(hPen)

Next i

Case LBS_VERTICALCOLOR '''' 垂直过渡色

BlueArea = Int(BarEndColor / &H10000) - Int(BarStartColor / &H10000)

GreenArea = (Int(BarEndColor / &H100) And &HFF) - (Int(BarStartColor / &H100) And &HFF)

RedArea = (BarEndColor And &HFF) - (BarStartColor And &HFF)

For i = 0 To barRect.Bottom

red = Int(BarStartColor And &HFF) + Int(i / (barRect.Bottom + 1) * RedArea)

green = (Int(BarStartColor / &H100) And &HFF) + Int(i / (barRect.Bottom + 1) * GreenArea)

blue = Int(BarStartColor / &H10000) + Int(i / (barRect.Bottom + 1) * BlueArea)

hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))

Call SelectObject(.hdc, hPen)

Call MoveToEx(.hdc, 0, i, 0)

Call LineTo(.hdc, barRect.Right, i)

Call DeleteObject(hPen)

Next i

Case LBS_IMAGE '''' 图像

If BarImage.Handle <> 0 Then

Dim barhDC As Long

barhDC = CreateCompatibleDC(GetDC(0))

SelectObject barhDC, BarImage.Handle

BitBlt .hdc, 0, 0, BarWidth, barRect.Bottom - barRect.Top + 1, barhDC, 0, 0, vbSrcCopy

DeleteDC barhDC

End If

End Select

&nbs