VB利用API画线性渐变矩形

'API相关定义
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TRIVERTEX
x As Long
y As Long
Red As Integer
Green As Integer
Blue As Integer
Alpha As Integer
End Type
Private Type GRADIENT_RECT
UpperLeft As Long
LowerRight As Long
End Type
Private Const GRADIENT_FILL_RECT_H As Long = &H0
Private Const GRADIENT_FILL_RECT_V As Long = &H1
'\\创建圆角矩形区域的API
Private Declare Function CreateRoundRectRgn Lib “gdi32” (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
'\\设置窗口区域的API
Private Declare Function SetWindowRgn Lib “user32” (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'\\设置指定矩形的内容
Private Declare Function SetRect Lib “user32” (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'\\绘制颜色块Api
Private Declare Function GradientFillRect Lib “msimg32” Alias “GradientFill” (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
'\\释放系统资源
Private Declare Function DeleteObject Lib “gdi32” (ByVal hObject As Long) As Long

‘回调函数

'绘画渐变矩形(目标DC,左距,顶距,宽度,高度,A颜色,B颜色,渐变方向)
Private Sub shadeRECT(hDC As Long, x As Long, y As Long, Width As Long, Height As Long, StartColor As Long, EndColor As Long, Optional Direction As Long)
Dim DotPlace(1) As TRIVERTEX, PropRECT As GRADIENT_RECT, Area As RECT, Nsrt As Long
Nsrt = SetRect(Area, x, y, Width, Height) '设置指定矩形的内容
With DotPlace(0)
.x = Area.Left
.y = Area.Top
.Red = DissectRGB(StartColor, 0)
.Green = DissectRGB(StartColor, 1)
.Blue = DissectRGB(StartColor, 2)
.Alpha = 0&
End With
With DotPlace(1)
.x = Area.Right
.y = Area.Bottom
.Red = DissectRGB(EndColor, 0)
.Green = DissectRGB(EndColor, 1)
.Blue = DissectRGB(EndColor, 2)
.Alpha = 0&
End With
PropRECT.UpperLeft = 1
PropRECT.LowerRight = 0
GradientFillRect hDC, DotPlace(0), 2, PropRECT, 1, IIf(Direction > 0, GRADIENT_FILL_RECT_V, GRADIENT_FILL_RECT_H)
Call DeleteObject(Nsrt)
End Sub
'对颜色分解成RGB函数
Private Function DissectRGB(ByVal ColorValue As Long, Optional RGBindex As Integer = 0) As Integer
Dim R As Double, G As Double, B As Double
R = CLng((ColorValue And &HFF&) * 256)
G = CLng(((ColorValue And &HFF00&) \ &H100&) * 256)
B = CLng(((ColorValue And &HFF0000) \ &H10000) * 256)
DissectRGB = IIf(RGBindex = 0, IIf(R < 32768, Int®, Int(R - &H10000)), IIf(RGBindex = 1, IIf(G < 32768, Int(G), Int(G - &H10000)), IIf(B < 32768, Int(B), Int(B - &H10000))))
End Function

'调用
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
Call shadeRECT(Me.hDC, 5, 5, Me.ScaleWidth - 5, 50, RGB(255, 0, 0), RGB(255, 255, 0)) '水平渐变
Call shadeRECT(Me.hDC, 5, 60, Me.ScaleWidth - 5, 110, RGB(0, 255, 0), RGB(0, 0, 255), 1) '垂直渐变
End Sub

VB利用API画线性渐变矩形相关推荐

html5 --- 使用canvas画一个渐变矩形
我们希望得到如下效果: 首先准备画布 // HTML <canvas width="500" height="375" id ="a" ...
手把手教你画圆锥渐变
前言昨天公司培训canvas相关内容,然后培训完还留下一道homework,觉得挺有意思的,特来与大家分享分享.大家可以先不看我的实现,自己尝试试试,还是可以学到不少知识的. 题目内容初看题目内容 ...
WPF(C#) LinearGradientBrush线性渐变画刷
LinearGradientBrush线性渐变画刷 LinearGradientBrush其实很简单,我们只需要关注5个属性,使用这5个属性你就可以完成这个画刷几乎所有的变化. 一.属性介绍 1.St ...
GdiplusFlat（4）单色画刷和线性渐变画刷
本博文由CSDN博主zuishikonghuan所作,版权归zuishikonghuan所有,转载请注明出处:http://blog.csdn.net/zuishikonghuan/article ...
GDI+学习之线性渐变画刷
分享一下我老师大神的人工智能教程!零基础,通俗易懂!http://blog.csdn.net/jiangjunshow 也欢迎大家转载本篇文章.分享知识,造福人民,实现我们中华民族伟大复兴! 作者:朱 ...
WPF线性渐变画刷应用之——炫彩线条
原文:WPF线性渐变画刷应用之--炫彩线条效果图: Xaml代码: <Rectangle Width="800" Height="10"> < ...
GDI+ 学习记录(10): 线性渐变画刷 - LinearGradientBrush
为什么80%的码农都做不了架构师?>>> //线性渐变画刷 varg: TGPGraphics;lb: TGPLinearGradientBrush;rect: TGPRect ...
转 Silverlight开发历程—(画刷与着色之线性渐变画刷)
转自:http://blog.csdn.net/work201003/article/details/6960427 线性渐变画刷(LinearGradientBrush)用来填充一个复合渐变色到一个 ...
利用API函数实现图像淡入淡出效果(VB)
利用API函数实现图像淡入淡出效果一般传统的实现两个PictureBox之间图像的淡入淡出效果都需要使用大量的API函数并进行复杂的调色板以及绘图设备(Device Context)的操作 ...

VB利用API画线性渐变矩形

VB利用API画线性渐变矩形相关推荐

最新文章

热门文章