| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 104 人关注过本帖
标题:改进老外的一个渐进色作图的代码
只看楼主 加入收藏
sam_jiang
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:14
帖 子:948
专家分:1485
注 册:2021-10-13
结帖率:97.44%
收藏
 问题点数:20 回复次数:5 
改进老外的一个渐进色作图的代码
闲来无事,研究老外的winapiviewer,发现一段代码,是有关渐进色作图的,就尝试运行一下,没想到却一个核心程序gdiplus.prg,老外没有提供。。。
源代码如下:
程序代码:
SET PROCEDURE TO gdiplus ADDITIVE &&关键代码缺失。。。
DO declare

PRIVATE gdiplus as gdiplusinit
gdiplus = CREATEOBJECT("gdiplusinit")

LOCAL oBitmap as gdibitmap
cFilename = "gradientsample.png"
nImgWidth = 300
nImgHeight = 300

oBitmap = CREATEOBJECT("gdibitmap",;
    nImgWidth, nImgHeight)

WITH oBitmap
    .graphics.FillRectangle(;
            ARGB(255,255,255, 255),;
            0,;
            0,;
            .imgwidth,;
            .imgheight)
ENDWITH

nPointCount = 128
nRadius = 120
cPoints = GeneratesCirclePoints(;
    nImgWidth/2,;
    nImgHeight/2,;
    nRadius,;
    nPointCount)

hBrush = 0
GdipCreatePathGradientI(;
    @cPoints, nPointCount, 4, @hBrush)

IF hBrush <> 0
    nColor1 = ARGB(0,156,0, 255)
    nColor2 = ARGB(230,255,230, 64)

    GdipSetPathGradientCenterColor(hBrush, nColor1)

    cColors = num2dword(nColor2)
    nColorCount = 1
    GdipSetPathGradientSurroundColorsWithCount(;
        hBrush, @cColors, @nColorCount)

    cPoints = num2dword(130) +;
        num2dword(140)

    GdipSetPathGradientCenterPointI(;
        hBrush, @cPoints)

    GdipFillRectangle(;
        oBitmap.graphics.graphics, hBrush,;
        0, 0, nImgWidth, nImgHeight)

    GdipDeleteBrush(hBrush)
ENDIF

oBitmap.SaveToFile(cFilename)
ShellExecute(0, "open", cFilename, "", "", 3)

oBitmap=NULL
gdiplus=NULL
* [color=#0000FF]end of main[/color]

PROCEDURE GeneratesCirclePoints(;
    nAxisX, nAxisY, nRadius, nPointCount)
* generates a series [color=#0000FF]of points forming a circle[/color]
    LOCAL nStep, nAngle, cResult
    nStep = (2 * PI()) / nPointCount

    cResult = ""
    FOR nAngle = 0 TO (2 * PI()) STEP nStep
        cResult = cResult +;
            num2dword(nAxisX + nRadius * COS(nAngle)) +;
            num2dword(nAxisY + nRadius * SIN(nAngle))
    NEXT
RETURN cResult

PROCEDURE declare
    DECLARE INTEGER ShellExecute IN shell32;
        INTEGER hWindow, STRING lpOperation,;
        STRING lpFile, STRING lpParameters,;
        STRING lpDirectory, INTEGER nShowCmd

    DECLARE INTEGER GdipCreatePathGradientI IN gdiplus;
        STRING @points, INTEGER pointcount,;
        INTEGER wrapMode, INTEGER @polyGradient

    DECLARE INTEGER GdipSetPathGradientCenterColor IN gdiplus;
        INTEGER brush, INTEGER colors

    DECLARE INTEGER GdipSetPathGradientSurroundColorsWithCount;
    IN gdiplus;
        INTEGER brush, STRING @argbColor, INTEGER @colorcount

    DECLARE INTEGER GdipSetPathGradientCenterPointI IN gdiplus;
        INTEGER brush, STRING @points

    DECLARE INTEGER GdipGetPathGradientCenterPointI IN gdiplus;
        INTEGER brush, STRING @points

FUNCTION num2dword(lnValue)
#DEFINE m0 0x0000100
#DEFINE m1 0x0010000
#DEFINE m2 0x1000000
    IF lnValue < 0
        lnValue = 0x100000000 + lnValue
    ENDIF
    LOCAL b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2)/m1)
    b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
    b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)  


于是,斗胆改造了上面这段代码,想看看这段代码的效果,皇天不负有心人啊~~~

改造成功,win7+vfp9.0下编译运行通过!
图片附件: 游客没有浏览图片的权限,请 登录注册

用vfp自带的_gdiplus.vcx改造后的代码如下:
程序代码:
*!*    SET PROCEDURE TO gdiplus ADDITIVE
*!* 源代码的gdiplus.prg 并不存在不知道哪里下载,没法用
*!* 只好用系统自带的_gdiplus.vcx类库

CLEAR ALL
SET CLASSLIB TO _gdiplus addi &&我把这个gdi类库复制到我的工作目录了,你们可以用下面原始位置的类库
*SET CLASSLIB TO HOME() + "FFC\_gdiplus.vcx"
DO declare

*!*    PRIVATE gdiplus as gdiplusinit
*!*    gdiplus = CREATEOBJECT("gdiplusinit")
*!* 摒弃这两句代码

LOCAL loBitmap as gpbitmap
cFilename = "gradientsample.png"
nImgWidth = 300
nImgHeight = 300

loBitmap = CREATEOBJECT("gpbitmap",nImgWidth, nImgHeight) &&创建位图
locolor=CREATEOBJECT("gpcolor",255,255,255,255) &&创建颜色对象用于初始化画布
lopen=CREATEOBJECT("gppen",locolor,2) &&创建实心画笔对象
lobrush=CREATEOBJECT("gpsolidbrush",locolor) &&创建笔刷对象
loGraphics = CREATEOBJECT("gpGraphics")&&创建画布对象
lographics.createfromimage(lobitmap) &&导入位图
loGraphics.fillrectangle(lobrush,0,0,nimgwidth,nimgheight) &&初始化画布,代替下面摒弃的代码
*!*    WITH oBitmap
*!*        .graphics.FillRectangle(;
*!*                ARGB(255,255,255, 255),;
*!*                0,;
*!*                0,;
*!*                .imgwidth,;
*!*                .imgheight)
*!*    ENDWITH
*!* 摒弃上面这段代码

nPointCount = 128
nRadius = 120
cPoints = GeneratesCirclePoints(;
    nImgWidth/2,;
    nImgHeight/2,;
    nRadius,;
    nPointCount)

hBrush = 0
GdipCreatePathGradientI(;
    @cPoints, nPointCount, 4, @hBrush)

IF hBrush <> 0
*!*        nColor1 = ARGB(0,156,0, 255)
*!*        nColor2 = ARGB(230,255,230, 64)
*!* 摒弃上面2句代码

    locolor1=CREATEOBJECT("gpcolor",0,156,0,255)
    ncolor1=locolor1.argb
    locolor2=CREATEOBJECT("gpcolor",230,255,230,64)
    ncolor2=locolor2.argb
    GdipSetPathGradientCenterColor(hBrush, nColor1)
    
    cColors = num2dword(nColor2)
    nColorCount = 1
    GdipSetPathGradientSurroundColorsWithCount(;
        hBrush, @cColors, @nColorCount)
    
    cPoints = num2dword(130) +;
        num2dword(140)

    GdipSetPathGradientCenterPointI(;
        hBrush, @cPoints)
    
    GdipFillRectangle(;
        lographics.gethandle(), hBrush,;
        0, 0, nImgWidth, nImgHeight)
            
    GdipDeleteBrush(hBrush)
    
ENDIF

loBitmap.SaveToFile(cFilename,"image/png","")
ShellExecute(0, "open", cFilename, "", "", 3)

RELEASE ALL LIKE lo*
*!*    oBitmap=NULL
*!*    gdiplus=NULL
* [color=#0000FF]end of main[/color]

PROCEDURE GeneratesCirclePoints(;
    nAxisX, nAxisY, nRadius, nPointCount)
* generates a series [color=#0000FF]of points forming a circle[/color]
    LOCAL nStep, nAngle, cResult
    nStep = (2 * PI()) / nPointCount
    
    cResult = ""
    FOR nAngle = 0 TO (2 * PI()) STEP nStep
        cResult = cResult +;
            num2dword(nAxisX + nRadius * COS(nAngle)) +;
            num2dword(nAxisY + nRadius * SIN(nAngle))
    NEXT
RETURN cResult

PROCEDURE declare
    DECLARE INTEGER ShellExecute IN shell32; 
        INTEGER hWindow, STRING lpOperation,; 
        STRING lpFile, STRING lpParameters,;  
        STRING lpDirectory, INTEGER nShowCmd
        
    DECLARE INTEGER GdipCreatePathGradientI IN gdiplus;
        STRING @points, INTEGER pointcount,;
        INTEGER wrapMode, INTEGER @polyGradient
        
    DECLARE INTEGER GdipSetPathGradientCenterColor IN gdiplus;
        INTEGER brush, INTEGER colors
        
    DECLARE INTEGER GdipSetPathGradientSurroundColorsWithCount;
    IN gdiplus;
        INTEGER brush, STRING @argbColor, INTEGER @colorcount

    DECLARE INTEGER GdipSetPathGradientCenterPointI IN gdiplus;
        INTEGER brush, STRING @points

    DECLARE INTEGER GdipGetPathGradientCenterPointI IN gdiplus;
        INTEGER brush, STRING @points
    *!* 源代码没有什么下面2个api函数
    DECLARE Integer GdipFillRectangle IN gdiplus integer,integer,integer,integer,integer,integer
    DECLARE intege GdipDeleteBrush IN gdiplus integer
    
FUNCTION num2dword(lnValue)
#DEFINE m0 0x0000100
#DEFINE m1 0x0010000
#DEFINE m2 0x1000000
    IF lnValue < 0
        lnValue = 0x100000000 + lnValue
    ENDIF
    LOCAL b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2)/m1)
    b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
    b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

好漂亮的图片。。。
搜索更多相关主题的帖子: LOCAL INTEGER STRING 代码 color 
前天 11:21
sam_jiang
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:14
帖 子:948
专家分:1485
注 册:2021-10-13
收藏
得分:0 
其他方法可以参考这篇文章:https://bbs.bc-cn.net/thread-513922-2-1.html
前天 11:23
schtg
Rank: 13Rank: 13Rank: 13Rank: 13
来 自:Usa
等 级:贵宾
威 望:67
帖 子:2112
专家分:4486
注 册:2012-2-29
收藏
得分:0 
前天 14:43
sam_jiang
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:14
帖 子:948
专家分:1485
注 册:2021-10-13
收藏
得分:0 
找到gdiplus.prg
老外诚不欺我

程序代码:
********************************************************************
* GDI[color=#808080]+ wrapper[/color]
********************************************************************
* Classes defined:
* gdiplusbase, graphics, gdiimage, gdibitmap, gdifontcollection,
* gdifontfamily, gdifont, gdipen, gdimatrix, gdistringformat,
* gdiplusinit
********************************************************************
* an instance [color=#0000FF]of gdiplusinit should be created before[/color]
* [color=#808080]and released after using any of gdi+ objects[/color]
********************************************************************

DEFINE CLASS gdiplusbase As Custom
* abstract base class [color=#0000FF]for graphics, gdiimage, gdifontcollection,[/color]
* gdifontfamily, gdifont [color=#808080]and others[/color]
    errorcode=0
ENDDEFINE

********************************************************************
DEFINE CLASS graphics As gdiplusbase
    SmoothingMode=0
    graphics=0
    hdc=0

PROCEDURE SmoothingMode_ACCESS
    LOCAL nSmoothingMode
    nSmoothingMode = 0

    IF GdipGetSmoothingMode(THIS.graphics, @nSmoothingMode) = 0
        THIS.SmoothingMode = nSmoothingMode
    ENDIF
RETURN THIS.SmoothingMode

PROCEDURE SmoothingMode_ASSIGN(vValue)
    IF VARTYPE(vValue) = "N" AND;
        GdipSetSmoothingMode(THIS.graphics, vValue) = 0
        THIS.SmoothingMode = vValue
    ENDIF

PROCEDURE Init(p1, p2)
    IF PCOUNT()>0
        THIS.CreateGraphics(p1, p2)
    ENDIF

PROCEDURE Destroy
    THIS.ReleaseGraphics
    DODEFAULT()

PROCEDURE ReleaseGraphics
    IF THIS.graphics = 0
        RETURN
    ENDIF

    THIS.ReleaseDC
    = GdipDeleteGraphics(THIS.graphics)
    THIS.graphics=0

FUNCTION CreateGraphics(p1, p2)
#DEFINE OBJ_DC 3
    THIS.ReleaseGraphics

    LOCAL graphics, nObjType
    STORE 0 TO graphics
    nObjType = GetObjectType(m.p1)

    DO CASE
    CASE nObjType=0 AND IsWindow(m.p1)<>0
        THIS.errorcode = GdipCreateFromHWND(m.p1, @graphics)
    CASE nObjType=OBJ_DC AND PCOUNT()=1
        THIS.errorcode = GdipCreateFromHDC(m.p1, @graphics)
    CASE nObjType=OBJ_DC AND PCOUNT()=2
        THIS.errorcode = GdipCreateFromHDC2(m.p1, m.p2, @graphics)
    OTHERWISE
        THIS.errorcode = -1
        RETURN .F.
    ENDCASE
    THIS.graphics = m.graphics
RETURN (THIS.errorcode=0)

PROCEDURE GetDC
    THIS.ReleaseDC
    LOCAL hdc
    hdc=0
    IF THIS.graphics <> 0
        = GdipGetDC(THIS.graphics, @hdc)
    ENDIF
    THIS.hdc = m.hdc
RETURN m.hdc

PROCEDURE ReleaseDC
    IF THIS.hdc <> 0
        = GdipReleaseDC(THIS.graphics, THIS.hdc)
        THIS.hdc=0
    ENDIF

PROCEDURE DrawImage(oImage, nX, nY, nWidth, nHeight)
    IF VARTYPE(nWidth) <> "N"
        nWidth = oImage.imgwidth
    ENDIF
    IF VARTYPE(nHeight) <> "N"
        nHeight = oImage.imgheight
    ENDIF
    THIS.errorcode = GdipDrawImageRectI(THIS.graphics,;
        oImage.himage, m.nX, m.nY, m.nWidth, m.nHeight)

PROCEDURE DrawText(cStr, oFont, p1, p2, p3, p4)
    LOCAL rectf
    IF VARTYPE(m.p1)="O"
        rectf = p1.ToString()
    ELSE
        WITH CREATEOBJECT("rectf", m.p1, m.p2, m.p3, m.p4)
            rectf = .ToString()
        ENDWITH
    ENDIF

    = GdipSetTextRenderingHint(THIS.graphics, 0)  && 0..5

    THIS.errorcode = GdipDrawString(THIS.graphics,;
        ToWideChar(m.cStr), -1, oFont.fnt, @rectf, 0, oFont.brush)
RETURN (THIS.errorcode=0)

FUNCTION MeasureString(cStr, oFont) As RectF
    LOCAL fmt As gdistringformat, oRect, cRectSrc, cRectDst,;
        nCharsFitted, nLinesFitted

    fmt = CREATEOBJECT("gdistringformat", 0)

    oRect = CREATEOBJECT("rectf", 0, 0, 0, 0)
    STORE oRect.ToString() TO cRectSrc, cRectDst

    STORE 0 TO nCharsFitted, nLinesFitted

    THIS.errorcode = GdipMeasureString(THIS.graphics, STRCONV(m.cStr+CHR(0),5),;
        LEN(m.cStr), oFont.fnt, cRectSrc, fmt.fmt, @cRectDst,;
        @nCharsFitted, @nLinesFitted)

    oRect.FromString(m.cRectDst)
RETURN m.oRect

PROCEDURE FillRectangle(p1, p2, p3, p4, p5)
    LOCAL brush
    IF VARTYPE(m.p1)="O"
        brush = p1.brush
    ELSE
        LOCAL oBrush
        oBrush = CREATEOBJECT("gdisolidbrush", m.p1)
        brush = oBrush.brush
    ENDIF

    IF VARTYPE(p2)="O"
        = GdipFillRectangle(THIS.graphics, m.brush,;
            p2.rleft, p2.rtop, p2.rwidth, p2.rheight)
    ELSE
        = GdipFillRectangle(THIS.graphics, m.brush,;
            m.p2, m.p3, m.p4, m.p5)
    ENDIF

PROCEDURE FillEllipse(p1, p2, p3, p4, p5)
    LOCAL brush
    IF VARTYPE(m.p1)="O"
        brush = p1.brush
    ELSE
        LOCAL oBrush
        oBrush = CREATEOBJECT("gdisolidbrush", m.p1)
        brush = oBrush.brush
    ENDIF

    IF VARTYPE(p2)="O"
        = GdipFillEllipse(THIS.graphics, m.brush,;
            p2.rleft, p2.rtop, p2.rwidth, p2.rheight)
    ELSE
        = GdipFillEllipse(THIS.graphics, m.brush,;
            m.p2, m.p3, m.p4, m.p5)
    ENDIF

PROCEDURE DrawRectangle(p1, p2, p3, p4, p5)
    LOCAL nHandle
    IF VARTYPE(m.p1)="O"
        nHandle = p1.hpen
    ELSE
        LOCAL oPenObj
        oPenObj = CREATEOBJECT("gdipen", m.p1, 1)
        nHandle = oPenObj.hpen
    ENDIF

    IF VARTYPE(p2)="O"
        = GdipDrawRectangle(THIS.graphics, m.nHandle,;
            p2.rleft, p2.rtop, p2.rwidth, p2.rheight)
    ELSE
        = GdipDrawRectangle(THIS.graphics, m.nHandle,;
            m.p2, m.p3, m.p4, m.p5)
    ENDIF

PROCEDURE DrawEllipse(p1, p2, p3, p4, p5)
    LOCAL nHandle
    IF VARTYPE(m.p1)="O"
        nHandle = p1.hpen
    ELSE
        LOCAL oPenObj
        oPenObj = CREATEOBJECT("gdipen", m.p1, 1)
        nHandle = oPenObj.hpen
    ENDIF

    IF VARTYPE(p2)="O"
        = GdipDrawEllipse(THIS.graphics, m.nHandle,;
            p2.rleft, p2.rtop, p2.rwidth, p2.rheight)
    ELSE
        = GdipDrawEllipse(THIS.graphics, m.nHandle,;
            m.p2, m.p3, m.p4, m.p5)
    ENDIF

PROCEDURE DrawLine(p1, p2, p3, p4, p5)
    LOCAL nHandle
    IF VARTYPE(m.p1)="O"
        nHandle = p1.hpen
    ELSE
        LOCAL oPenObj
        oPenObj = CREATEOBJECT("gdipen", m.p1, 1)
        nHandle = oPenObj.hpen
    ENDIF

    IF VARTYPE(p2)="O"
        = GdipDrawLine(THIS.graphics, m.nHandle,;
            p2.rleft, p2.rtop, p2.rwidth, p2.rheight)
    ELSE
        = GdipDrawLine(THIS.graphics, m.nHandle,;
            m.p2, m.p3, m.p4, m.p5)
    ENDIF

PROCEDURE SetTransform(vMatrix)
    DO CASE
    CASE VARTYPE(m.vMatrix) = "O"
        THIS.errorcode = GdipSetWorldTransform(;
            THIS.graphics, vMatrix.hmatrix)
    CASE VARTYPE(m.vMatrix) = "N"
        THIS.errorcode = GdipSetWorldTransform(;
            THIS.graphics, m.vMatrix)
    ENDCASE

PROCEDURE ResetTransform
    THIS.errorcode=GdipResetWorldTransform(;
        THIS.graphics)

ENDDEFINE

********************************************************************
DEFINE CLASS gdidbrush As gdiplusbase
    brush=0
PROCEDURE Destroy
    THIS.ReleaseBrush
PROTECTED PROCEDURE ReleaseBrush
    IF THIS.brush <> 0
        = GdipDeleteBrush(THIS.brush)
        THIS.brush=0
    ENDIF
ENDDEFINE

DEFINE CLASS gdisolidbrush As gdidbrush
PROCEDURE Init(argbcolor)
    IF VARTYPE(m.argbcolor) <> "N"
        argbcolor=0
    ENDIF
    THIS.SetBrushColor(argbcolor)

PROCEDURE SetBrushColor(argbcolor)
    THIS.ReleaseBrush
    LOCAL brush
    brush=0
    THIS.errorcode = GdipCreateSolidFill(m.argbcolor, @brush)
    THIS.brush = m.brush
RETURN (THIS.errorcode=0)

ENDDEFINE

********************************************************************
DEFINE CLASS gdiimage As gdiplusbase
    himage=0
    hbitmap=0
    filename=""
    imgtype=0
    imgwidth=0
    imgheight=0
    imgflags=0
    guid=""
    graphics=0

PROCEDURE Init(p1, p2, p3, p4, p5, p6)
    DO CASE
    CASE PCOUNT()=1 AND VARTYPE(p1)="C"
        THIS.CreateFromFile(p1)
    CASE PCOUNT()=1 AND VARTYPE(p1)="N"
        THIS.CreateFromHandle(p1)
    CASE PCOUNT()=1 AND VARTYPE(p1)="O"
        THIS.CloneFromGdiBitmap1(p1)
    CASE PCOUNT()>1 AND VARTYPE(p1)="O"
        THIS.CloneFromGdiBitmap2(p1, p2, p3, p4, p5, p6)
    ENDCASE

PROCEDURE Destroy
    THIS.ReleaseImage
    DODEFAULT()

PROCEDURE ReleaseImage
#DEFINE OBJ_BITMAP 7
    IF VARTYPE(THIS.graphics)="O"
        THIS.graphics=0
    ENDIF
    IF THIS.himage <> 0
        = GdipDisposeImage(THIS.himage)
        THIS.himage=0
    ENDIF
    IF THIS.hbitmap <> 0
        IF GetObjectType(THIS.hbitmap)=OBJ_BITMAP
            = DeleteObject(THIS.hbitmap)
        ENDIF
        THIS.hbitmap=0
    ENDIF
    THIS.filename=""
    THIS.imgtype=0
    THIS.imgwidth=0
    THIS.imgheight=0
    THIS.imgflags=0
    THIS.guid=""
    THIS.errorcode = 0

FUNCTION CreateFromFile(cFile)
    THIS.ReleaseImage
    THIS.filename = m.cFile

    LOCAL img, imgtype, imgwidth, imgheight, imgflags, guid
    STORE 0 TO img, imgtype, imgwidth, imgheight, imgflags

    TRY
        THIS.errorcode = GdipLoadImageFromFile(;
            ToWideChar(cFile), @img)
    CATCH
        THIS.errorcode =-1
    ENDTRY

    THIS.himage=m.img
    THIS.GetImageParameters
RETURN (THIS.himage<>0)

FUNCTION CreateFromHandle(img)
    THIS.ReleaseImage
    THIS.himage=m.img
    THIS.GetImageParameters
    IF THIS.imgtype <> 0
        RETURN .T.
    ELSE
        THIS.ReleaseImage
        RETURN .F.
    ENDIF

FUNCTION CloneFromGdiBitmap1(src)
    LOCAL srcHBitmap, dstHImage, dst
    srcHBitmap = src.GetHBITMAP()
    IF srcHBitmap <> 0
        dstHImage=0
        THIS.errorcode = GdipCreateBitmapFromHBITMAP(;
            m.srcHBitmap, 0, @dstHImage)
        IF THIS.errorcode = 0
            RETURN THIS.CreateFromHandle(dstHImage)
        ENDIF
    ENDIF
RETURN .F.

FUNCTION CloneFromGdiBitmap2(src, dstfmt, x0, y0, dstwidth, dstheight)
    LOCAL dstHImage
    dstHImage = 0
    THIS.errorcode = GdipCloneBitmapArea(;
        m.x0, m.y0, m.dstwidth, m.dstheight,;
        dstfmt, src.himage, @dstHImage)
    IF THIS.errorcode = 0
        RETURN THIS.CreateFromHandle(dstHImage)
    ENDIF
RETURN .F.

PROTECTED PROCEDURE GetImageParameters
    LOCAL imgtype, imgwidth, imgheight, imgflags, guid, graphics
    STORE 0 TO imgtype, imgwidth, imgheight, imgflags, graphics
    guid = REPLICATE(CHR(0), 16)

    IF THIS.himage <> 0
        = GdipGetImageType(THIS.himage, @m.imgtype)
        = GdipGetImageWidth(THIS.himage, @m.imgwidth)
        = GdipGetImageHeight(THIS.himage, @m.imgheight)
        = GdipGetImageFlags(THIS.himage, @m.imgflags)
        = GdipGetImageRawFormat(THIS.himage, @m.guid)
    ENDIF
    THIS.imgtype = m.imgtype
    THIS.imgwidth = m.imgwidth
    THIS.imgheight = m.imgheight
    THIS.imgflags = m.imgflags
    THIS.guid = m.guid

    IF VARTYPE(THIS.graphics) = "N"
        THIS.errorcode =;
            GdipGetImageGraphicsContext(THIS.himage, @graphics)
        IF THIS.errorcode = 0
        * 3=OutOfMemory
            THIS.graphics = CREATEOBJECT("graphics")
            THIS.graphics.graphics = m.graphics
        ENDIF
    ENDIF

FUNCTION GetHBITMAP
    LOCAL hbitmap
    hbitmap=0
    IF THIS.hbitmap = 0
        THIS.errorcode = GdipCreateHBITMAPFromBitmap(;
            THIS.himage, @hbitmap, 0)
        IF THIS.errorcode = 0
            THIS.hbitmap = m.hbitmap
        ENDIF
    ENDIF
RETURN THIS.hbitmap

PROCEDURE CreateHICON
    LOCAL hIcon
    hIcon=0
    THIS.errorcode = GdipCreateHICONFromBitmap(;
        THIS.himage, @hIcon)
RETURN m.hIcon

FUNCTION SaveToFile(cTargetFile)
#DEFINE ccEncoderBitmap "{557cf400-1a04-11d3-9a73-0000f81ef32e}"
#DEFINE ccEncoderJpeg   "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
#DEFINE ccEncoderGif    "{557cf402-1a04-11d3-9a73-0000f81ef32e}"
#DEFINE ccEncoderTiff   "{557cf405-1a04-11d3-9a73-0000f81ef32e}"
#DEFINE ccEncoderPng    "{557cf406-1a04-11d3-9a73-0000f81ef32e}"
    LOCAL cType, cEncoder
    cType = UPPER(ALLTRIM(SUBSTR(cTargetFile,;
        RAT(".",cTargetFile)+1)))

    DO CASE
    CASE cType == "BMP"
        cEncoder=StringToCLSID(ccEncoderBitmap)
    CASE cType == "JPG" OR cType == "JPEG"
        cEncoder=StringToCLSID(ccEncoderJpeg)
    CASE cType == "GIF"
        cEncoder=StringToCLSID(ccEncoderGif)
    CASE cType == "TIF" OR cType == "TIFF"
        cEncoder=StringToCLSID(ccEncoderTiff)
    CASE cType == "PNG"
        cEncoder=StringToCLSID(ccEncoderPng)
    OTHERWISE
        THIS.errorcode=-1
        RETURN .F.
    ENDCASE
    THIS.errorcode = GdipSaveImageToFile(THIS.himage,;
        ToWideChar(m.cTargetFile), m.cEncoder, 0)
RETURN (THIS.errorcode=0)
ENDDEFINE

********************************************************************
DEFINE CLASS gdibitmap As gdiimage

PROCEDURE Init(p1, p2)
    IF PCOUNT()=2 AND VARTYPE(p1)="N" AND VARTYPE(p2)="N"
        THIS.CreateBitmap(p1, p2)
    ENDIF

PROCEDURE CreateBitmap(nWidth, nHeight)
RETURN THIS.CreateFromHWND(nWidth, nHeight, GetDesktopWindow())

PROCEDURE CreateFromHWND(nWidth, nHeight, hwindow)
    LOCAL gr, lResult
    gr = CREATEOBJECT("graphics", m.hwindow)
    lResult = THIS.CreateFromGraphics(nWidth, nHeight, gr.graphics)
RETURN m.lResult

PROCEDURE CreateFromGraphics(nWidth, nHeight, graphics)
    LOCAL img
    img=0
    THIS.errorcode = GdipCreateBitmapFromGraphics(;
        m.nWidth, m.nHeight, m.graphics, @img)
    IF THIS.errorcode = 0
        RETURN THIS.CreateFromHandle(m.img)
    ELSE
        RETURN .F.
    ENDIF

PROCEDURE CreateFromHBITMAP(hBitmap)
    LOCAL img
    img=0
    THIS.errorcode = GdipCreateBitmapFromHBITMAP(;
        m.hBitmap, 0, @m.img)
    IF THIS.errorcode = 0
        RETURN THIS.CreateFromHandle(m.img)
    ELSE
        RETURN .F.
    ENDIF

PROCEDURE CreateFromHICON(hIcon)
    LOCAL img
    img=0
    THIS.errorcode = GdipCreateBitmapFromHICON(;
        m.hIcon, @m.img)
    IF THIS.errorcode = 0
        RETURN THIS.CreateFromHandle(m.img)
    ELSE
        RETURN .F.
    ENDIF

PROCEDURE CreateFromBITMAPINFO(hBitmapinfo, hBitmapdata)
#DEFINE BITMAPINFOHEADER_SIZE 40
    IF VARTYPE(hBitmapdata) <> "N" OR hBitmapdata=0
    * simplified: null color table is assumed
        hBitmapdata = hBitmapinfo +;
            BITMAPINFOHEADER_SIZE
    ENDIF
    LOCAL img
    img=0
    THIS.errorcode = GdipCreateBitmapFromGdiDib(hBitmapinfo,;
        hBitmapdata, @img)
    IF THIS.errorcode = 0
        RETURN THIS.CreateFromHandle(m.img)
    ELSE
        RETURN .F.
    ENDIF

ENDDEFINE

********************************************************************
DEFINE CLASS gdifontcollection As gdiplusbase
* collection [color=#0000FF]of fonts installed on the system[/color]
    fontfamilies=0

PROCEDURE Init
    THIS.GetFontFamilies

PROCEDURE GetFontFamily(vFamilyName)
    LOCAL oFamily, ex as Exception
    TRY
        oFamily = THIS.fontfamilies.Item(vFamilyName)
    CATCH TO ex
        IF VARTYPE(vFamilyName)="C"
            oFamily = THIS.GetFamilyByName(vFamilyName)
        ELSE
            oFamily = CREATEOBJECT("gdifontfamily")
        ENDIF
    ENDTRY
RETURN m.oFamily

PROTECTED PROCEDURE GetFamilyByName(cFamilyName)
    cFamilyName = LOWER(ALLTRIM(m.cFamilyName))
    LOCAL oFamily As gdifontfamily
    FOR EACH oFamily IN THIS.fontfamilies
        IF LOWER(oFamily.familyname) = m.cFamilyName
            RETURN oFamily
        ENDIF
    NEXT
    oFamily = CREATEOBJECT("gdifontfamily")
RETURN m.oFamily

PROTECTED PROCEDURE GetFontFamilies
    THIS.fontfamilies = CREATEOBJECT("Collection")

    LOCAL fonts, familycount, cBuffer, hfontfamily, nIndex
    STORE 0 TO fonts, familycount
    = GdipNewInstalledFontCollection(@fonts)
    = GdipGetFontCollectionFamilyCount(fonts, @familycount)

    cBuffer = REPLICATE(CHR(0), m.familycount*4)
    = GdipGetFontCollectionFamilyList(fonts, familycount,;
        @cBuffer, @familycount)
    FOR nIndex=0 TO familycount-1
        LOCAL oFontFamily
        hfontfamily = buf2dword(SUBSTR(cBuffer,;
            nIndex*4+1,4))
        oFontFamily = CREATEOBJECT("gdifontfamily", m.hfontfamily)
        THIS.fontfamilies.Add(oFontFamily, oFontFamily.familyname)
    NEXT
ENDDEFINE

********************************************************************
DEFINE CLASS gdifontfamily As gdiplusbase
    hfontfamily=0
    familyname=""
    hasregular=.F.
    hasbold=.F.
    hasitalic=.F.
    hasbolditalic=.F.
    hasunderline=.F.
    hasstrikeout=.F.

PROCEDURE Init(hfontfamily)
    IF VARTYPE(m.hfontfamily)="N"
        THIS.hfontfamily = m.hfontfamily
        THIS.GetFamilyData
    ENDIF

PROTECTED PROCEDURE GetFamilyData
#DEFINE LF_FACESIZE 32
    LOCAL familyname, langid
    langid = VAL(SYS(3004))
    familyname = REPLICATE(CHR(0), (LF_FACESIZE+1)*2)  && widechar
    = GdipGetFamilyName(THIS.hfontfamily, @m.familyname, m.langid)
    THIS.familyname = STRCONV(m.familyname,6)
    THIS.hasregular=THIS.IsStyleAvailable(0)
    THIS.hasbold=THIS.IsStyleAvailable(1)
    THIS.hasitalic=THIS.IsStyleAvailable(2)
    THIS.hasbolditalic=THIS.IsStyleAvailable(3)
    THIS.hasunderline=THIS.IsStyleAvailable(4)
    THIS.hasstrikeout=THIS.IsStyleAvailable(8)

PROTECTED FUNCTION IsStyleAvailable(nStyle)
    LOCAL nAvailable
    nAvailable=0
    = GdipIsStyleAvailable(THIS.hfontfamily, nStyle, @nAvailable)
RETURN (nAvailable<>0)
ENDDEFINE

********************************************************************
DEFINE CLASS gdifont As gdiplusbase
PROTECTED fontfamilycreated
    hfontfamily=0
    fnt=0
    brush=0

PROCEDURE Init(vFamily, fntsize, fntstyle, argbcolor)
    DO CASE
    CASE PCOUNT()=0
        THIS.InitFont("Arial", 10, 0, ARGB(0,0,0))
    CASE PCOUNT()=1
        THIS.InitFont(vFamily, 10, 0, ARGB(0,0,0))
    CASE PCOUNT()=2
        THIS.InitFont(vFamily, fntsize, 0, ARGB(0,0,0))
    CASE PCOUNT()=3
        THIS.InitFont(vFamily, fntsize, fntstyle, ARGB(0,0,0))
    CASE PCOUNT()=4
        THIS.InitFont(vFamily, fntsize, fntstyle, argbcolor)
    ENDCASE

PROTECTED PROCEDURE InitFont(vFamily, fntsize, fntstyle, argbcolor)
    THIS.ClearFont

    DO CASE
    CASE VARTYPE(m.vFamily)="O"
        THIS.hfontfamily = vFamily.hfontfamily
    CASE VARTYPE(m.vFamily)="N"
        THIS.hfontfamily = m.vFamily
    CASE VARTYPE(m.vFamily)="C"
        LOCAL hfontfamily
        hfontfamily=0
        THIS.errorcode = GdipCreateFontFamilyFromName(;
            ToWideChar(m.vFamily), 0, @m.hfontfamily)
        THIS.hfontfamily = m.hfontfamily
        THIS.fontfamilycreated=.T.
    OTHERWISE
        RETURN .F.
    ENDCASE

    LOCAL brush, fnt
    STORE 0 TO brush, fnt
    = GdipCreateSolidFill(m.argbcolor, @brush)

    THIS.errorcode = GdipCreateFont(THIS.hfontfamily,;
        m.fntsize, m.fntstyle, 3, @m.fnt)

    THIS.fnt = m.fnt
    THIS.brush = m.brush
RETURN (THIS.errorcode=0)

PROCEDURE Destroy
    THIS.ClearFont

PROCEDURE ClearFont
    IF THIS.brush <> 0
        = GdipDeleteBrush(THIS.brush)
        THIS.brush=0
    ENDIF
    IF THIS.fnt <> 0
        = GdipDeleteFont(THIS.fnt)
        THIS.fnt=0
    ENDIF
    IF THIS.hfontfamily <> 0 AND THIS.fontfamilycreated
        = GdipDeleteFontFamily(THIS.hfontfamily)
        THIS.hfontfamily=0
    ENDIF
    THIS.fontfamilycreated=.F.
ENDDEFINE

********************************************************************
DEFINE CLASS gdipen As gdiplusbase
    hpen=0

PROCEDURE Init(nArgbcolor, nPenWidth)
    LOCAL hpen
    hpen=0
    THIS.errorcode = GdipCreatePen1(nArgbcolor, nPenWidth, 0, @hpen)
    THIS.hpen = m.hpen

PROCEDURE Destroy
    IF THIS.hpen <> 0
        = GdipDeletePen(THIS.hpen)
        THIS.hpen=0
    ENDIF

ENDDEFINE

********************************************************************
DEFINE CLASS gdimatrix As gdiplusbase
    hmatrix=0
    m11=0
    m12=0
    m21=0
    m22=0
    dx=0
    dy=0

PROCEDURE Init(m11, m12, m21, m22, dx, dy)
    LOCAL hmatrix
    hmatrix=0

    IF VARTYPE(m.m11)="N" AND VARTYPE(m.m12)="N";
        AND VARTYPE(m.m21)="N" AND VARTYPE(m.m22)="N"

        IF VARTYPE(m.dx) <> "N"
            dx = 0
        ENDIF
        IF VARTYPE(m.dy) <> "N"
            dy = 0
        ENDIF

        THIS.errorcode = GdipCreateMatrix2(m11, m12,;
            m21, m22, dx, dy, @m.hmatrix)
    ELSE
    * creates identity matrix [(1,0), (0,1)] zero offset
        THIS.errorcode = GdipCreateMatrix(@m.hmatrix)
    ENDIF

    THIS.hmatrix = m.hmatrix
    THIS.GetElements

PROCEDURE Destroy
    IF THIS.hmatrix <> 0
        = GdipDeleteMatrix(THIS.hmatrix)
        THIS.hmatrix=0
    ENDIF

PROCEDURE SetElements(m11, m12, m21, m22, dx, dy)
    IF VARTYPE(m.dx) <> "N"
        dx = 0
    ENDIF
    IF VARTYPE(m.dy) <> "N"
        dy = 0
    ENDIF

    THIS.errorcode = GdipSetMatrixElements(THIS.hmatrix,;
        m.m11, m.m12, m.m21, m.m22, m.dx, m.dy)

PROCEDURE GetElements
    LOCAL cCoords
    cCoords = REPLICATE(CHR(0), 24)
    THIS.errorcode = GdipGetMatrixElements(THIS.hmatrix, @m.cCoords)

    IF THIS.errorcode = 0
        THIS.m11 = Float2Int(buf2dword(SUBSTR(m.cCoords, 1,4)))
        THIS.m12 = Float2Int(buf2dword(SUBSTR(m.cCoords, 5,4)))
        THIS.m21 = Float2Int(buf2dword(SUBSTR(m.cCoords, 9,4)))
        THIS.m22 = Float2Int(buf2dword(SUBSTR(m.cCoords, 13,4)))
        THIS.dx = Float2Int(buf2dword(SUBSTR(m.cCoords, 17,4)))
        THIS.dy = Float2Int(buf2dword(SUBSTR(m.cCoords, 21,4)))
    ENDIF

PROCEDURE Translate(nOffsetX, nOffsetY, nOrder)
    IF VARTYPE(m.nOrder) <> "N"
        nOrder=0
    ENDIF
    THIS.errorcode = GdipTranslateMatrix(THIS.hmatrix,;
        m.nOffsetX, m.nOffsetY, m.nOrder)

PROCEDURE Scale(nScaleX, nScaleY, nOrder)
    IF VARTYPE(m.nOrder) <> "N"
        nOrder=0
    ENDIF
    THIS.errorcode = GdipScaleMatrix(THIS.hmatrix,;
        m.nScaleX, m.nScaleY, m.nOrder)

PROCEDURE Shear(nShearX, nShearY, nOrder)
    IF VARTYPE(m.nOrder) <> "N"
        nOrder=0
    ENDIF
    THIS.errorcode = GdipShearMatrix(THIS.hmatrix,;
        m.nShearX, m.nShearY, m.nOrder)

PROCEDURE Rotate(nAngle, nOrder)
    IF VARTYPE(m.nOrder) <> "N"
        nOrder=0
    ENDIF
    THIS.errorcode = GdipRotateMatrix(THIS.hmatrix,;
        m.nAngle, m.nOrder)

PROCEDURE Invert
    THIS.errorcode = GdipInvertMatrix(THIS.hmatrix)

ENDDEFINE

********************************************************************
DEFINE CLASS gdistringformat As gdiplusbase
#DEFINE LANG_NEUTRAL 0
    fmt=0

PROCEDURE Init(nAttributes)
    LOCAL nFmt
    nFmt=0
    THIS.errorcode = GdipCreateStringFormat(nAttributes, LANG_NEUTRAL, @nFmt)
    THIS.fmt=m.nFmt

PROCEDURE Destroy
    IF THIS.fmt <> 0
        = GdipDeleteStringFormat(THIS.fmt)
        THIS.fmt=0
    ENDIF

ENDDEFINE

***未完待续***


也就是说,最开始那段代码也可以运行了~~~
前天 20:24
sam_jiang
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:14
帖 子:948
专家分:1485
注 册:2021-10-13
收藏
得分:0 
因为发帖字数限制,继续发剩下的代码~
程序代码:
********************************************************************
***加入刚才的代码后面吧***
DEFINE CLASS gdiplusinit As Custom
* an instance [color=#0000FF]of gdiplusinit should be created before[/color]
* [color=#808080]and released after using any of gdi+ objects[/color]
PROTECTED hToken
    errorcode=0
    initialized=.F.

PROCEDURE Init
    THIS.declare
    THIS.initialized = THIS.InitGDIplus()

PROCEDURE Destroy
    THIS.ReleaseGDIplus

PROTECTED FUNCTION InitGDIplus
    LOCAL hToken, cInput
    hToken=0
    cInput = PADR(CHR(1),16,CHR(0))
    TRY
        THIS.errorcode = GdiplusStartup(@hToken, @cInput, 0)
    CATCH
        THIS.errorcode = -1
    ENDTRY
    THIS.hToken=hToken
RETURN (THIS.errorcode=0)

PROTECTED PROCEDURE ReleaseGDIplus
    IF THIS.hToken <> 0
        = GdiplusShutdown(THIS.hToken)
        THIS.hToken=0
    ENDIF

PROCEDURE decl
THIS.declare

PROCEDURE declare
    DECLARE INTEGER IsWindow IN user32 INTEGER hwnd
    DECLARE INTEGER GetDesktopWindow IN user32
    DECLARE INTEGER GetObjectType IN gdi32 INTEGER hObject
    DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
    DECLARE INTEGER GdipDeleteFont IN gdiplus INTEGER fnt
    DECLARE INTEGER GdipDeleteFontFamily IN gdiplus INTEGER FontFamily
    DECLARE INTEGER GdiplusShutdown IN gdiplus INTEGER token
    DECLARE INTEGER GdipDeleteGraphics IN gdiplus INTEGER graphics
    DECLARE INTEGER GdipDeletePen IN gdiplus INTEGER gdipen
    DECLARE INTEGER GdipDeleteBrush IN gdiplus INTEGER brush
    DECLARE INTEGER CLSIDFromString IN ole32 STRING lpsz, STRING @pclsid
    DECLARE INTEGER GdipCreateMatrix IN gdiplus INTEGER @matrix
    DECLARE INTEGER GdipDeleteMatrix IN gdiplus INTEGER matrix
    DECLARE INTEGER GdipDeleteStringFormat IN gdiplus INTEGER fmt
    DECLARE INTEGER GdipInvertMatrix IN gdiplus INTEGER matrix

    DECLARE INTEGER GdipSetSmoothingMode IN gdiplus;
        INTEGER graphics, INTEGER smoothingMode

    DECLARE INTEGER GdipGetSmoothingMode IN gdiplus;
        INTEGER graphics, INTEGER @smoothingMode

    DECLARE INTEGER GdipCreateMatrix2 IN gdiplus;
        SINGLE m11, SINGLE m12, SINGLE m21, SINGLE m22,;
        SINGLE dx, SINGLE dy, INTEGER @matrix

    DECLARE INTEGER GdipMeasureString IN gdiplus;
        INTEGER graphics, STRING txt, INTEGER length,;
        INTEGER fnt, STRING layoutRect, INTEGER stringFormat,;
        STRING @boundingBox, INTEGER @codepointsFitted,;
        INTEGER @linesFilled

    DECLARE INTEGER GdipCreateStringFormat IN gdiplus;
        INTEGER formatAttributes, INTEGER language, INTEGER @

    DECLARE INTEGER GdipCreateSolidFill IN gdiplus;
        INTEGER clr, INTEGER @brush

    DECLARE INTEGER GdiplusStartup IN gdiplus;
        INTEGER @token, STRING @input, INTEGER output

    DECLARE INTEGER StringFromGUID2 IN ole32;
        STRING rguid, STRING @lpsz, INTEGER cchMax

    DECLARE INTEGER GdipCreateFromHDC IN gdiplus;
        INTEGER hdc, INTEGER @graphics

    DECLARE INTEGER GdipCreateFromHWND IN gdiplus;
        INTEGER hWindow, INTEGER @graphics

    DECLARE INTEGER GdipCreateFromHDC2 IN gdiplus;
        INTEGER hdc, INTEGER hDevice, INTEGER @graphics

    DECLARE INTEGER GdipLoadImageFromFile IN gdiplus;
        STRING filename, INTEGER @img

    DECLARE INTEGER GdipDisposeImage IN gdiplus INTEGER img

    DECLARE INTEGER GdipGetImageType IN gdiplus;
        INTEGER img, INTEGER @imgtype

    DECLARE INTEGER GdipGetImageWidth IN gdiplus;
        INTEGER img, INTEGER @imgwidth

    DECLARE INTEGER GdipGetImageHeight IN gdiplus;
        INTEGER img, INTEGER @imgheight

    DECLARE INTEGER GdipGetImageFlags IN gdiplus;
        INTEGER img, INTEGER @imgflags

    DECLARE INTEGER GdipGetImageRawFormat IN gdiplus;
        INTEGER img, STRING @guid

    DECLARE INTEGER GdipDrawImageRectI IN gdiplus;
        INTEGER graphics, INTEGER img, INTEGER x, INTEGER y,;
        INTEGER imgwidth, INTEGER imgheight

    DECLARE INTEGER GdipSaveImageToFile IN gdiplus;
        INTEGER img, STRING filename,;
        STRING clsidEncoder, INTEGER encoderParams

    DECLARE INTEGER GdipCreateBitmapFromHBITMAP IN gdiplus;
        INTEGER hbm, INTEGER hpal, INTEGER @hbitmap

    DECLARE INTEGER GdipCreateBitmapFromHICON IN gdiplus;
        INTEGER hicon, INTEGER @hbitmap

    DECLARE INTEGER GdipCreateHICONFromBitmap IN gdiplus;
        INTEGER hbitmap, INTEGER @hbmReturn

    DECLARE INTEGER GdipCreateBitmapFromGdiDib IN gdiplus;
        INTEGER gdiBitmapInfo, INTEGER gdiBitmapData, INTEGER @hBitmap

    DECLARE INTEGER GdipCreateHBITMAPFromBitmap IN gdiplus;
        INTEGER bitmap, INTEGER @hbmReturn, INTEGER background

    DECLARE INTEGER GdipCreateBitmapFromGraphics IN gdiplus;
        INTEGER width, INTEGER height,;
        INTEGER graphics, INTEGER @bitmap

    DECLARE INTEGER GdipCloneBitmapArea IN gdiplus;
        SINGLE x, SINGLE y, SINGLE width, SINGLE height,;
        INTEGER fmt, INTEGER srcBitmap, INTEGER @dstBitmap

    DECLARE INTEGER GdipGetImageGraphicsContext IN gdiplus;
        INTEGER img, INTEGER @graphics

    DECLARE INTEGER GdipGetDC IN gdiplus;
        INTEGER graphics, INTEGER @hdc

    DECLARE INTEGER GdipReleaseDC IN gdiplus;
        INTEGER graphics, INTEGER hdc

    DECLARE INTEGER GdipCreateFont IN gdiplus;
        INTEGER fontFamily, SINGLE emSize,;
        INTEGER fontstyle, INTEGER unit, INTEGER @fnt

    DECLARE INTEGER GdipCreateFontFamilyFromName IN gdiplus;
        STRING familyname, INTEGER fontCollection, INTEGER @FontFamily

    DECLARE INTEGER GdipCreatePen1 IN gdiplus;
        INTEGER color, SINGLE penwidth, INTEGER unit, INTEGER @gdipen

    DECLARE INTEGER GdipFillRectangle IN gdiplus;
        INTEGER graphics, INTEGER brush,;
        SINGLE x, SINGLE y, SINGLE width, SINGLE height

    DECLARE INTEGER GdipFillEllipse IN gdiplus;
        INTEGER graphics, INTEGER brush,;
        SINGLE x, SINGLE y, SINGLE width, SINGLE height

    DECLARE GdipDrawRectangle IN gdiplus;
        INTEGER graphics, INTEGER gdipen,;
        SINGLE x, SINGLE y, SINGLE width, SINGLE height

    DECLARE GdipDrawEllipse IN gdiplus;
        INTEGER graphics, INTEGER gdipen,;
        SINGLE x, SINGLE y, SINGLE width, SINGLE height

    DECLARE GdipDrawLine IN gdiplus;
        INTEGER graphics, INTEGER gdipen,;
        SINGLE x, SINGLE y, SINGLE width, SINGLE height

    DECLARE INTEGER GdipDrawString IN gdiplus;
        INTEGER graphics, STRING widechar, INTEGER length,;
        INTEGER fnt, STRING @rect, INTEGER stringFormat, INTEGER brush

    DECLARE INTEGER GdipSetTextRenderingHint IN gdiplus;
        INTEGER graphics, INTEGER TextRenderingHint

    DECLARE INTEGER GdipNewInstalledFontCollection IN gdiplus;
        INTEGER @fontCollection

    DECLARE INTEGER GdipGetFontCollectionFamilyCount IN gdiplus;
        INTEGER fontCollection, INTEGER @numFound

    DECLARE INTEGER GdipGetFontCollectionFamilyList IN gdiplus;
        INTEGER fontCollection, INTEGER numSought,;
        STRING @gpfamilies, INTEGER @numFound

    DECLARE INTEGER GdipGetFamilyName IN gdiplus;
        INTEGER fontfamily, STRING @familyname, INTEGER language

    DECLARE INTEGER GdipIsStyleAvailable IN gdiplus;
        INTEGER fontfamily, INTEGER fontstyle, INTEGER @IsStyleAvail

    DECLARE INTEGER GdipSetWorldTransform IN gdiplus;
        INTEGER graphics, INTEGER matrix

    DECLARE INTEGER GdipResetWorldTransform IN gdiplus;
        INTEGER graphics

    DECLARE INTEGER GdipRotateMatrix IN gdiplus;
        INTEGER matrix, SINGLE angle, INTEGER ord

    DECLARE INTEGER GdipTranslateMatrix IN gdiplus;
        INTEGER matrix, SINGLE offsetX,;
        SINGLE offsetY, INTEGER ord

    DECLARE INTEGER GdipScaleMatrix IN gdiplus;
        INTEGER matrix, SINGLE scaleX,;
        SINGLE scaleY, INTEGER ord

    DECLARE INTEGER GdipShearMatrix IN gdiplus;
        INTEGER matrix, SINGLE shearX,;
        SINGLE shearY, INTEGER ord

    DECLARE INTEGER GdipSetMatrixElements IN gdiplus;
        INTEGER matrix, SINGLE m11, SINGLE m12,;
        SINGLE m21, SINGLE m22,;
        SINGLE dx, SINGLE dy

    DECLARE INTEGER GdipGetMatrixElements IN gdiplus;
        INTEGER matrix, STRING @matrixOut

ENDDEFINE

DEFINE CLASS rect As Session
    rleft=0
    rtop=0
    rwidth=0
    rheight=0

PROCEDURE Init(nLeft, nTop, nWidth, nHeight)
    THIS.rleft=m.nLeft
    THIS.rtop=m.nTop
    THIS.rwidth=m.nWidth
    THIS.rheight=m.nHeight

FUNCTION ToString As String
RETURN num2dword(THIS.rleft) +;
    num2dword(THIS.rtop) +;
    num2dword(THIS.rwidth) +;
    num2dword(THIS.rheight)

PROCEDURE FromString(cBuffer)
    THIS.rleft=buf2dword(SUBSTR(cBuffer,1,4))
    THIS.rtop=buf2dword(SUBSTR(cBuffer,5,4))
    THIS.rwidth=buf2dword(SUBSTR(cBuffer,9,4))
    THIS.rheight=buf2dword(SUBSTR(cBuffer,13,4))

PROCEDURE FromString1(cBuffer)
    LOCAL nRight, nBottom
    THIS.rleft=buf2dword(SUBSTR(cBuffer,1,4))
    THIS.rtop=buf2dword(SUBSTR(cBuffer,5,4))
    nRight=buf2dword(SUBSTR(cBuffer,9,4))
    nBottom=buf2dword(SUBSTR(cBuffer,13,4))
    THIS.rwidth=nRight-THIS.rleft+1
    THIS.rheight=nBottom-THIS.rtop+1

ENDDEFINE

DEFINE CLASS rectf As rect

FUNCTION ToString As String
RETURN num2dword(Int2Float(THIS.rleft)) +;
    num2dword(Int2Float(THIS.rtop)) +;
    num2dword(Int2Float(THIS.rwidth)) +;
    num2dword(Int2Float(THIS.rheight))

PROCEDURE FromString(cBuffer)
    rect::FromString(cBuffer)
    THIS.rleft=Float2Int(THIS.rleft)
    THIS.rtop=Float2Int(THIS.rtop)
    THIS.rwidth=Float2Int(THIS.rwidth)
    THIS.rheight=Float2Int(THIS.rheight)

PROCEDURE FromString1(cBuffer)
    rect::FromString1(cBuffer)
    THIS.rleft=Float2Int(THIS.rleft)
    THIS.rtop=Float2Int(THIS.rtop)
    THIS.rwidth=Float2Int(THIS.rwidth)
    THIS.rheight=Float2Int(THIS.rheight)

ENDDEFINE

*********************** static functions **************************
#DEFINE REAL_BIAS 127
#DEFINE REAL_MANTISSA_SIZE 23
#DEFINE REAL_NEGATIVE 0x80000000
#DEFINE EXPONENT_MASK 0x7F800000
#DEFINE MANTISSA_MASK 0x7FFFFF

FUNCTION GUIDToString(cGUID)
    LOCAL cBuffer, nBufsize
    nBufsize=128
    cBuffer = REPLICATE(CHR(0), nBufsize*2)
    = StringFromGUID2(cGUID, @cBuffer, nBufsize)
    cBuffer = SUBSTR(cBuffer, 1, AT(CHR(0)+CHR(0), cBuffer))
RETURN STRCONV(cBuffer,6)

FUNCTION StringToCLSID(cStr)
    LOCAL cBuffer
    cBuffer=REPLICATE(CHR(0),16)
    = CLSIDFromString(ToWideChar(cStr), @cBuffer)
RETURN m.cBuffer

FUNCTION ToWideChar(cStr)
RETURN STRCONV(m.cStr+CHR(0),5)

FUNCTION ARGB(nRedValue, nGreenValue, nBlueValue, nAlphaValue)
    IF VARTYPE(m.nAlphaValue) <> "N"
        nAlphaValue=0xff
    ENDIF
RETURN BITOR(BITLSHIFT(m.nAlphaValue,24), BITLSHIFT(m.nRedValue,16),;
    BITLSHIFT(m.nGreenValue,8), m.nBlueValue)

FUNCTION ColorToARGB(nColor, nAlphaValue)
    LOCAL nRedValue, nGreenValue, nBlueValue
    nBlueValue = BITRSHIFT(m.nColor, 16)
    nGreenValue = BITRSHIFT(BITAND(m.nColor, 0x00ff00), 8)
    nRedValue = BITAND(m.nColor, 0x0000ff)
RETURN ARGB(m.nRedValue, m.nGreenValue, m.nBlueValue, m.nAlphaValue)

FUNCTION Float2Int(num)
* converts [color=#800000]32-bit float form to FoxPro numeric[/color]
    IF num = 0
        RETURN 0
    ENDIF
    LOCAL sgn, exponent, mantissa
    sgn = IIF(BITTEST(num,31), -1,1)
    exponent = BITRSHIFT(BITAND(num, EXPONENT_MASK),;
        REAL_MANTISSA_SIZE) - REAL_BIAS
    mantissa = BITAND(num,;
        MANTISSA_MASK) / 2^(REAL_MANTISSA_SIZE-exponent)
RETURN (2^exponent + mantissa) * sgn

FUNCTION Int2Float(num)
* converts FoxPro numeric [color=#0000FF]to 32-bit float form[/color]
    LOCAL sgn, exponent, mantissa
    DO CASE
    CASE num < 0
        sgn = REAL_NEGATIVE
        num = -num
    CASE num > 0
        sgn = 0
    OTHERWISE
        RETURN 0
    ENDCASE
    exponent = FLOOR(LOG(num)/LOG(2))
    mantissa = (num - 2^exponent)* 2^(REAL_MANTISSA_SIZE-exponent)
    exponent = BITLSHIFT(exponent+REAL_BIAS, REAL_MANTISSA_SIZE)
RETURN BITOR(sgn, exponent, mantissa)

FUNCTION buf2dword(lcBuffer)
* converts DWORD string buffer [color=#0000FF]to FoxPro numeric[/color]
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)

FUNCTION buf2word(lcBuffer)
* converts WORD string buffer [color=#0000FF]to FoxPro numeric[/color]
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
       Asc(SUBSTR(lcBuffer, 2,1)) * 256

FUNCTION num2dword(lnValue)
* converts FoxPro numeric [color=#0000FF]to DWORD string buffer[/color]
#DEFINE m0 0x0000100
#DEFINE m1 0x0010000
#DEFINE m2 0x1000000
    IF lnValue < 0
        lnValue = 0x100000000 + lnValue
    ENDIF
    LOCAL b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2)/m1)
    b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
    b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

FUNCTION num2word(lnValue)
* converts FoxPro numeric [color=#0000FF]to WORD string buffer[/color]
RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))  
前天 20:26
schtg
Rank: 13Rank: 13Rank: 13Rank: 13
来 自:Usa
等 级:贵宾
威 望:67
帖 子:2112
专家分:4486
注 册:2012-2-29
收藏
得分:0 
辛苦啦
昨天 06:32
快速回复:改进老外的一个渐进色作图的代码
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.040127 second(s), 9 queries.
Copyright©2004-2025, BC-CN.NET, All Rights Reserved