找到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
***未完待续***
也就是说，最开始那段代码也可以运行了~~~
