注册 登录
编程论坛 → VFP论坛

vfp如何用渐进色作图

sam_jiang 发布于 2024-08-18 20:57， 787 次点击
记得windowsAPI里有专门的函数可以在矩形和三角形里作渐进色图，但是我一直没搞懂那几个API函数的参数的结构(vfp里怎么调用)，如果有人知道的，可以说明一下，谢谢！最好给个示例~~~

作为回馈，我把纯用foxpro代码的渐进色作图代码奉上，作为抛砖引玉！

程序代码：

PARAMETERS ndirection

IF PARAMETERS()=0
    ndirection=4 &&这个值1-5，会有不同效果
ENDIF

CLEAR
ncurrentcolor=_screen.ForeColor

_screen.Box(100,100,500,500)
*!*    * 渐变颜色计算
*!*    设定起始颜色
ocolor_begin=NEWOBJECT("color","myclass")
ncolor_begin=GETCOLOR()
ocolor_begin.set(ncolor_begin)

ocolor_end=NEWOBJECT("color","myclass")
ncolor_end=GETCOLOR()
ocolor_end.set(ncolor_end)

nStepRed = (ocolor_end.r - ocolor_begin.r) / 400
nStepGreen = (ocolor_end.g - ocolor_begin.g) / 400
nStepBlue = (ocolor_end.b - ocolor_begin.b) / 400

* 绘制色彩渐变

FOR nX = 100 TO 500
    nRed = ocolor_begin.r + (nX - 100) * nStepRed
    nGreen = ocolor_begin.g + (nX - 100) * nStepGreen
    nBlue = ocolor_begin.b + (nX - 100) * nStepBlue
    _screen.forecolor=RGB(nRed, nGreen, nBlue)
    DO CASE
        CASE ndirection=1 &&水平渐进
            _screen.LINE (nx,100,nx,500)
        CASE ndirection=2 &&垂直渐进
            _screen.LINE (100,nx,500,nx)
        CASE ndirection=3 &&往中间渐变        
            _screen.LINE (100,600-nx , nx, 500)
            _screen.LINE (600-nx,100,500,nx)
        CASE ndirection=4 &&左下到右上对角渐变
            _screen.Line(IIF(nx<=300,100,(nx-300)*2+99),IIF(nx<=300,(300-nx)*2+99,100),;
                        IIF(nx<=300,(nx-100)*2+101,500),IIF(nx<=300,500,500-(nx-300)*2+1))

            _screen.Line(IIF(nx<=300,100,(nx-300)*2+100),IIF(nx<=300,(300-nx)*2+100,100),;
                        IIF(nx<=300,(nx-100)*2+100,500),IIF(nx<=300,500,500-(nx-300)*2))               
        CASE ndirection=5 &&水波渐变
            _screen.LINE (nx,100,nx,500)
            _screen.LINE (100,nx,500,nx)
    ENDCASE
ENDFOR

_screen.ForeColor=ncurrentcolor

15 回复
#2
sam_jiang2024-08-18 21:01
漏了2个重要的类，否则运行不了。。。

struct 类：
程序代码：

**************************************************
*-- 类:           struct (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 父类:  custom
*-- 基类:    custom
*-- 时间戳:   08/14/24 08:01:09 PM
*
DEFINE CLASS struct AS custom


    *-- 用以储存或设置结构体数据
    struct = ""
    Name = "struct"


    *-- 设置结构体
    PROCEDURE set
        RETURN .t.
    ENDPROC


    *-- 获得结构体数据。
    PROCEDURE getstruct
    ENDPROC


ENDDEFINE
*
*-- EndDefine: struct
**************************************************
#3
sam_jiang2024-08-18 21:02
漏了2个重要的类，否则运行不了。。。

color 类：

**************************************************
*-- 类:           color (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 父类:  struct (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 基类:    custom
*-- 时间戳:   08/14/24 06:23:09 PM
*
DEFINE CLASS color AS struct


    *-- 红色
    r = .F.

    *-- 绿色
    g = .F.

    *-- 蓝色
    b = .F.

    *-- alpha透明度
    a = .F.

    *-- 颜色值
    value = .F.


    PROCEDURE getstruct
        this.value=RGB(this.r,this.g,this.b)
        this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(this.a)
        RETURN this.struct
    ENDPROC


    PROCEDURE set
        PARAMETERS nred,ngreen,nblue,nalpha
        DO CASE
            CASE PARAMETERS()=0
                this.value=RGB(this.r,this.g,this.b)
        *!*            this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(0)
            CASE PARAMETERS()=1 &&只有一个参数，要么是颜色结构要么是颜色值
                IF VARTYPE(nred)="N" &&颜色值
                    this.value=nred
                    this.r=MOD(this.value,0x100)
                    this.b=INT(this.value/0x10000)
                    this.g=INT((this.value-this.r-this.b*0x10000)/0x100)
                ELSE
                    IF VARTYPE(nred)="C" AND LEN(nred)=4 &&颜色结构
                        this.struct=nred
                        this.b=ASC(SUBSTR(this.struct,1,1))
                        this.g=ASC(SUBSTR(this.struct,2,1))
                        this.r=ASC(SUBSTR(this.struct,3,1))
                        this.a=ASC(SUBSTR(this.struct,4,1))
                        this.value=RGB(this.r,this.g,this.b)
                    ELSE
                        RETURN .f.
                    ENDIF
                ENDIF
            CASE PARAMETERS()=3
                this.r=nred
                this.g=ngreen
                this.b=nblue
                this.a=0
                this.value=RGB(this.r,this.g,this.b)
        *!*            this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(this.a)
            CASE PARAMETERS()=4
                this.r=nred
                this.g=ngreen
                this.b=nblue
                this.a=nalpha
                this.value=RGB(this.r,this.g,this.b)
        *!*            this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(this.a)
            OTHERWISE
                RETURN .f.
        ENDCASE


    ENDPROC


ENDDEFINE
*
*-- EndDefine: color
**************************************************
#4
schtg2024-08-19 06:42
谢谢分享！
#5
gs25367856782024-08-19 14:36
楼主你好，你的作品我下载后运行，程序提示找不到类
myclass.vcx
不知道这个类在什么地方？
#6
sych2024-08-19 15:12
PARAMETERS ndirection

IF PARAMETERS()=0
    ndirection=4 &&这个值1-5，会有不同效果
ENDIF

CLEAR
ncurrentcolor=_screen.ForeColor

_screen.Box(100,100,500,500)
*!*    * 渐变颜色计算
*!*    设定起始颜色
ocolor_begin=NEWOBJECT("color")
ncolor_begin=GETCOLOR()
ocolor_begin.set(ncolor_begin)

ocolor_end=NEWOBJECT("color")
ncolor_end=GETCOLOR()
ocolor_end.set(ncolor_end)

nStepRed = (ocolor_end.r - ocolor_begin.r) / 400
nStepGreen = (ocolor_end.g - ocolor_begin.g) / 400
nStepBlue = (ocolor_end.b - ocolor_begin.b) / 400

* 绘制色彩渐变

FOR nX = 100 TO 500
    nRed = ocolor_begin.r + (nX - 100) * nStepRed
    nGreen = ocolor_begin.g + (nX - 100) * nStepGreen
    nBlue = ocolor_begin.b + (nX - 100) * nStepBlue
    _screen.forecolor=RGB(nRed, nGreen, nBlue)
    DO CASE
        CASE ndirection=1 &&水平渐进
            _screen.LINE (nx,100,nx,500)
        CASE ndirection=2 &&垂直渐进
            _screen.LINE (100,nx,500,nx)
        CASE ndirection=3 &&往中间渐变        
            _screen.LINE (100,600-nx , nx, 500)
            _screen.LINE (600-nx,100,500,nx)
        CASE ndirection=4 &&左下到右上对角渐变
            _screen.Line(IIF(nx<=300,100,(nx-300)*2+99),IIF(nx<=300,(300-nx)*2+99,100),;
                        IIF(nx<=300,(nx-100)*2+101,500),IIF(nx<=300,500,500-(nx-300)*2+1))

            _screen.Line(IIF(nx<=300,100,(nx-300)*2+100),IIF(nx<=300,(300-nx)*2+100,100),;
                        IIF(nx<=300,(nx-100)*2+100,500),IIF(nx<=300,500,500-(nx-300)*2))               
        CASE ndirection=5 &&水波渐变
            _screen.LINE (nx,100,nx,500)
            _screen.LINE (100,nx,500,nx)
    ENDCASE
ENDFOR

_screen.ForeColor=ncurrentcolor


DEFINE CLASS color AS custom

struct=""

    *-- 红色
    r = .F.

    *-- 绿色
    g = .F.

    *-- 蓝色
    b = .F.

    *-- alpha透明度
    a = .F.

    *-- 颜色值
    value = .F.


    PROCEDURE getstruct
        this.value=RGB(this.r,this.g,this.b)
        this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(this.a)
        RETURN this.struct
    ENDPROC


    PROCEDURE set
        PARAMETERS nred,ngreen,nblue,nalpha
        DO CASE
            CASE PARAMETERS()=0
                this.value=RGB(this.r,this.g,this.b)
        *!*            this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(0)
            CASE PARAMETERS()=1 &&只有一个参数，要么是颜色结构要么是颜色值
                IF VARTYPE(nred)="N" &&颜色值
                    this.value=nred
                    this.r=MOD(this.value,0x100)
                    this.b=INT(this.value/0x10000)
                    this.g=INT((this.value-this.r-this.b*0x10000)/0x100)
                ELSE
                    IF VARTYPE(nred)="C" AND LEN(nred)=4 &&颜色结构
                        this.struct=nred
                        this.b=ASC(SUBSTR(this.struct,1,1))
                        this.g=ASC(SUBSTR(this.struct,2,1))
                        this.r=ASC(SUBSTR(this.struct,3,1))
                        this.a=ASC(SUBSTR(this.struct,4,1))
                        this.value=RGB(this.r,this.g,this.b)
                    ELSE
                        RETURN .f.
                    ENDIF
                ENDIF
            CASE PARAMETERS()=3
                this.r=nred
                this.g=ngreen
                this.b=nblue
                this.a=0
                this.value=RGB(this.r,this.g,this.b)
        *!*            this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(this.a)
            CASE PARAMETERS()=4
                this.r=nred
                this.g=ngreen
                this.b=nblue
                this.a=nalpha
                this.value=RGB(this.r,this.g,this.b)
        *!*            this.struct=CHR(this.b)+CHR(this.g)+CHR(this.r)+CHR(this.a)
            OTHERWISE
                RETURN .f.
        ENDCASE


    ENDPROC


ENDDEFINE
楼上的代码稍加修改
#7
sam_jiang2024-08-19 16:36
回复 5楼 gs2536785678
哈哈，六楼替我回答了。

你也可以自建一个myclass的类，然后加入这连个类。
#8
gs25367856782024-08-19 19:12
非常感谢，这个作品有意思
只有本站会员才能查看附件，请 登录
#9
schtg2024-08-20 07:04
非常好！
#10
gs25367856782024-08-20 08:55
增加了二种渐变方式
    CASE ndirection=6 &&水平往中间渐变
        _SCREEN.LINE (100+INT((nx-100)/2),100 , 100+INT((nx-100)/2), 500)
        _SCREEN.LINE (500-INT((nx-100)/2),100 , 500-INT((nx-100)/2), 500)        
    CASE ndirection=7 &&垂直往中间渐变
        _SCREEN.LINE (100 , 100+INT((nx-100)/2),500, 100+INT((nx-100)/2))
        _SCREEN.LINE (100 ,500-INT((nx-100)/2), 500, 500-INT((nx-100)/2))        
#11
sam_jiang2024-08-20 10:25
鍥炲? 10妤
#12
sam_jiang2024-08-20 19:53
网上找到api函数，以及VB代码，但是用改成vfp好像无法运行，主要是trivertex和gradient_rect两个结构无法理解，用一般的方法转成字符串好像不行，有没有人知道的？

VB申明：
*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

*!*    Public Type TRIVERTEX‘顶点类型
*!*    x As Long
*!*    y As Long
*!*    Red As Integer
*!*    Green As Integer
*!*    Blue As Integer
*!*    Alpha As Integer
*!*    End Type

*!*    Public Type GRADIENT_RECT
*!*    UpperLeft As Long
*!*    LowerRight As Long
*!*    End Type

VFP申明：
Declare integer GradientFillRect IN msimg32 integer, string, integer, string, integer, integer
DECLARE integer GradientFill IN gdi32 integer, string, integer, string, integer, integer
#13
nbwww2024-08-20 20:49
这样试下

DECLARE LONG GradientFillRect IN msimg32 integer, string, integer, string, integer, integer
DECLARE LONG GradientFill IN gdi32 integer, string, integer, string, integer, integer
#14
sych2024-08-20 21:12
Declare long GradientFill IN msimg32.dll long, string @, long, string @, long, long
DECLARE Long ReleaseDC IN WIN32API  Long hWnd, Long hDc
DECLARE INTEGER GetDC IN win32api INTEGER hwnd
DECLARE INTEGER GetDesktopWindow IN win32api
hDc = GetDC(GetDesktopWindow())
tr=BINTOC(300,"4rs")+BINTOC(300,"4rs")+BINTOC(0,"2s")+BINTOC(0,"2s")+BINTOC(255,"2s")+BINTOC(0,"2s")
tr=tr+BINTOC(500,"4rs")+BINTOC(500,"4rs")+BINTOC(0,"2s")+BINTOC(255,"2s")+BINTOC(0,"2s")+BINTOC(0,"2s")
gr=BINTOC(0,"4rs")+BINTOC(1,"4rs")
GradientFill(hdc,@tr,2,@gr,1,1)
ReleaseDC(0,hdc)
#15
sam_jiang2024-08-22 15:24
回复 14楼 sych


我知道错哪里了，掉了2个@ 符号。。。
#16
sam_jiang2024-08-22 20:09
回复 14楼 sych
我想完成在三角形中渐变，但似乎没有成功，提示在dll中找不到入口点
调试时这句出错： GradientFilltriangle(hdc,@cvertex,3,@cg_r,1,2)
我的系统是win7+foxpro 9.0 sp2！

代码如下：

程序代码：

Declare integer GradientFillRect IN msimg32 long, string @, long, string @, long, long
Declare integer GradientFillTriangle in "msimg32" Long, string @, Long, string @, Long, Long
DECLARE integer GradientFill IN msimg32 long, string @, long, string @, long, long
DECLARE integer GetWindowDC IN WIN32API integer
DECLARE integer GetLastError IN WIN32API
DECLARE integer ReleaseDC IN WIN32API integer,integer
DECLARE INTEGER GetDesktopWindow IN win32api
DECLARE INTEGER GetDC IN win32api INTEGER hwnd

clea
hdc=getdc(_screen.hwnd)
overtex=NEWOBJECT("trivertex")
overtex.n=3
overtex.set(1,100,100)
overtex.set(2,500,500)
overtex.set(3,50,400)
cvertex=overtex.getstruct()

og_r=NEWOBJECT("gradient_rect")
og_r.n=3
og_r.set(1,0,1,2)
cg_r=og_r.getstruct()

GradientFilltriangle(hdc,@cvertex,3,@cg_r,1,2)
RELEASE memo like o*
RELEASE memo like c*
releasedc(_screen.hwnd,hdc)

**************************************************
*-- 类:           trivertex (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 父类:  struct (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 基类:    custom
*-- 时间戳:   08/22/24 05:03:08 PM
*
DEFINE CLASS trivertex AS custom


    Height = 22
    Width = 58

    *-- 顶点数，决定所有数组大小，2为矩形，3为三角形，大于3则可以任意组合。
    n = .F.

    *-- 顶点x轴坐标数组
    DIMENSION x[2]

    *-- 顶点y轴坐标数组
    DIMENSION y[2]

    *-- 红色分量数组
    DIMENSION r[2]

    *-- 绿色分量数组
    DIMENSION g[2]

    *-- 蓝色分量数组
    DIMENSION b[2]

    *-- alpha透明度分量数组
    DIMENSION a[2]


    PROCEDURE n_assign
        LPARAMETERS vNewVal
        *To do: 为 Assign 方法程序修改此例程
        IF m.vnewval<>this.n
            DIMENSION this.x[m.vnewval]
            DIMENSION this.y[m.vnewval]
            DIMENSION this.r[m.vnewval]
            DIMENSION this.g[m.vnewval]
            DIMENSION this.b[m.vnewval]
            DIMENSION this.a[m.vnewval]
        ENDIF
        THIS.n = m.vNewVal
    ENDPROC


    PROCEDURE getstruct
        this.struct=''
        FOR i=1 TO this.n
            this.struct=this.struct+;
                BINTOC(this.x[i],[4rs])+;
                BINTOC(this.y[i],[4rs])+;
                BINTOC(this.r[i],[2s])+;
                BINTOC(this.g[i],[2s])+;
                BINTOC(this.b[i],[2s])+;
                BINTOC(this.a[i],[2s])
        ENDFOR

        RETURN this.struct
    ENDPROC


    PROCEDURE set
        *!*********    在设置顶点结构前，需要确定有几个顶点，this.n=? **********!*
        PARAMETERS nindex, x,y,nred,ngreen,nblue,nalpha
        DO CASE
            CASE PARAMETERS()=3
                ocolor=NEWOBJECT([color],[myclass])
                ncolor=GETCOLOR()
                IF ncolor<0
                    RELEASE ocolor,ncolor
                    RETURN .f.
                ELSE
                    ocolor.set(ncolor)
                    this.x[nindex]=x
                    this.y[nindex]=y
                    this.r[nindex]=ocolor.r
                    this.g[nindex]=ocolor.g
                    this.b[nindex]=ocolor.b
                    this.a[nindex]=ocolor.a
                ENDIF
            CASE PARAMETERS()=7
                this.x[nindex]=x
                this.y[nindex]=y
                this.r[nindex]=nred
                this.g[nindex]=ngreen
                this.b[nindex]=nblue
                this.a[nindex]=nalpha
            OTHERWISE
                RETURN .f.
        ENDCASE

    ENDPROC


ENDDEFINE
*
*-- EndDefine: trivertex
**************************************************


**************************************************
*-- 类:           gradient_rect (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 父类:  struct (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 基类:    custom
*-- 时间戳:   08/22/24 07:58:02 PM
*
DEFINE CLASS gradient_rect AS custom


    *-- 确定矩形或三角形顶点的数量，总是2的倍数(长方形)，或3的倍数(三角形)
    n = 2

    *-- 指定顶点结构数组中的索引数组
    DIMENSION nindexs[2]


    PROCEDURE n_assign
        LPARAMETERS vNewVal
        *To do: 为 Assign 方法程序修改此例程
        *事实上矩形的数量可能多于顶点数/2，可能几个矩形共用某个顶点
        IF m.vnewval<>this.n
            DIMENSION this.nindexs[m.vnewval]
        ENDIF
        THIS.n = m.vNewVal
    ENDPROC


    PROCEDURE getstruct
        this.struct=''
        IF ASCAN(this.nindexs,.f.)!=0
            MESSAGEBOX('有未定义的索引！')
        ELSE
            FOR i=1 TO ALEN(this.nindexs)
                this.struct=this.struct+BINTOC(this.nindexs[i],"4rs")
            ENDFOR
        ENDIF

        RETURN this.struct
    ENDPROC


    PROCEDURE set
        PARAMETERS ngroup,nindex1,nindex2,nindex3
        DO CASE
            CASE PARAMETERS()=3 && 说明是矩形
                IF ngroup<=this.n
                    this.nindexs[ngroup*2-1]=nindex1
                    this.nindexs[ngroup*2]=nindex2
                ELSE
                    RETURN .f.
                ENDIF

            CASE PARAMETERS()=4 && 说明是三角形
                IF ngroup<=this.n
                    this.nindexs[ngroup*3-2]=nindex1
                    this.nindexs[ngroup*3-1]=nindex2
                    this.nindexs[ngroup*3]=nindex3
                ELSE
                    RETURN .f.
                ENDIF
            OTHERWISE
            RETURN .f.
        ENDCASE
    ENDPROC


ENDDEFINE
*
*-- EndDefine: gradient_rect
**************************************************



[此贴子已经被作者于2024-8-22 20:15编辑过]
1
©2025, BCCN.NET
电脑版