还是渐变问题,100分，

zx095x 2010-10-17 11:59:35
想把一个PICTURE的颜色渐变，左上角颜色淡，右下角深。矩形。
...全文
124 10 打赏 收藏 转发到动态 举报
写回复
用AI写文章
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
bcrun 2010-10-21
  • 打赏
  • 举报
 回复
[Quote=引用 8 楼 asftrhgjhkjlkttttttt 的回复:]
自己下吧,不过只能下载6次
[/Quote]

你真逗,传csdn上不就得了:)
贝隆 2010-10-18
  • 打赏
  • 举报
 回复 


Option Explicit

Rem 常量声明区域

Public Const PI = 3.14159265354         '圆周率常量

Public Const SPI_GETWORKAREA As Long = 48&

Public Const GRADIENT_FILL_TRIANGLE As Long = &H2&

'public Const GRADIENT_FILL_RECT_H   As Long = &H0&

Public Const GRADIENT_FILL_RECT_V   As Long = &H1&

Public Const LWA_ALPHA     As Long = &H2

Public Const GWL_EXSTYLE   As Long = (-20)

Public Const WS_EX_LAYERED As Long = &H80000

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

Rem 变量声明区域

Public m_iOSver          As Byte         '/* OS 1=Win98/ME; 2=Win2000/XP

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

Rem 结构类型声明区域

Public Type Rect

    Left   As Long

    top    As Long

    right  As Long

    bottom As Long

End Type

Public Type GRADIENT_TRIANGLE

    Vertex1 As Long

    Vertex2 As Long

    Vertex3 As Long

End Type

Public Type GRADIENT_RECT

    UpperLeft  As Long  '/* UNSIGNED Long

    LowerRight As Long  '/* UNSIGNED Long

End Type

Public Type TRIVERTEX

    x     As Long

    y     As Long

    Red   As Integer '/* Ushort value

    Green As Integer '/* Ushort value

    Blue  As Integer '/* Ushort value

    Alpha As Integer '/* Ushort value

End Type

'/* Operating system version information

Public Type OSVERSIONINFO

    OSVSize       As Long

    dwVerMajor    As Long

    dwVerMinor    As Long

    dwBuildNumber As Long

    PlatformID    As Long

    szCSDVersion  As String * 128

End Type

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

Rem API函数声明区域

Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

'/* Set window in the Z order

Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long

'/* GradientFill API - Requires Windows 2000 or later; Requires Windows 98 or later

Public Declare Function GradientFillTriangle Lib "msimg32" Alias "GradientFill" (ByVal hdc As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long

Public 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

'/* Transparancy API's - Requires Windows 2000 or later; Win9x/ME is not supported

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

'/* Used to draw the form's rounded border

Public Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal Left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long, ByVal EllipseWidth As Long, ByVal EllipseHeight As Long) As Long

'/* Used to make the rounded corners of the form transparent

Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal RectX1 As Long, ByVal RectY1 As Long, ByVal RectX2 As Long, ByVal RectY2 As Long, ByVal EllipseWidth As Long, ByVal EllipseHeight As Long) As Long

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

'过程功能：

'参数说明：

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

Public Sub GradientFill(ByVal iBackcolor As Long, ByRef objP As PictureBox)

    Dim TriVert(3) As TRIVERTEX

    Dim gTRi(1)    As GRADIENT_TRIANGLE

    objP.AutoRedraw = True

    objP.ScaleMode = vbPixels '/* Required but done in Sub DisplayMessage



    '/* Top Left Trangle

    TriVert(0).x = 0&

    TriVert(0).y = 0&

    Call GradientFillColor(TriVert(0), RGB(255, 255, 0))



    '/* Top Right Trangle

    TriVert(1).x = objP.ScaleWidth

    TriVert(1).y = 0&

    Call GradientFillColor(TriVert(1), RGB(255, 255, 0))



    '/* Bottom Right Trangle

    TriVert(2).x = objP.ScaleWidth

    TriVert(2).y = objP.ScaleHeight

    Call GradientFillColor(TriVert(2), iBackcolor)



    '/* Bottom Left Trangle

    TriVert(3).x = 0&

    TriVert(3).y = objP.ScaleHeight

    Call GradientFillColor(TriVert(3), RGB(255, 255, 0))



    gTRi(0).Vertex1 = 0&

    gTRi(0).Vertex2 = 1&

    gTRi(0).Vertex3 = 2&



    gTRi(1).Vertex1 = 0&

    gTRi(1).Vertex2 = 2&

    gTRi(1).Vertex3 = 3&

    Call GradientFillTriangle(objP.hdc, TriVert(0), 4&, gTRi(0), 2&, GRADIENT_FILL_TRIANGLE)

End Sub

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

'过程功能：构建点的填充色

'参数说明：tTV，给点赋值：RGB

'        ：iColor：顶点颜色

'        ：最深颜色

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

Public Sub GradientFillColor(ByRef tTV As TRIVERTEX, ByVal iColor As Long)

    Dim iRed   As Long

    Dim iGreen As Long

    Dim iBlue  As Long

    '/* Separate color into RGB

    iRed = (iColor And &HFF&) * &H100&

    iGreen = (iColor And &HFF00&)

    iBlue = (iColor And &HFF0000) \ &H100&

    '/* Make Red color a UShort

    If (iRed And &H8000&) = &H8000& Then

       tTV.Red = (iRed And &H7F00&)

       tTV.Red = tTV.Red Or &H8000

    Else

       tTV.Red = iRed

    End If

    '/* Make Green color a UShort

    If (iGreen And &H8000&) = &H8000& Then

       tTV.Green = (iGreen And &H7F00&)

       tTV.Green = tTV.Green Or &H8000

    Else

       tTV.Green = iGreen

    End If

    '/* Make Blue color a UShort

    If (iBlue And &H8000&) = &H8000& Then

       tTV.Blue = (iBlue And &H7F00&)

       tTV.Blue = tTV.Blue Or &H8000

    Else

       tTV.Blue = iBlue

    End If

End Sub
孤独剑_LPZ 2010-10-17
  • 打赏
  • 举报
 回复
[Quote=引用 6 楼 zx095x 的回复:]
怎么改？


引用 5 楼 asftrhgjhkjlkttttttt 的回复:
给你一段示例,改一下吧

Dim Color As Long
Dim i As Long, W As Long, H As Long
W = Picture1.ScaleWidth
H = Picture1.ScaleHeight
For i = 0 To H
Color = RGB(255 * ……
[/Quote]

不是几句话能说清楚的,我有一个示例,实现任意角度渐变,自己下吧,不过只能下载6次
http://62.dc.ftn.qq.com/ftn_handler/2ac8ab6de41b0410941f2a47fade7ef8755ed3b39a159e21c5dd6da7388b1c0bda5e8e729e1773e57fcc615d8e225a27f39f09feb24b1d8799b1ff8a01460675/任意角度颜色渐变.rar?k=2c33336394efcd9e4c0d53791e38004e550401025a0d5452485607010015065206041e5b5d0e004c5d0406565d0907025c575251382c32a9abe1d1deff8efab0b0fa98de9d89d64f1752416305&fr=00&&txf_fid=30c834bf410d5dae370ecce15684e0c7fa38ac42
提取码 e33c882a
贝隆 2010-10-17
  • 打赏
  • 举报
 回复
呵呵，兄弟，你又发问了啊？
怎么又要矩形 了？
zx095x 2010-10-17
  • 打赏
  • 举报
 回复
怎么改？

[Quote=引用 5 楼 asftrhgjhkjlkttttttt 的回复:]
给你一段示例,改一下吧

Dim Color As Long
Dim i As Long, W As Long, H As Long
W = Picture1.ScaleWidth
H = Picture1.ScaleHeight
For i = 0 To H
Color = RGB(255 * i / H, 255 * i / H, 255)
Picture1.Line ……
[/Quote]
孤独剑_LPZ 2010-10-17
  • 打赏
  • 举报
 回复
给你一段示例,改一下吧

Dim Color As Long
Dim i As Long, W As Long, H As Long
W = Picture1.ScaleWidth
H = Picture1.ScaleHeight
For i = 0 To H
Color = RGB(255 * i / H, 255 * i / H, 255)
Picture1.Line (0, i)-(W, i), Color
Next
zx095x 2010-10-17
  • 打赏
  • 举报
 回复
没看好，什么乱七八糟的。

[Quote=引用 3 楼 xiaokui008 的回复:]
看好了，模块中代码
Sub Gradient(TheObject As Object, Redval&, Greenval&, Blueval&, TopToBottom As Boolean)
Dim Step%, Reps%, FillTop%, FillLeft%, FillRight%, FillBottom%, HColor$

Step =……
[/Quote]
bhinas 2010-10-17
  • 打赏
  • 举报
 回复
看好了，模块中代码
Sub Gradient(TheObject As Object, Redval&, Greenval&, Blueval&, TopToBottom As Boolean)
Dim Step%, Reps%, FillTop%, FillLeft%, FillRight%, FillBottom%, HColor$

Step = (TheObject.Height / 63)
If TopToBottom = True Then FillTop = 0 Else FillTop = TheObject.Height - Step
FillLeft = 0
FillRight = TheObject.Width
FillBottom = FillTop + Step

For Reps = 1 To 63

TheObject.Line (FillLeft, FillTop)-(FillRight, FillBottom), RGB(Redval, Greenval, Blueval), BF
Redval = Redval - 4
Greenval = Greenval - 4
Blueval = Blueval - 4
If Redval <= 0 Then Redval = 0
If Greenval <= 0 Then Greenval = 0
If Blueval <= 0 Then Blueval = 0
If TopToBottom = True Then FillTop = FillBottom Else FillTop = FillTop - Step
FillBottom = FillTop + Step
Next
End Sub
窗体中代码
Private Sub Form_Resize()
Gradient Me, Slider1.Value, Slider2.Value, Slider3.Value, Check1.Value

End Sub


Private Sub Picture3_Paint()
Gradient Picture3, 0, 0, 255, 1
Gradient Picture4, 0, 0, 255, 1
End Sub






Private Sub Slider1_Scroll()
Label1.Caption = "Red = " + CStr(Slider1.Value)
Gradient Picture1, Slider1.Value, 0, 0, Check1.Value
Gradient Picture4, Slider1.Value, Slider2.Value, Slider3.Value, Check1.Value
End Sub


Private Sub Slider2_Scroll()
Label2.Caption = "Green = " + CStr(Slider2.Value)
Gradient Picture2, 0, Slider2.Value, 0, Check1.Value
Gradient Picture4, Slider1.Value, Slider2.Value, Slider3.Value, Check1.Value

End Sub


Private Sub Slider3_Scroll()
Label3.Caption = "Blue = " + CStr(Slider3.Value)
Gradient Picture3, 0, 0, Slider3.Value, Check1.Value
Gradient Picture4, Slider1.Value, Slider2.Value, Slider3.Value, Check1.Value

End Sub
控件自己摆设
zx095x 2010-10-17
  • 打赏
  • 举报
 回复
没有，那不是斜的

[Quote=引用 1 楼 bcrun 的回复:]
你上个帖子里好像就有答案吧
[/Quote]
bcrun 2010-10-17
  • 打赏
  • 举报
 回复
你上个帖子里好像就有答案吧
[精仿]QQ2013局域网通讯(10.30更新版-带最新版界面库)
20.SkinLabel与SkinButton控件字体与窗体标题可以根据背景色暗亮度自动调节字体为黑还是白。 21.MessageBox提示框的美化，并继承调用窗口的色调与背景，MessageBox可所谓已达到帅气的不能再帅气的境界了。 22.天气...
CSS3的颜色渐变的理解！颜色渐变的角度问题，颜色渐变百分比的理解！以及加入了透明度的问题。
1、CSS3的颜色渐变角度的问题 颜色渐变角度的使用并没有兼容性的考虑，当然了也不用写兼容性代码，同时对于方向性也能有更多的定义 就如上图所示的那样，如： 0deg：表示从下往上进行颜色渐变 90deg：表示从...
CSS3网页设计与制作(6-11)：颜色特性/新型盒模型/边框/背景/渐变
CSS3规范并不是独立的，它重复了CSS的部分内容，但在其基础上进行了很多的增补与修改。CSS3与之前的几个版本相比，其变化是革命性的，让我们看到网页样式发展的前景，让我们更具有方向感、使命感。...
CSS背景属性之颜色渐变
0为红色，0-50为红色到黄色渐变， 100黄色。这里的 to top是默认的值，颜色渐变会从上而下由黄色到绿色有过渡渐变。下面两张效果图，前者是to right，后者是to left。效果图如下，左边是没有角度的，右边是45deg的...
CSS线性渐变和径向渐变详解
第九章：渐变色1.线性渐变1.1.什么是线性渐变1.2线性渐变的写法2.径向渐变2.1什么是径向渐变2.2径向渐变的...创建一个线性渐变，需指定两种及两种以上的颜色进行一个平滑过渡形成的渐变色，可以实现从不同方向、不同角
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章