*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="_gdiplus.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS gpbase AS custom && The abstract base class for all other _GDIPLUS classes. Provides some basic utility methods. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: allowmodalmessages_assign *m: appname_assign *m: clearerrors && Resets the object's error status *m: clone && Create a new object as an exact copy of an existing object *m: geterrorstatus && Has an error occurred? *m: getlasterrormessage && Get information about the last error to occur *m: guidtostring && Convert GUID value from binary form to string representation *m: ignoreerrors_assign *m: makegdiparrayf && Convert VFP array to a binary string (array of floats) *m: makegdiparrayffromcursor && Convert VFP cursor to a binary string (array of floats) *m: makegdippointf && Create GDI+ PointF structure as string, from separate x,y parameters *m: makegdiprectf && Create GDI+ RectF structure as string, from separate x,y,w,h parameters *m: makegdipsizef && Create GDI+ SizeF structure as string, from separate width,height parameters *m: objfactory && Object factory function for creating _GDIPLUS objects. Override this or ObjFactoryHook to change the classes used *m: objfactoryhook && Modify behaviour of object factory for _GDIPLUS objects. Override this or ObjFactory to change the classes used *m: quietonerror_assign *m: stringtoguid && Convert string representation of a GUID or CLSID to binary form (16 bytes) *p: allowmodalmessages && Allow error handler to put up Messagebox on error *p: appname && Application name for use in user feedback *p: haderror && Flag indicating whether an error has occured - you can also check return value from most functions. *p: ignoreerrors && If .T., errors are ignored: test return values from all functions! *p: lasterrormessage && Last error message (formatted) *p: quietonerror && If .T., error messages are suppressed *p: _memberdata && XML Metadata for customizable properties * PROTECTED haderror,lasterrormessage * allowmodalmessages = (inlist(_VFP.StartMode,0,4)) appname = GDI+ FFC Library lasterrormessage = ('') Name = "gpbase" quietonerror = (not inlist(_VFP.StartMode,0,4)) _memberdata = * PROCEDURE allowmodalmessages_assign lparameters vNewVal #if GDIPLUS_CHECK_PARAMS if vartype(m.vNewVal)='L' #endif This.AllowModalMessages = m.vNewVal #if GDIPLUS_CHECK_PARAMS else error 11 && func arg endif #endif ENDPROC PROCEDURE appname_assign lparameters vNewVal #if GDIPLUS_CHECK_PARAMS if vartype(m.vNewVal)='C' #endif This.AppName = m.vNewVal #if GDIPLUS_CHECK_PARAMS else error 11 && func arg endif #endif ENDPROC PROCEDURE clearerrors && Resets the object's error status This.hadError = .F. This.LastErrorMessage = '' ENDPROC PROCEDURE clone && Create a new object as an exact copy of an existing object lparameters toOtherObject * Not implemented in this class, see derived classes ENDPROC PROCEDURE Error LPARAMETERS nError as integer, cMethod as string, nLine as Integer local lcMessage, lcCodeLine lcMessage = message() lcCodeLine = message(1) This.HadError = .T. if This.IgnoreErrors or _vfp.StartMode>0 return .F. endif local lcOnError, lcErrorMsg lcOnError = alltrim(on("error")) if not empty(m.lcOnError) lcOnError= ; strtran( ; strtran( ; strtran( ; strtran( ; strtran( ; m.lcOnError,'error()',"m.nError",1,-1,1) ; ,'program()',"m.cMethod",1,-1,1) ; ,'lineno()',"m.nLine",1,-1,1) ; ,'message()',"m.lcMessage",1,-1,1) ; ,'message(1)',"m.lcCodeLine",1,-1,1) &lcOnError return endif lcErrorMsg = ; m.lcMessage ; +chr(13)+chr(13) ; + This.Name ; + chr(13) + _GDIPLUS_ERRNOLABEL_LOC + ltrim(str(m.nError)) ; + chr(13) + _GDIPLUS_ERRPROCLABEL_LOC + m.cMethod ; + chr(13) + _GDIPLUS_ERRLINELABEL_LOC + ltrim(str(m.nLine)) ; + chr(13) + m.lcCodeLine This.LastErrorMessage = m.lcErrorMsg do case case This.QuietOnError * Do nothing case This.AllowModalMessages messagebox( m.lcErrorMsg,16, This.AppName ) otherwise wait window (m.lcErrorMsg) nowait endcase #if GDIPLUS_ERRHANDLER_RETHROW if m.nError = 1098 error m.lcMessage else * Note, this loses the additional parameter error m.nError endif #endif ENDPROC PROCEDURE geterrorstatus && Has an error occurred? return This.hadError ENDPROC PROCEDURE getlasterrormessage && Get information about the last error to occur return This.LastErrorMessage ENDPROC PROCEDURE guidtostring && Convert GUID value from binary form to string representation lparameters tqGUID #if GDIPLUS_CHECK_PARAMS * Require 16-byte string or varbinary if !(vartype(m.tqGUID)$'CQ' and len(m.tqGUID)=16) error 11 && function argument return cast(null as C) endif #endif local lcUnicodeString, lnResult lcUnicodeString = replicate(chr(0),80) && Should be big enough for anything * Note - this is Unicode declare integer StringFromGUID2 in ole32.dll ; string @cCLSID, string @cUnicodeString, integer nLen lnResult = StringFromGUID2( m.tqGUID, @lcUnicodeString, 40 ) if m.lnResult == 0 error _GDIPLUS_INTERNALBUFTOOSMALL_LOC return cast(null as C) else return strconv(left(m.lcUnicodeString,(m.lnResult-1)*2),6) endif ENDPROC PROCEDURE ignoreerrors_assign lparameters vNewVal #if GDIPLUS_CHECK_PARAMS if vartype(m.vNewVal)='L' #endif This.IgnoreErrors = m.vNewVal #if GDIPLUS_CHECK_PARAMS else error 11 && func arg endif #endif ENDPROC PROCEDURE Init #ifdef GDIPLUS_ERRHANDLER_ALLOWMODAL This.AllowModalMessages = GDIPLUS_ERRHANDLER_ALLOWMODAL #endif #ifdef GDIPLUS_ERRHANDLER_QUIET This.QuietOnError = GDIPLUS_ERRHANDLER_QUIET #endif #ifdef GDIPLUS_ERRHANDLER_IGNOREERRORS This.IgnoreErrors = GDIPLUS_ERRHANDLER_IGNOREERRORS #endif #ifdef GDIPLUS_ERRHANDLER_APPNAME This.AppName = GDIPLUS_ERRHANDLER_APPNAME #endif return dodefault() ENDPROC PROCEDURE makegdiparrayf && Convert VFP array to a binary string (array of floats) lparameters taArray as array, tnCols as integer, tnFirstCol as integer external array taArray #if GDIPLUS_CHECK_PARAMS if !(type('m.taArray[1,2]')='N') && Must be 2-D array error 11 && function argument return cast(null as C) endif #endif local lcStruct, lnRows, lnRow, lnCol, lnFirstCol, lnColsMinusOne lnRows = alen(taArray,1) lnFirstCol = evl(m.tnFirstCol,1) lnColsMinusOne= iif(empty(m.tnCols), alen(taArray,2)-m.lnFirstCol, m.tnCols-1 ) #if GDIPLUS_CHECK_PARAMS if !(between(m.lnFirstCol,1,alen(taArray,2)) and between(m.lnColsMinusOne,0,alen(taArray,2)-m.lnFirstCol)) error 11 && function argument return cast(null as C) endif #endif lcStruct = '' for lnRow = 1 to m.lnRows for lnCol = m.lnFirstCol to m.lnFirstCol+m.lnColsMinusOne lcStruct = m.lcStruct + bintoc(taArray[m.lnRow,m.lnCol],'F') endfor endfor assert len(m.lcStruct) == m.lnRows*4*(m.lnColsMinusOne+1) return m.lcStruct * Determine length from the result ENDPROC PROCEDURE makegdiparrayffromcursor && Convert VFP cursor to a binary string (array of floats) lparameters tcAlias as string, tnCols as Integer ; , tcExpr1 as string, tcExpr2 as string, tcExpr3 as string, tcExpr4 as String ; , tcExpr5 as string, tcExpr6 as string, tcExpr7 as string, tcExpr8 as string #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcAlias)='C' and vartype(m.tnCols)='N' and between(m.tnCols,1,8)) error 11 && function argument return cast(null as C) endif if !used(m.tcAlias) error 13, m.tcAlias && Alias not found return cast(null as C) endif #endif local lcStruct, lnCol, lnSaveArea, lnSaveRecno, laExpr[m.tnCols] lnSaveArea = select() select (m.tcAlias) lnSaveRecno = recno() * Check expressions for lnCol = 1 to m.tnCols laExpr[m.lnCol] = evaluate("m.tcExpr"+ltrim(str(m.lnCol))) #if GDIPLUS_CHECK_PARAMS if vartype(laExpr[m.lnCol])!='C' error 11 && function argument return cast(null as C) endif #endif endfor lcStruct = '' scan for lnCol = 1 to m.tnCols lcStruct = m.lcStruct + bintoc(evaluate(laExpr[m.lnCol]),'F') endfor endscan if m.lnSaveRecno<=reccount() go (m.lnSaveRecno) endif select (m.lnSaveArea) return m.lcStruct ENDPROC PROCEDURE makegdippointf && Create GDI+ PointF structure as string, from separate x,y parameters lparameters tx as number,ty as number #if GDIPLUS_CHECK_PARAMS if ! vartype(m.tx)+vartype(m.ty)=='NN' error 11 && function argument return cast(null as C) endif #endif return ; bintoc(m.tX,'F') + bintoc(m.tY,'F') ENDPROC PROCEDURE makegdiprectf && Create GDI+ RectF structure as string, from separate x,y,w,h parameters lparameters tx as number,ty as number,tw as number,th as number #if GDIPLUS_CHECK_PARAMS if ! vartype(m.tx)+vartype(m.ty)+vartype(m.tw)+vartype(m.th)=='NNNN' error 11 && function argument return cast(null as C) endif #endif return ; bintoc(m.tX,'F') + bintoc(m.tY,'F') ; + bintoc(m.tW,'F') + bintoc(m.tH,'F') ENDPROC PROCEDURE makegdipsizef && Create GDI+ SizeF structure as string, from separate width,height parameters lparameters tw as number,th as number #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tw)+vartype(m.th)=='NN') error 11 && function argument return cast(null as C) endif #endif return ; bintoc(m.tW,'F') + bintoc(m.tH,'F') ENDPROC PROCEDURE objfactory && Object factory function for creating _GDIPLUS objects. Override this or ObjFactoryHook to change the classes used lparameters tcContext, tcClassName ; , p1,p2,p3,p4,p5,p6,p7,p8,p9,p10 * Class name is one of _gdiplus.vcx base classes, or you could extend it yourself * context is where it is called from, in the form 'class.method' * #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcContext)+vartype(m.tcClassName )=='CC') error 11 && function argument return cast(null as O) && Function argument endif #endif * Base implementation - always use same class library as header file local lcClassLibrary,lcModule lcClassLibrary = GDIPLUS_CLASS_LIBRARY lcModule = '' * Allow modifications to class chosen. Note arguments cannot be changed This.ObjFactoryHook( tcContext, @tcClassName, @lcClassLibrary, @lcModule ) * Most common cases in _GDIPLUS.VCX are 1 and 2 args so do those pcounts() first do case case pcount()==3 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1) case pcount()==4 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2) case pcount()==2 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule) case pcount()==5 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2,@p3) case pcount()==6 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2,@p3,@p4) case pcount()==7 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2,@p3,@p4,@p5) case pcount()==8 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p,@p3,@p4,@p5,@p6) case pcount()==9 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2,@p3,@p4,@p5,@p6,@p7) case pcount()==10 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2,@p3,@p4,@p5,@p6,@p7,@p8) case pcount()==11 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2,@p3,@p4,@p5,@p6,@p7,@p8,@p9) case pcount()==12 return newobject(m.tcClassName,m.lcClassLibrary,m.lcModule,@p1,@p2,@p3,@p4,@p5,@p6,@p7,@p8,@p9,@p10) endcase error 11 && Function argument return cast(null as O) ENDPROC PROCEDURE objfactoryhook && Modify behaviour of object factory for _GDIPLUS objects. Override this or ObjFactory to change the classes used lparameters tcContext, rcClassName, rcClassLibrary, rcModule * No special behaviour in base class ENDPROC PROCEDURE quietonerror_assign lparameters vNewVal #if GDIPLUS_CHECK_PARAMS if vartype(m.vNewVal)='L' #endif This.QuietOnError = m.vNewVal #if GDIPLUS_CHECK_PARAMS else error 11 && func arg endif #endif ENDPROC PROCEDURE stringtoguid && Convert string representation of a GUID or CLSID to binary form (16 bytes) lparameters lcString as String #if GDIPLUS_CHECK_PARAMS if !(vartype(m.lcString)='C') error 11 && function argument return cast(null as Q) && Function argument endif #endif local lcCLSID, lnResult lcCLSID = replicate(chr(0),16) declare integer CLSIDFromString in ole32.dll ; string cString, string @cCLSID lnResult = CLSIDFromString( strconv(m.lcString,5), @lcCLSID ) if m.lnResult == 0 return cast(m.lcCLSID as Q(16)) else error _GDIPLUS_STRINGTOGUID_LOC return cast(null as Q) endif ENDPROC ENDDEFINE DEFINE CLASS gpbitmap AS gpimage OF "_gdiplus.vcx" && Encapsulates a GDI+ bitmap, which consists of the pixel data for a graphics image and its attributes. A Bitmap object is an object used to work with images defined by pixel data. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: create && Create bitmap with specified properties *m: createfromgraphics && Create from a GpGraphics object *m: getpixel && Get the colour value of an individual pixel *m: setpixel && Set an individual pixel in this image to a specific colour value *m: setresolution && Set the resolution of the bitmap, specified in dots-per-inch * * Name = "gpbitmap" _memberdata = * PROCEDURE create && Create bitmap with specified properties LPARAMETERS tnWidth as Integer, tnHeight as Integer, tnPixelFormat as Integer #if GDIPLUS_CHECK_PARAMS if !(vartype(tnWidth)='N' AND vartype(tnHeight)='N' AND vartype(tnPixelFormat )$'LN') This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipCreateBitmapFromScan0 in gdiplus.dll ; integer nWidth, integer nHeight, integer nStride; , integer nPixelFormat ; , string @ cScan0, integer @ nImage this.Destroy() local nHandle nHandle = 0 This.gdipStatus = GdipCreateBitmapFromScan0( ; m.tnWidth, m.tnHeight, 0 ; , iif(vartype(m.tnPixelFormat)='N',m.tnPixelFormat,GDIPLUS_PIXELFORMAT_32bppARGB) ; , 0 ; , @nHandle) this.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE createfromfile lparameters tcFilename as String, tlUseEmbeddedColorMgmt as Logical #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcFilename)='C' and !empty(m.tcFilename) and vartype(m.tlUseEmbeddedColorMgmt)='L') error 11 This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif if m.tlUseEmbeddedColorMgmt declare integer GdipCreateBitmapFromFileICM in gdiplus.dll ; string wFilename, integer @ nImage this.Destroy() local nHandle nHandle = 0 This.gdipStatus = GdipCreateBitmapFromFileICM( ; strconv(m.tcFilename+chr(0),5) ; , @nHandle) this.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus else declare integer GdipCreateBitmapFromFile in gdiplus.dll ; string wFilename, integer @ nImage this.Destroy() local nHandle nHandle = 0 This.gdipStatus = GdipCreateBitmapFromFile( ; strconv(m.tcFilename+chr(0),5) ; , @nHandle) this.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus endif ENDPROC PROCEDURE createfromgraphics && Create from a GpGraphics object lparameters toGraphics as GpGraphics, nWidth as integer, nHeight as integer #if GDIPLUS_CHECK_PARAMS if !(vartype(toGraphics)$'ON' and vartype(m.nWidth)='N' and vartype(m.nHeight)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipCreateBitmapFromGraphics in gdiplus.dll ; integer nWidth, integer nHeight, integer nGraphics, integer @ nImage this.Destroy() local nHandle nHandle = 0 This.gdipStatus = GdipCreateBitmapFromGraphics( ; m.nWidth, m.nHeight ; , iif(vartype(m.toGraphics)='O',m.toGraphics.GetHandle(),m.toGraphics) ; , @nHandle) this.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE getpixel && Get the colour value of an individual pixel lparameters tX as integer, tY as integer #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tx)='N' and vartype(m.ty)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as I) endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC endif #endif declare integer GdipBitmapGetPixel in gdiplus.dll ; integer nBitmap, integer x, integer y, integer @ nARGB local nARGB nARGB = 0 This.gdipStatus = GdipBitmapGetPixel( ; This.gdipHandle, m.tx, m.ty, @nARGB ) return iif(GDIPLUS_STATUS_OK == This.gdipStatus,m.nARGB,cast(null as I)) ENDPROC PROCEDURE Init lparameters tvParam1, tvParam2, tvParam3 if vartype(m.tvParam1)+vartype(m.tvParam2)='NN' * Width and height if not dodefault() && Bypasses return .F. endif return This.Create( m.tvParam1, m.tvParam2, m.tvParam3 ) else return dodefault(m.tvParam1,m.tvParam2) endif ENDPROC PROCEDURE setpixel && Set an individual pixel in this image to a specific colour value lparameters tX as integer, tY as integer, tvColor #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tx)='N' and vartype(m.ty)='N' and ; (vartype(m.tvColor)='N' or (vartype(m.tvColor)='O' and pemstatus(m.tvColor,'argb',5)))) error 11 This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC endif #endif declare integer GdipBitmapSetPixel in gdiplus.dll ; integer nBitmap, integer x, integer y, integer nARGB This.gdipStatus = GdipBitmapSetPixel( ; This.gdipHandle, m.tx, m.ty ; , iif(vartype(m.tvColor)='N',m.tvColor,m.tvColor.argb) ; ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE setresolution && Set the resolution of the bitmap, specified in dots-per-inch lparameters tnDPIX as number, tnDPIY as number #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnDPIX )='N' and vartype(m.tnDPIY )='N') error 11 This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC endif #endif declare integer GdipBitmapSetResolution in gdiplus.dll ; integer nBitmap, single dpix, single dpiy This.gdipStatus = GdipBitmapSetResolution ( ; This.gdipHandle, m.tnDPIX , m.tnDPIY ; ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC ENDDEFINE DEFINE CLASS gpbrush AS gpobject OF "_gdiplus.vcx" && The abstract base class for all Brush classes (for example, the gpSolidBrush and gpHatchBrush classes). *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * Name = "gpbrush" _memberdata = * PROCEDURE clone lparameters toBrush as GpBrush #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toBrush)='O' and m.toBrush.gdipHandle<>0) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif this.Destroy() local nHandle nHandle = 0 Declare Integer GdipCloneBrush In GDIPlus.Dll ; integer nBrush, integer @nCloneBrush This.gdipStatus = GdipCloneBrush( ; m.toBrush.gdipHandle ; , @nHandle) this.gdipHandle= m.nHandle return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE Destroy if This.gdipHandle!=0 and This.gdipOwnsThisHandle declare integer GdipDeleteBrush in gdiplus.dll ; integer nBrush GdipDeleteBrush( This.gdipHandle ) This.gdipHandle = 0 This.gdipOwnsThisHandle = .F. endif return dodefault() ENDPROC ENDDEFINE DEFINE CLASS gpcolor AS gpbase OF "_gdiplus.vcx" && Encapsulates a GDI+ color, consisting of 4 positive integers (0..255) for red, green, blue and alpha components. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: alpha_access *m: alpha_assign *m: blue_access *m: blue_assign *m: foxrgb_access *m: foxrgb_assign *m: green_access *m: green_assign *m: red_access *m: red_assign *m: set && Set colour value using separate R,G,B,Alpha components *p: alpha && Alpha (transparency) component, value 0-255 (255=completely opaque) *p: argb && Color in ARGB form (GDI+ native format), bits 24-31=alpha, 16-23=red, 8-15=green, 0-7=blue *p: blue && Blue component, value 0-255 *p: foxrgb && Color in Foxpro RGB form (bits 0-7=red, 8-15=green, 16-23=blue, no transparency) *p: green && Green component, value 0-255 *p: red && Red component, value 0-255 * * argb = -16777216 Name = "gpcolor" _memberdata = * PROCEDURE alpha_access RETURN bitand(bitrshift(This.ARGB,24),0xFF) ENDPROC PROCEDURE alpha_assign LPARAMETERS tnNewVal #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnNewVal)='N' and between(m.tnNewVal,0,255)) error 11 && Function argument endif #endif This.ARGB = bitor( bitand(This.ARGB,0xFF00FFFF), bitlshift(m.tnNewVal,24)) ENDPROC PROCEDURE blue_access RETURN bitand(This.ARGB,0xFF) ENDPROC PROCEDURE blue_assign LPARAMETERS tnNewVal #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnNewVal)='N' and between(m.tnNewVal,0,255)) error 11 && Function argument endif #endif This.ARGB = bitor( bitand(This.ARGB,0xFFFFFF00), m.tnNewVal) ENDPROC PROCEDURE clone lparameters toOtherColor as GpColor #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toOtherColor)='O' and pemstatus(toOtherColor,'argb',5)) error 11 && Function argument return .F. endif #endif This.ARGB = m.toOtherColor.ARGB ENDPROC PROCEDURE foxrgb_access return rgb(This.Red,This.Green,This.Blue) ENDPROC PROCEDURE foxrgb_assign LPARAMETERS tnRGB #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnRGB)=='N') error 11 && Function argument endif #endif This.ARGB = bitor( 0xFF000000 ; , bitlshift(bitand(m.tnRGB,0xFF),16) ; , bitand(m.tnRGB,0x0000FF00) ; , bitrshift(bitand(m.tnRGB,0x00FF0000),16) ) ENDPROC PROCEDURE green_access RETURN bitand(bitrshift(This.ARGB,8),0xFF) ENDPROC PROCEDURE green_assign LPARAMETERS tnNewVal #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnNewVal)='N' and between(m.tnNewVal,0,255)) error 11 && Function argument endif #endif This.ARGB = bitor( bitand(This.ARGB,0xFF00FFFF), bitlshift(m.tnNewVal,8)) ENDPROC PROCEDURE Init lparameters tnRedOrARGB as Integer, tnGreen as Integer, tnBlue as Integer, tnAlpha as integer #if GDIPLUS_CHECK_PARAMS if !(inlist(pcount(),0,1,3,4)) error 11 && Function argument return .F. endif #endif if not dodefault() return .F. endif do case case pcount()=1 #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnRedOrARGB)='N') error 11 && Function argument endif #endif This.ARGB = int(m.tnRedOrARGB) case pcount()>=3 This.Set(tnRedOrARGB, tnGreen, tnBlue, m.tnAlpha ) endcase ENDPROC PROCEDURE red_access RETURN bitand(bitrshift(This.ARGB,16),0xFF) ENDPROC PROCEDURE red_assign LPARAMETERS tnNewVal #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnNewVal)='N' and between(m.tnNewVal,0,255)) error 11 && Function argument endif #endif This.ARGB = bitor( bitand(This.ARGB,0xFF00FFFF), bitlshift(m.tnNewVal,16)) ENDPROC PROCEDURE set && Set colour value using separate R,G,B,Alpha components lparameters tnRed, tnGreen, tnBlue, tnAlpha #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnRed)='N' and between(m.tnRed,0,255) ; and vartype(m.tnGreen)='N' and between(m.tnGreen,0,255) ; and vartype(m.tnBlue)='N' and between(m.tnBlue,0,255) ; and vartype(m.tnAlpha)='L' or (vartype(m.tnAlpha)='N' and between(m.tnAlpha,0,255))) error 11 && Function argument endif #endif This.ARGB = ; iif(vartype(m.tnAlpha)='N',0x1000000*m.tnAlpha,0xFF000000) ; + 0x10000*m.tnRed ; + 0x100 * m.tnGreen ; + m.tnBlue ENDPROC ENDDEFINE DEFINE CLASS gpfont AS gpobject OF "_gdiplus.vcx" && Defines a particular format for text, including font face, size, and style attributes. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: create && Create font using specified font family, size and style *m: fontname_access *m: fontname_assign *m: getheight && Get line spacing for a given Graphics object (in the units of that graphics object) *m: getheightgivendpi && Get line spacing of this font, for specified DPI *m: size_access *m: size_assign *m: style_access *m: style_assign *m: unit_access *m: unit_assign *p: fontname && Font name eg "Arial" *p: size && Get the em size in the unit of this Font object *p: style && Get style information for this font *p: unit && The unit of measure used by this font * * Name = "gpfont" _memberdata = * PROCEDURE clone lparameters toFont as GpFont this.Destroy() local nHandle nHandle = 0 #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toFont)='O' and m.toFont.gdipHandle<>0) error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif Declare Integer GdipCloneFont In GDIPlus.Dll ; integer nOriginal, integer @nClone This.GdipStatus = GdipCloneFont( ; m.toFont.gdipHandle ; , @nHandle) this.gdipHandle= m.nHandle This.gdipOwnsThisHandle = .T. return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE create && Create font using specified font family, size and style lparameters ; tvFontNameOrFamily ; && Font name or Fontfamily (created separately) , tnSize as Number ; && size in units (default points) , tnStyle as integer ; && see GDIPLUS_FontStyle_xxx values (default Normal) , tnUnit as integer && see GDIPLUS_Unit_xxx values (default points) #if GDIPLUS_CHECK_PARAMS if !((vartype(m.tvFontNameOrFamily )='C' ; or (vartype(m.tvFontNameOrFamily )='O' and m.tvFontNameOrFamily.GetHandle()<>0)) ; and vartype(m.tnSize)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lnStyle as Integer, lnUnit as integer, lnHandle as integer ; , loFamily as GpFontFamily, lnFamily as integer lnStyle = evl(m.tnStyle,GDIPLUS_FontStyle_Regular) lnUnit = evl(m.tnUnit,GDIPLUS_Unit_World) lnHandle = 0 if vartype(m.tvFontnameOrFamily)='O' lnFamily = m.tvFontNameOrFamily.GetHandle() else * Must create ourselves loFamily = This.ObjFactory('gpfont.create', GDIPLUS_CLASS_FONTFAMILY, @tvFontNameOrFamily) lnFamily =iif(vartype(m.loFamily)='O',m.loFamily.GetHandle(),0) endif this.Destroy() Declare Integer GdipCreateFont In GDIPlus.Dll ; integer nFontFamily, single fSize, integer nStyle, integer nUnit, integer @nHandle if 0!=m.lnFamily * Try creating font This.gdipStatus = GdipCreateFont( m.lnFamily, m.tnSize,m.lnStyle,m.lnUnit,@lnHandle) if GDIPLUS_STATUS_OK==This.gdipStatus * That worked This.SetHandle(m.lnHandle,.T.) return .T. endif endif * If here, either font family is invalid or font creation failed * Try from Generic family lnFamily = 0 declare integer GdipGetGenericFontFamilySansSerif in gdiplus.dll integer @ GdipGetGenericFontFamilySansSerif( @lnFamily ) This.gdipStatus = GdipCreateFont( m.lnFamily, m.tnSize,m.lnStyle,m.lnUnit,@lnHandle) This.SetHandle(m.lnHandle,.T.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE Destroy if This.GdipHandle!=0 and This.gdipOwnsThisHandle Declare Integer GdipDeleteFont In GDIPlus.Dll ; integer nFont GdipDeleteFont(This.GdipHandle) This.GdipHandle=0 This.gdipOwnsThisHandle=.F. endif ENDPROC PROCEDURE fontname_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as C) endif #endif declare integer GdipGetFamily in gdiplus.dll ; integer nFont, integer @ nFamily declare integer GdipGetFamilyName in gdiplus.dll ; integer nFamily, string @ cUnicodeName, integer nLangID declare integer lstrlenW in kernel32.dll as __win32_lstrlenW string local nFamily as Number, cUnicodeName as String nFamily = 0 cUnicodeName= replicate(chr(0), 64 ) && 64=LF_FACESIZE*2 This.gdipStatus = GdipGetFamily( This.gdipHandle, @nFamily ) && LANG_NEUTRAL if (GDIPLUS_STATUS_OK!=This.gdipStatus) return cast(null as C) endif This.gdipStatus = GdipGetFamilyName( m.nFamily, @cUnicodeName, 0x00 ) && LANG_NEUTRAL return iif(GDIPLUS_STATUS_OK==This.gdipStatus ; , strconv( left(m.cUnicodeName,__win32_lstrlenW(m.cUnicodeName)*2),6) ; , cast(null as C) ) ENDPROC PROCEDURE fontname_assign LPARAMETERS vNewVal error 1743,'FontName' ENDPROC PROCEDURE getheight && Get line spacing for a given Graphics object (in the units of that graphics object) lparameters tvGraphics local lnGraphics do case case vartype(m.tvGraphics)='N' lnGraphics = m.tvGraphics case vartype(m.tvGraphics)='O' lnGraphics = m.tvGraphics.GetHandle() otherwise error 11 This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as B) endcase #if GDIPLUS_CHECK_PARAMS if 0==m.lnGraphics error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as B) endif #endif declare integer GdipGetFontHeight in gdiplus.dll ; integer nFont, integer nGraphics, single @ fHeight local nHeight nHeight = 0.0 This.gdipStatus = GdipGetFontHeight(This.gdipHandle,m.lnGraphics,@nHeight) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nHeight,cast(null as B)) ENDPROC PROCEDURE getheightgivendpi && Get line spacing of this font, for specified DPI lparameters tnDPI as Number #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif #if GDIPLUS_CHECK_PARAMS if vartype(m.tnDPI)!='N' error 11 && Function argument endif #endif declare integer GdipGetFontHeightGivenDPI in gdiplus.dll ; integer nFont, single nDPI, single @ fHeight local nHeight nHeight = 0.0 This.gdipStatus = GdipGetFontHeight(This.gdipHandle,m.tnDPI,@nHeight) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nHeight,cast(null as B)) ENDPROC PROCEDURE Init lparameters ; tvFontNameOrFamily ; && Font name, or Fontfamily (created separately) , tnSize as Number ; && size in units (default points) , tnStyle as integer ; && see GDIPLUS_FontStyle_xxx values (default Normal) , tnUnit as integer && see GDIPLUS_Unit_xxx values (default points) if not dodefault() return .F. endif if pcount()>0 return This.Create(m.tvFontNameOrFamily,m.tnSize,m.tnStyle,m.tnUnit) endif return .T. ENDPROC PROCEDURE size_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare integer GdipGetFontSize in gdiplus.dll ; integer nFont, single @ local nSize nSize= 0.0 This.gdipStatus = GdipGetFontSize( This.gdipHandle, @nSize) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nSize,cast(null as B)) ENDPROC PROCEDURE size_assign LPARAMETERS vNewVal error 1743, 'Size' ENDPROC PROCEDURE style_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetFontStyle in gdiplus.dll ; integer nFont, integer @ local nStyle nStyle= 0 This.gdipStatus = GdipGetFontStyle( This.gdipHandle, @nStyle) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nStyle,cast(null as I)) ENDPROC PROCEDURE style_assign LPARAMETERS vNewVal error 1743, 'Style' ENDPROC PROCEDURE unit_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetFontUnit in gdiplus.dll ; integer nFont, integer @ local nUnit nUnit = 0 This.gdipStatus = GdipGetFontUnit( This.gdipHandle, @nUnit) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nUnit,cast(null as I)) ENDPROC PROCEDURE unit_assign LPARAMETERS vNewVal error 1743, 'Unit' ENDPROC ENDDEFINE DEFINE CLASS gpfontfamily AS gpobject OF "_gdiplus.vcx" && Designates attributes shared by a group of related fonts. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: create && Create font family with specified name *m: fontname_access *m: fontname_assign *m: getcellascent && Get cell ascent in design units, of this font family in the specified style *m: getcelldescent && Get cell descent in design units, of this font family in the specified style *m: getemheight && Get the height in design units, of this font family in the specified style *m: getgenericmonospace && Gets a generic monospace FontFamily *m: getgenericsansserif && Gets a generic sans serif FontFamily *m: getgenericserif && Gets a generic serif FontFamily *m: getlinespacing && Get line spacing in design units, of this font family in the specified style *m: getname && Get name of this font family, in the specified language *m: isstyleavailable && Indicates whether the specified Font Style enumeration is available *p: fontname && Font name eg "Arial" *p: gdipfontcollectionhandle && Handle to GDI+ FontCollection object. This class does not manage this handle at all, it merely uses it. Normally it will refer to the collection of installed fonts. * * gdipfontcollectionhandle = 0 Name = "gpfontfamily" _memberdata = * PROCEDURE clone lparameters toFontFamily as GpFontFamily this.Destroy() local nHandle nHandle = 0 #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toFontFamily)='O' and m.toFontFamily.gdipHandle<>0) error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif Declare Integer GdipCloneFontFamily In GDIPlus.Dll ; integer nOriginal, integer @nClone This.GdipStatus = GdipCloneFontFamily( ; m.toFontFamily.gdipHandle ; , @nHandle) this.gdipHandle= m.nHandle This.gdipOwnsThisHandle = .T. return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE create && Create font family with specified name lparameters tcName as String this.Destroy() local nHandle nHandle = 0 Declare Integer GdipCreateFontFamilyFromName In GDIPlus.Dll ; string cUnicodeName, integer nFontCollection ,integer @nHandle This.gdipStatus = GdipCreateFontFamilyFromName ( ; strconv(m.tcName,5)+chr(0) ; , This.gdipFontCollectionHandle ; , @nHandle ) This.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE Destroy if This.GdipHandle!=0 and This.gdipOwnsThisHandle Declare Integer GdipDeleteFontFamily In GDIPlus.Dll ; integer nFontFamily GdipDeleteFontFamily(This.GdipHandle) This.GdipHandle=0 This.gdipOwnsThisHandle=.F. endif ENDPROC PROCEDURE fontname_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as C) endif #endif declare integer GdipGetFamilyName in gdiplus.dll ; integer nFamily, string @ cUnicodeName, integer nLangID declare integer lstrlenW in kernel32.dll as __win32_lstrlenW string local cUnicodeName as String cUnicodeName= replicate(chr(0), 64 ) && 64=LF_FACESIZE*2 This.gdipStatus = GdipGetFamilyName( This.gdipHandle, @cUnicodeName, 0x00 ) && 0x00=LANG_NEUTRAL return iif(GDIPLUS_STATUS_OK==This.gdipStatus ; , strconv( left(m.cUnicodeName,__win32_lstrlenW(m.cUnicodeName)*2),6) ; , cast(null as C) ) ENDPROC PROCEDURE fontname_assign LPARAMETERS vNewVal error 1743, 'FontName' ENDPROC PROCEDURE getcellascent && Get cell ascent in design units, of this font family in the specified style lparameters tnStyle as integer #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnStyle)$'LN') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as I) endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetCellAscent in gdiplus.dll ; integer nFamily, integer nStyle, integer @ nValue local nValue as Number nValue = 0 This.gdipStatus = GdipGetCellAscent( This.gdipHandle, evl(m.tnStyle,0), @nValue) return iif(GDIPLUS_STATUS_OK==This.gdipStatus ; , m.nValue ; , cast(null as I) ) ENDPROC PROCEDURE getcelldescent && Get cell descent in design units, of this font family in the specified style lparameters tnStyle as integer #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnStyle)$'LN') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as I) endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetCellDescent in gdiplus.dll ; integer nFamily, integer nStyle, integer @ nValue local nValue as Number nValue = 0 This.gdipStatus = GdipGetCellDescent( This.gdipHandle, evl(m.tnStyle,0), @nValue) return iif(GDIPLUS_STATUS_OK==This.gdipStatus ; , m.nValue ; , cast(null as I) ) ENDPROC PROCEDURE getemheight && Get the height in design units, of this font family in the specified style lparameters tnStyle as integer #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnStyle)$'LN') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as I) endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetEmHeight in gdiplus.dll ; integer nFamily, integer nStyle, integer @ nValue local nValue as Number nValue = 0 This.gdipStatus = GdipGetEmHeight( This.gdipHandle, evl(m.tnStyle,0), @nValue) return iif(GDIPLUS_STATUS_OK==This.gdipStatus ; , m.nValue ; , cast(null as I) ) ENDPROC PROCEDURE getgenericmonospace && Gets a generic monospace FontFamily this.Destroy() local nHandle nHandle = 0 Declare Integer GdipGetGenericFontFamilyMonospace In GDIPlus.Dll ; integer @nHandle This.gdipStatus = GdipGetGenericFontFamilyMonospace(@nHandle ) This.SetHandle(m.nHandle,.F.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE getgenericsansserif && Gets a generic sans serif FontFamily this.Destroy() local nHandle nHandle = 0 Declare Integer GdipGetGenericFontFamilySansSerif In GDIPlus.Dll ; integer @nHandle This.gdipStatus = GdipGetGenericFontFamilySansSerif(@nHandle ) This.SetHandle(m.nHandle,.F.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE getgenericserif && Gets a generic serif FontFamily this.Destroy() local nHandle nHandle = 0 Declare Integer GdipGetGenericFontFamilySerif In GDIPlus.Dll ; integer @nHandle This.gdipStatus = GdipGetGenericFontFamilySerif(@nHandle ) This.SetHandle(m.nHandle,.F.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE getlinespacing && Get line spacing in design units, of this font family in the specified style lparameters tnStyle as integer #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnStyle)$'LN') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as I) endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetLineSpacing in gdiplus.dll ; integer nFamily, integer nStyle, integer @ nValue local nValue as Number nValue = 0 This.gdipStatus = GdipGetLineSpacing( This.gdipHandle, evl(m.tnStyle,0), @nValue) return iif(GDIPLUS_STATUS_OK==This.gdipStatus ; , m.nValue ; , cast(null as I) ) ENDPROC PROCEDURE getname && Get name of this font family, in the specified language lparameters tnLangID #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnLangID)$'LN') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as C) endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as C) endif #endif declare integer GdipGetFamilyName in gdiplus.dll ; integer nFamily, string @ cUnicodeName, integer nLangID declare integer lstrlenW in kernel32.dll as __win32_lstrlenW string local cUnicodeName as String cUnicodeName= replicate(chr(0), 64 ) && 64=LF_FACESIZE*2 This.gdipStatus = GdipGetFamilyName( This.gdipHandle, @cUnicodeName, evl(m.tnLangID,0x00) ) && LANG_NEUTRAL return iif(GDIPLUS_STATUS_OK==This.gdipStatus ; , strconv( left(m.cUnicodeName,__win32_lstrlenW(m.cUnicodeName)*2),6) ; , cast(null as C) ) ENDPROC PROCEDURE Init lparameters tcName * Get the Installed Font collection if not dodefault() return .F. endif * This class cannot handle Private Font collections on its own: if you want * that, you will need to extend it (and manage the lifetime of the * PrivateFontCollection object * Is this necessary? * declare integer GdipNewInstalledFontCollection in gdiplus.dll integer @ * * For now, this seems to work: This.gdipFontCollectionHandle = 0 if pcount()>=1 return This.Create( m.tcName ) endif return .T. ENDPROC PROCEDURE isstyleavailable && Indicates whether the specified Font Style enumeration is available lparameters tnFontStyle as integer #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnFontStyle)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipIsStyleAvailable in gdiplus.dll ; integer nFontFamily, integer nStyle, integer @bIsAvailable local nAvailable nAvailable = 0 && default to FALSE This.gdipStatus = GdipIsStyleAvailable( This.gdipHandle, m.tnFontStyle, @nAvailable ) * Convert integer to .T./.F. return (m.nAvailable<>0) ENDPROC ENDDEFINE DEFINE CLASS gpgraphics AS gpobject OF "_gdiplus.vcx" && Encapsulates a GDI+ drawing surface. Provides methods for drawing on a window or other canvas. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: clear && Clear entire drawing surface and fill with specified background color *m: clipbounds_access *m: clipbounds_assign *m: compositingmode_access *m: compositingmode_assign *m: compositingquality_access *m: compositingquality_assign *m: createfromhdc && Create Graphics object for a given device context (HDC) *m: createfromhwnd && Create GDI+ Graphics object for a given window (HWND) *m: createfromimage && Create graphics object from the specified GpImage object (to draw on that image's surface) *m: dpix_access *m: dpix_assign *m: dpiy_access *m: dpiy_assign *m: drawarc && Draws an arc representing a portion of an ellipse, given bounding rectangle of elllipse, start and sweep angles. *m: drawbezier && Draw a B�zier spline from 4 control points *m: drawbeziers && Draw a B�zier spline given a 2-column array of coordinates *m: drawbeziersfromcursor && Draw a B�zier spline given a cursor containing coordinates *m: drawclosedcurve && Draw a closed curve given a 2-column array of coordinates *m: drawclosedcurvefromcursor && Draw a closed curve given a cursor containing coordinates *m: drawcurve && Draw a smooth curve given a 2-column array of coordinates *m: drawcurvefromcursor && Draw a smooth curve given a cursor containing coordinates *m: drawellipse && Draw outlined ellipse specified by its bounding rectangle *m: drawimageat && Draw image at the specified location, using its original physical size *m: drawimageportionat && Draw portion of an image at the specified location, using its original size *m: drawimageportionscaled && Draw portion of an image at the specified location and with the specified size *m: drawimagescaled && Draw image at the specified location with the specified size. *m: drawline && Draw a line that connects two points, in the specified pen. *m: drawlines && Draw sequence of connected lines, given array of coordinates *m: drawlinesfromcursor && Draw sequence of connected lines, given cursor containing coordinates *m: drawpie && Draw outlined pie slice in specified pen and start/stop anagles *m: drawpolygon && Draw a polygon given a 2-column array of coordinates *m: drawpolygonfromcursor && Draw a polygon given a cursor containing coordinates *m: drawrectangle && Draw a rectangle *m: drawrectangles && Draw a series of rectangles given a 4-column array (each row x,y,w,h) *m: drawrectanglesfromcursor && Draw a series of rectangles given a cursor containing x,y,w,h values *m: drawstringa && Draw a string in specified font and position (ANSI Version) *m: drawstringw && Draw a string in specified font and position (Unicode Version) *m: fillclosedcurve && Fill a closed curve defined by a 2-column array of coordinates *m: fillclosedcurvefromcursor && Fill a closed curve from a cursor defining coordinates *m: fillellipse && Draw filled ellipse specified by its bounding rectangle *m: fillpie && Draw filled pie slice in specified pen and start/stop angles *m: fillpolygon && Filll a polygon defined by a 2-column array of coordinates *m: fillpolygonfromcursor && Fill a polygon from a cursor defining coordinates *m: fillrectangle && Fill a rectangle *m: fillrectangles && Fill a series of rectangles defined by a 4-column array of coordinates *m: fillrectanglesfromcursor && Fill a series of rectangles defined by a cursor containing x,y,w,h values *m: flush && Force execution of all pending graphics operations *m: gethdc && Get handle to device context associated with this Graphics object. *m: interpolationmode_access *m: interpolationmode_assign *m: measurestringa && Measures ANSI text string when drawn with the specified Font and formatting *m: measurestringw && Measures Unicode text string when drawn with the specified Font and formatting *m: pagescale_access *m: pagescale_assign *m: pageunit_access *m: pageunit_assign *m: pixeloffsetmode_access *m: pixeloffsetmode_assign *m: releasehdc && Release device context previously obtained with GetHdc() *m: renderingorigin_access *m: renderingorigin_assign *m: resettransform && Reset the world transform matrix (to no transformation) *m: restore && Restore previously saved state *m: rotatetransform && Prepend rotation by specified angle to this object's transformation matrix *m: save && Save current state and return token (for later restore) *m: scaletransform && Apply scaling to transformation matrix for this graphics object *m: smoothingmode_access *m: smoothingmode_assign *m: textcontrast_access *m: textcontrast_assign *m: textrenderinghint_access *m: textrenderinghint_assign *m: translatetransform && Add translate by (x,y) to this graphics object's transformation matrix *m: visibleclipbounds_access *m: visibleclipbounds_assign *p: clipbounds && Returns GpRectangle object that bounds the clipping region of this graphics object . Note: if the clipping region is infinite, this returns a meaningless large rectangle *p: compositingmode && how composited images are drawn to this Graphics object *p: compositingquality && rendering quality of composited images drawn to this Graphics object *p: dpix && Horizontal resolution of drawing surface *p: dpiy && Vertical resolution of drawing surface *p: interpolationmode && interpolation mode associated with this Graphics object. *p: pagescale && The scaling between world units and page units *p: pageunit && The unit of measure used for page coordinates *p: pixeloffsetmode && Value specifying how pixels are offset during rendering of this Graphics object *p: renderingorigin && The rendering origin for dithering and for hatch brushes *p: smoothingmode && Rendering quality *p: textcontrast && Gamma corrrection value for rendering text *p: textrenderinghint && Rendering mode for text associated with this Graphics object *p: visibleclipbounds && Returns a GpRectange Object of the visible clipping region * * Name = "gpgraphics" pageunit = pixeloffsetmode = 0 _memberdata = * PROCEDURE clear && Clear entire drawing surface and fill with specified background color lparameters tvColor #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvColor)$'NO') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif Declare Integer GdipGraphicsClear In GDIPlus.Dll ; integer nGraphics, integer nColor This.gdipStatus = GdipGraphicsClear( ; This.gdipHandle ; , iif(vartype(m.tvColor)='O',m.tvColor.ARGB,m.tvColor) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE clipbounds_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif declare integer GdipGetClipBounds in gdiplus.dll ; integer nGraphics, string @ pRectF local lcRectF, loRect lcRectF = replicate(chr(0),16) This.gdipStatus = GdipGetClipBounds ( This.gdipHandle, @lcRectF ) if This.gdipStatus==GDIPLUS_STATUS_OK and len(m.lcRectF)==16 return This.ObjFactory('gpgraphics.clipbounds_access',GDIPLUS_CLASS_RECT,@lcRectF) else return null endif ENDPROC PROCEDURE clipbounds_assign LPARAMETERS vNewVal error 1743, 'ClipBounds' ENDPROC PROCEDURE compositingmode_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetCompositingMode in gdiplus.dll ; integer nGraphics, integer @ local nMode nMode = 0 This.gdipStatus = GdipGetCompositingMode( This.gdipHandle, @nMode) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nMode,cast(null as I)) ENDPROC PROCEDURE compositingmode_assign LPARAMETERS tnMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnMode)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetCompositingMode in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetCompositingMode( This.gdipHandle,m.tnMode) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE compositingquality_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetCompositingQuality in gdiplus.dll ; integer nGraphics, integer @ local nQuality nQuality = 0 This.gdipStatus = GdipGetCompositingQuality( This.gdipHandle, @nQuality) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nQuality,cast(null as I)) ENDPROC PROCEDURE compositingquality_assign LPARAMETERS tnQuality #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnQuality)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetCompositingQuality in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetCompositingQuality( This.gdipHandle,m.tnQuality) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE createfromhdc && Create Graphics object for a given device context (HDC) lparameters hDC #if GDIPLUS_CHECK_PARAMS if !(vartype(hDC)=='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif This.Destroy() declare integer GdipCreateFromHDC in gdiplus.dll ; integer hdc, integer @ nGraphics local nHandle nHandle = 0 This.gdipStatus = GdipCreateFromHDC ( m.hDC, @nHandle ) if GDIPLUS_STATUS_OK == This.gdipStatus This.SetHandle( m.nHandle,.T.) return .T. else return .F. endif ENDPROC PROCEDURE createfromhwnd && Create GDI+ Graphics object for a given window (HWND) lparameters hWND, tlICM as Logical #if GDIPLUS_CHECK_PARAMS if !(vartype(hWND)=='N' and vartype(m.tlICM)='L') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif This.Destroy() local nHandle nHandle = 0 if m.tlICM declare integer GdipCreateFromHWNDICM in gdiplus.dll ; integer hwnd, integer @ nGraphics This.gdipStatus = GdipCreateFromHWNDICM( m.hWND, @nHandle ) else declare integer GdipCreateFromHWND in gdiplus.dll ; integer hwnd, integer @ nGraphics This.gdipStatus = GdipCreateFromHWND( m.hWND, @nHandle ) endif if GDIPLUS_STATUS_OK == This.gdipStatus This.SetHandle(m.nHandle,.T.) return .T. else return .F. endif ENDPROC PROCEDURE createfromimage && Create graphics object from the specified GpImage object (to draw on that image's surface) lparameters toImage #if GDIPLUS_CHECK_PARAMS if !(vartype(toImage)=='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif This.Destroy() declare integer GdipGetImageGraphicsContext in gdiplus.dll ; integer nImage, integer @ nGraphics local nHandle nHandle = 0 This.gdipStatus = GdipGetImageGraphicsContext ( toImage.GetHandle(), @nHandle ) if GDIPLUS_STATUS_OK == This.gdipStatus This.SetHandle(m.nHandle,.T.) return .T. else return .F. endif ENDPROC PROCEDURE Destroy if This.gdipHandle>0 and This.gdipOwnsThisHandle declare integer GdipDeleteGraphics in gdiplus.dll integer GdipDeleteGraphics( This.gdipHandle ) This.gdipHandle = 0 This.gdipOwnsThisHandle = .F. endif ENDPROC PROCEDURE dpix_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare integer GdipGetDpiX in gdiplus.dll ; integer nGraphics, single @ fDPI local nDPI nDPI = 0.0 This.gdipStatus = GdipGetDpiX( This.gdipHandle, @nDPI) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nDPI,cast(null as B)) ENDPROC PROCEDURE dpix_assign LPARAMETERS vNewVal error 1743, 'DpiX' ENDPROC PROCEDURE dpiy_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare integer GdipGetDpiY in gdiplus.dll ; integer nGraphics, single @ fDPI local nDPI nDPI = 0.0 This.gdipStatus = GdipGetDpiY( This.gdipHandle, @nDPI) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nDPI,cast(null as B)) ENDPROC PROCEDURE dpiy_assign LPARAMETERS vNewVal error 1743, 'DpiY' ENDPROC PROCEDURE drawarc && Draws an arc representing a portion of an ellipse, given bounding rectangle of elllipse, start and sweep angles. lparameters toPen, x,y,nWidth,nHeight, nStartAngle, nSweepAngle #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)+vartype(x)+vartype(y)+vartype(nWidth)+vartype(nHeight)+vartype(nStartAngle)+vartype(nSweepAngle)=='ONNNNNN') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipDrawArc in gdiplus.dll ; integer nGraphics, integer nPen, single x, single y, single w,single h,single fStart, single fSweep This.gdipStatus = GdipDrawArc( THis.gdipHandle, toPen.GetHandle(), m.x,m.y,m.nWidth,m.nHeight,m.nStartAngle,m.nSweepAngle) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawbezier && Draw a B�zier spline from 4 control points lparameters toPen, x1,y1, x2,y2, x3,y3, x4,y4 #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)+vartype(x1)+vartype(y1)+vartype(x2)+vartype(y2)+vartype(x3)+vartype(y3)+vartype(x4)+vartype(y4)=='ONNNNNNNN') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipDrawBezier in gdiplus.dll ; integer nGraphics, integer nPen, single,single,single,single,single,single,single,single This.gdipStatus = GdipDrawBezier( This.gdipHandle, toPen.GetHandle() ; , m.x1,m.y1, m.x2,m.y2, m.x3,m.y3, m.x4,m.y4 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawbeziers && Draw a B�zier spline given a 2-column array of coordinates lparameters toPen, taPoints, tnFirstCol #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O' and (vartype(taPoints)='C' or type("taPoints[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints if vartype(taPoints)='C' lcPoints = m.taPoints else lcPoints = This.MakeGdipArrayF( @taPoints, 2, m.tnFirstCol ) endif declare integer GdipDrawBeziers in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawBeziers( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawbeziersfromcursor && Draw a B�zier spline given a cursor containing coordinates lparameters toPen, tcAlias, tcExprX, tcExprY #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints lcPoints = This.MakeGdipArrayFFromCursor( m.tcAlias, 2, m.tcExprX, m.tcExprY ) declare integer GdipDrawBeziers in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawBeziers( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawclosedcurve && Draw a closed curve given a 2-column array of coordinates lparameters toPen, taPoints, tnFirstCol #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O' and (vartype(taPoints)='C' or type("taPoints[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints if vartype(taPoints)='C' lcPoints = m.taPoints else lcPoints = This.MakeGdipArrayF( @taPoints, 2, m.tnFirstCol ) endif declare integer GdipDrawClosedCurve in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawClosedCurve( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawclosedcurvefromcursor && Draw a closed curve given a cursor containing coordinates lparameters toPen, tcAlias, tcExprX, tcExprY #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints lcPoints = This.MakeGdipArrayFFromCursor( m.tcAlias, 2, m.tcExprX, m.tcExprY ) declare integer GdipDrawClosedCurve in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawClosedCurve( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawcurve && Draw a smooth curve given a 2-column array of coordinates lparameters toPen, taPoints, tnFirstCol #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O' and (vartype(taPoints)='C' or type("taPoints[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints if vartype(taPoints)='C' lcPoints = m.taPoints else lcPoints = This.MakeGdipArrayF( @taPoints, 2, m.tnFirstCol ) endif declare integer GdipDrawCurve in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawCurve( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawcurvefromcursor && Draw a smooth curve given a cursor containing coordinates lparameters toPen, tcAlias, tcExprX, tcExprY #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints lcPoints = This.MakeGdipArrayFFromCursor( m.tcAlias, 2, m.tcExprX, m.tcExprY ) declare integer GdipDrawCurve in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawCurve( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawellipse && Draw outlined ellipse specified by its bounding rectangle lparameters toPen, tXOrRect,tnY,tnW,tnH * Parameters either ( pen, x,y,w,h ) * or ( pen, rect ) #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS do case case vartype(m.toPen)!='O' * Pen must be given (assume object is of correct type!) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. case vartype(m.tXOrRect)='N' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='NNN' * OK case vartype(m.tXOrRect)='O' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='LLL' ; and pemstatus(m.tXOrRect,'X',5) and pemstatus(m.tXOrRect,'W',5) * OK otherwise * Parameters do not pass the test error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase #endif declare Integer GdipDrawEllipse in gdiplus.dll ; integer nGraphics, integer nPen, single,single,single,single if vartype(m.tXOrRect)='O' This.gdipStatus = GdipDrawEllipse( This.gdipHandle, toPen.GetHandle() ; , m.tXOrRect.X,m.tXOrRect.Y, m.tXOrRect.W,m.tXOrRect.H ) else This.gdipStatus = GdipDrawEllipse( This.gdipHandle, toPen.GetHandle() ; , m.tXOrRect,m.tnY, m.tnW,m.tnH ) endif return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawimageat && Draw image at the specified location, using its original physical size lparameters toImage, destPtOrX,destY #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toImage)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lnDestX, lnDestY as Number do case case vartype(m.destPtOrX)+vartype(m.destY)='NN' * passed separate coordinates lnDestX = m.destPtOrX lnDestY = m.destY case vartype(m.destPtOrX)+vartype(m.destY)='OL' and pemstatus(m.destPtOrX,'X',5) * passed a point object (or a rect but we're ignoring width&height - this is unscaled) lnDestX = m.destPtOrX.X lnDestY = m.destPtOrX.Y otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase declare Integer GdipDrawImage in gdiplus.dll ; integer nGraphics, integer nImage, single,single This.gdipStatus = GdipDrawImage( This.gdipHandle, toImage.GetHandle() ; , m.lnDestX,m.lnDestY) return GDIPLUS_STATUS_OK==This.gdipStatus ENDPROC PROCEDURE drawimageportionat && Draw portion of an image at the specified location, using its original size lparameters toImage, destPoint,srcRect, srcUnit #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toImage)+vartype(m.destPoint)+vartype(m.srcRect)+vartype(m.srcUnit)=='OOON' ; and pemstatus(m.destPoint,'X',5) ; and pemstatus(m.srcRect,'X',5) and pemstatus(m.srcRect,'W',5)) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipDrawImagePointRect in gdiplus.dll ; integer nGraphics, integer nImage ; , single,single ; , single,single,single,single ; , integer This.gdipStatus = GdipDrawImagePointRect( This.gdipHandle, toImage.GetHandle() ; , m.destPoint.X,m.destPoint.Y ; , m.srcRect.X,m.srcRect.Y,m.srcRect.W,m.srcRect.H ; , m.srcUnit ) return GDIPLUS_STATUS_OK==This.gdipStatus ENDPROC PROCEDURE drawimageportionscaled && Draw portion of an image at the specified location and with the specified size lparameters toImage, destRect,srcRect, srcUnit, imageAttribs * This function allows an optional ImageAttributes object. Since this class * isn't currently implemented in the FFC classes, allow an integer pointer * to be passed in, so that the called can implement themselves #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toImage)+vartype(m.destRect)+vartype(m.srcRect)+vartype(m.srcUnit)=='OOON' ; and vartype(m.imageAttribs)$'ONL' ; and pemstatus(m.destRect,'X',5) and pemstatus(m.destRect,'W',5) ; and pemstatus(m.srcRect,'X',5) and pemstatus(m.srcRect,'W',5)) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipDrawImageRectRect in gdiplus.dll ; integer nGraphics, integer nImage ; , single,single,single,single ; , single,single,single,single ; , integer nSrcUnit ; , integer nImgAttribs ; , integer nCallback, integer nCallbackData This.gdipStatus = GdipDrawImageRectRect( This.gdipHandle, toImage.GetHandle() ; , m.destRect.X,m.destRect.Y,m.destRect.W,m.destRect.H ; , m.srcRect.X,m.srcRect.Y,m.srcRect.W,m.srcRect.H ; , m.srcUnit ; , icase( vartype(m.imageAttribs)='O',m.imageAttribs.GetHandle() ; ,vartype(m.imageAttribs)='N',m.imageAttributes ; , 0 ) ; , 0, 0 ) return GDIPLUS_STATUS_OK==This.gdipStatus ENDPROC PROCEDURE drawimagescaled && Draw image at the specified location with the specified size. lparameters toImage as GpImage, destRectOrX,destY,destW,destH #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toImage)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lnDestX, lnDestY, lnDestW, lnDestH as Number do case case vartype(m.destRectOrX)+vartype(m.destY)+vartype(m.destW)+vartype(m.destH)='NNNN' * passed separate coordinates lnDestX = m.destRectOrX lnDestY = m.destY lnDestW = m.destW lnDestH = m.destH case vartype(m.destRectOrX)+vartype(m.destY)+vartype(m.destW)+vartype(m.destH)='OLLL' ; and pemstatus(m.destRectOrX,'X',5) and pemstatus(m.destRectOrX,'W',5) * passed a Rect object lnDestX = m.destRectOrX.X lnDestY = m.destRectOrX.Y lnDestW = m.destRectOrX.W lnDestH = m.destRectOrX.H otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase declare Integer GdipDrawImageRect in gdiplus.dll ; integer nGraphics, integer nImage, single,single,single,single This.gdipStatus = GdipDrawImageRect ( This.gdipHandle, toImage.GetHandle() ; , m.lnDestX,m.lnDestY, m.lnDestW,m.lnDestH ) return GDIPLUS_STATUS_OK==This.gdipStatus ENDPROC PROCEDURE drawline && Draw a line that connects two points, in the specified pen. lparameters toPen as GpPen, x1,y1,x2,y2 #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)+vartype(m.x1)+vartype(m.y1)+vartype(m.x2)+vartype(m.y2)=='ONNNN') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipDrawLine in gdiplus.dll ; integer nGraphics, integer nPen, single,single,single,single This.gdipStatus = GdipDrawLine( This.gdipHandle, toPen.GetHandle(), m.x1,m.y1, m.x2,m.y2 ) return This.gdipStatus = GDIPLUS_STATUS_OK ENDPROC PROCEDURE drawlines && Draw sequence of connected lines, given array of coordinates lparameters toPen as GpPen, taPoints, tnFirstCol as integer #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O' and (vartype(taPoints)='C' or type("taPoints[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints if vartype(taPoints)='C' lcPoints = m.taPoints else lcPoints = This.MakeGdipArrayF( @taPoints, 2, m.tnFirstCol ) endif declare integer GdipDrawLines in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawLines( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawlinesfromcursor && Draw sequence of connected lines, given cursor containing coordinates lparameters toPen as GpPen, tcAlias as String, tcExprX as String, tcExprY as String #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints lcPoints = This.MakeGdipArrayFFromCursor( m.tcAlias, 2, m.tcExprX, m.tcExprY ) declare integer GdipDrawLines in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawLines( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawpie && Draw outlined pie slice in specified pen and start/stop anagles lparameters toPen, tXOrRect,tnYOrStart,tnWOrSweep,tnH, nStart, nSweep * Parameters either ( pen, x,y,w,h, start, sweep ) * or ( pen, rect, start, sweep ) #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS do case case vartype(m.toPen)!='O' * Pen must be given (assume object is of correct type!) * Start and sweep angles are required error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. case vartype(m.tXOrRect)='N' ; and vartype(m.tnYOrStart)+vartype(m.tnWOrSweep)+vartype(m.tnH)+vartype(nStart)+vartype(nSweep)=='NNNNN' * OK case vartype(m.tXOrRect)='O' ; and vartype(m.tnYOrStart)+vartype(m.tnWOrSweep)+vartype(m.tnH)+vartype(nStart)+vartype(nSweep)=='NNLLL' ; and pemstatus(m.tXOrRect,'X',5) and pemstatus(m.tXOrRect,'W',5) * OK otherwise * Parameters do not pass the test error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase #endif declare integer GdipDrawPie in gdiplus.dll ; integer nGraphics, integer nPen ; , single x, single y, single w,single h ; ,single fStart, single fSweep if vartype(m.tXOrRect)='O' This.gdipStatus = GdipDrawPie( This.gdipHandle, toPen.GetHandle() ; , m.tXOrRect.X,m.tXOrRect.Y, m.tXOrRect.W,m.tXOrRect.H ; , m.tnYOrStart,m.tnWOrSweep ) else This.gdipStatus = GdipDrawPie( This.gdipHandle, toPen.GetHandle() ; , m.tXOrRect,m.tnYOrStart, m.tnWOrSweep,m.tnH ; , m.nStart,m.nSweep ) endif return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawpolygon && Draw a polygon given a 2-column array of coordinates lparameters toPen, taPoints, tnFirstCol #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O' and (vartype(taPoints)='C' or type("taPoints[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints if vartype(taPoints)='C' lcPoints = m.taPoints else lcPoints = This.MakeGdipArrayF( @taPoints, 2, m.tnFirstCol ) endif declare integer GdipDrawPolygon in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawPolygon( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawpolygonfromcursor && Draw a polygon given a cursor containing coordinates lparameters toPen, tcAlias, tcExprX, tcExprY #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints lcPoints = This.MakeGdipArrayFFromCursor( m.tcAlias, 2, m.tcExprX, m.tcExprY ) declare integer GdipDrawPolygon in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount This.gdipStatus = GdipDrawPolygon( This.gdipHandle, toPen.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawrectangle && Draw a rectangle lparameters toPen, tXOrRect,tnY,tnW,tnH * Parameters either ( pen, x,y,w,h ) * or ( pen, rect ) #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS do case case vartype(m.toPen)!='O' * Pen must be given (assume object is of correct type!) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. case vartype(m.tXOrRect)='N' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='NNN' * OK case vartype(m.tXOrRect)='O' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='LLL' ; and pemstatus(m.tXOrRect,'X',5) and pemstatus(m.tXOrRect,'W',5) * OK otherwise * Parameters do not pass the test error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase #endif declare Integer GdipDrawRectangle in gdiplus.dll ; integer nGraphics, integer nPen, single,single,single,single if vartype(m.tXOrRect)='O' This.gdipStatus = GdipDrawRectangle( This.gdipHandle, toPen.GetHandle() ; , m.tXOrRect.X,m.tXOrRect.Y, m.tXOrRect.W,m.tXOrRect.H ) else This.gdipStatus = GdipDrawRectangle( This.gdipHandle, toPen.GetHandle() ; , m.tXOrRect,m.tnY, m.tnW,m.tnH ) endif return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawrectangles && Draw a series of rectangles given a 4-column array (each row x,y,w,h) lparameters toPen, taRects, tnFirstCol #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O' and (vartype(taRects)='C' or type("taRects[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcRects if vartype(taRects)='C' lcRects = m.taRects else lcRects = This.MakeGdipArrayF( @taRects, 4, m.tnFirstCol ) endif declare integer GdipDrawRectangles in gdiplus.dll ; integer nGraphics, integer nPen, string cRects, integer nCount This.gdipStatus = GdipDrawRectangles( This.gdipHandle, toPen.GetHandle() ; , m.lcRects, len(m.lcRects)/16 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawrectanglesfromcursor && Draw a series of rectangles given a cursor containing x,y,w,h values lparameters toPen, tcAlias, tcExprX, tcExprY, tcExprW, tcExprH #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toPen)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcRects lcRects = This.MakeGdipArrayFFromCursor( m.tcAlias, 4, m.tcExprX, m.tcExprY, m.tcExprW, m.tcExprH ) declare integer GdipDrawRectangles in gdiplus.dll ; integer nGraphics, integer nPen, string cRects, integer nCount This.gdipStatus = GdipDrawRectangles( This.gdipHandle, toPen.GetHandle() ; , m.lcRects, len(m.lcRects)/16 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawstringa && Draw a string in specified font and position (ANSI Version) lparameters tcAnsiString, toFont, tvRectPoint, toStringFormat, toBrush #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcAnsiString)='C' and vartype(m.toFont)$'OL' ; and vartype(m.toStringFormat)$'OL' and vartype(m.toBrush)$'OL') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcRect do case case vartype(tvRectPoint)$'CQ' && String or varbinary do case case len(m.tvRectPoint)==8 && point lcRect = m.tvRectPoint + replicate(chr(0),8) case len(m.tvRectPoint)==16 && rect lcRect = m.tvRectPoint otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase case vartype(m.tvRectPoint) == 'O' do case case pemstatus(m.tvRectPoint,'gdipRectF',5) && Rect lcRect = tvRectPoint.GdipRectF case pemstatus(m.tvRectPoint,'gdipPointF',5) && Point lcRect = tvRectPoint.GdipPointF + replicate(chr(0),8) otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase declare integer GdipDrawString in gdiplus.dll ; integer,string,integer,integer,string,integer,integer This.gdipStatus = GdipDrawString( ; This.gdipHandle ; , strconv(m.tcAnsiString,5) ; , len(m.tcAnsiString) ; , iif(vartype(m.toFont)='O',toFont.GetHandle(),0) ; , m.lcRect ; , iif(vartype(m.toStringFormat)='O',toStringFormat.GetHandle(),0) ; , iif(vartype(m.toBrush)='O',toBrush.GetHandle(),0) ; ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE drawstringw && Draw a string in specified font and position (Unicode Version) lparameters tcUnicodeString, toFont, tvRectPoint, toStringFormat, toBrush #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcUnicodeString)='C' and vartype(m.toFont)$'OL' ; and vartype(m.toStringFormat)$'OL' and vartype(m.toBrush)$'OL') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcRect do case case vartype(tvRectPoint)$'CQ' && String or varbinary do case case len(m.tvRectPoint)==8 && point lcRect = m.tvRectPoint + replicate(chr(0),8) case len(m.tvRectPoint)==16 && rect lcRect = m.tvRectPoint otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase case vartype(m.tvRectPoint) == 'O' do case case pemstatus(m.tvRectPoint,'gdipRectF',5) && Rect lcRect = tvRectPoint.GdipRectF case pemstatus(m.tvRectPoint,'gdipPointF',5) && Point lcRect = tvRectPoint.GdipPointF + replicate(chr(0),8) otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase declare integer GdipDrawString in gdiplus.dll ; integer,string,integer,integer,string,integer,integer This.gdipStatus = GdipDrawString( ; This.gdipHandle ; , m.tcUnicodeString ; , len(m.tcUnicodeString)/2 ; , iif(vartype(m.toFont)='O',toFont.GetHandle(),0) ; , m.lcRect ; , iif(vartype(m.toStringFormat)='O',toStringFormat.GetHandle(),0) ; , iif(vartype(m.toBrush)='O',toBrush.GetHandle(),0) ; ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillclosedcurve && Fill a closed curve defined by a 2-column array of coordinates lparameters toBrush, taPoints, tnFirstCol, tnFillMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toBrush)='O' and vartype(m.tnFillMode)$'LN' and (vartype(taPoints)='C' or type("taPoints[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints if vartype(taPoints)='C' lcPoints = m.taPoints else lcPoints = This.MakeGdipArrayF( @taPoints, 2, m.tnFirstCol ) endif declare integer GdipFillClosedCurve in gdiplus.dll ; integer nGraphics, integer nPen, string cPoints, integer nCount, integer nFillMode This.gdipStatus = GdipFillClosedCurve( This.gdipHandle, toBrush.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8,evl(m.tnFillMode,GDIPLUS_FillMode_Alternate) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillclosedcurvefromcursor && Fill a closed curve from a cursor defining coordinates lparameters toBrush, tcAlias, tcExprX, tcExprY, tnFillMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toBrush)='O' and vartype(m.tnFillMode)$'LN' ) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints lcPoints = This.MakeGdipArrayFFromCursor( m.tcAlias, 2, m.tcExprX, m.tcExprY ) declare integer GdipFillClosedCurve in gdiplus.dll ; integer nGraphics, integer nBrush, string cPoints, integer nCount, integer nFillMode This.gdipStatus = GdipFillClosedCurve( This.gdipHandle, toBrush.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8,evl(m.tnFillMode,GDIPLUS_FillMode_Alternate) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillellipse && Draw filled ellipse specified by its bounding rectangle lparameters toBrush, tXOrRect,tnY,tnW,tnH * Parameters either ( brush, x,y,w,h ) * or ( brush, rect ) #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS do case case vartype(m.toBrush)!='O' * Brush must be given (assume object is of correct type!) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. case vartype(m.tXOrRect)='N' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='NNN' * OK case vartype(m.tXOrRect)='O' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='LLL' ; and pemstatus(m.tXOrRect,'X',5) and pemstatus(m.tXOrRect,'W',5) * OK otherwise * Parameters do not pass the test error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase #endif declare Integer GdipFillEllipse in gdiplus.dll ; integer nGraphics, integer nBrush, single,single,single,single if vartype(m.tXOrRect)='O' This.gdipStatus = GdipFillEllipse( This.gdipHandle, toBrush.GetHandle() ; , m.tXOrRect.X,m.tXOrRect.Y, m.tXOrRect.W,m.tXOrRect.H ) else This.gdipStatus = GdipFillEllipse( This.gdipHandle, toBrush.GetHandle() ; , m.tXOrRect,m.tnY, m.tnW,m.tnH ) endif return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillpie && Draw filled pie slice in specified pen and start/stop angles lparameters toBrush, tXOrRect,tnYOrStart,tnWOrSweep,tnH, nStart, nSweep * Parameters either ( brush, x,y,w,h, start, sweep ) * or ( brush, rect, start, sweep ) #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS do case case vartype(m.toBrush)!='O' * Brush must be given (assume object is of correct type!) * Start and sweep angles are required error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. case vartype(m.tXOrRect)='N' ; and vartype(m.tnYOrStart)+vartype(m.tnWOrSweep)+vartype(m.tnH)+vartype(nStart)+vartype(nSweep)=='NNNNN' * OK case vartype(m.tXOrRect)='O' ; and vartype(m.tnYOrStart)+vartype(m.tnWOrSweep)+vartype(m.tnH)+vartype(nStart)+vartype(nSweep)=='NNLLL' ; and pemstatus(m.tXOrRect,'X',5) and pemstatus(m.tXOrRect,'W',5) * OK otherwise * Parameters do not pass the test error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase #endif declare integer GdipFillPie in gdiplus.dll ; integer nGraphics, integer nBrush ; , single x, single y, single w,single h ; ,single fStart, single fSweep if vartype(m.tXOrRect)='O' This.gdipStatus = GdipFillPie( This.gdipHandle, toBrush.GetHandle() ; , m.tXOrRect.X,m.tXOrRect.Y, m.tXOrRect.W,m.tXOrRect.H ; , m.tnYOrStart,m.tnWOrSweep ) else This.gdipStatus = GdipFillPie( This.gdipHandle, toBrush.GetHandle() ; , m.tXOrRect,m.tnYOrStart, m.tnWOrSweep,m.tnH ; , m.nStart,m.nSweep ) endif return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillpolygon && Filll a polygon defined by a 2-column array of coordinates lparameters toBrush, taPoints, tnFirstCol, tnFillMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toBrush)='O' and vartype(m.tnFillMode)$'LN' and (vartype(taPoints)='C' or type("taPoints[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints if vartype(taPoints)='C' lcPoints = m.taPoints else lcPoints = This.MakeGdipArrayF( @taPoints, 2, m.tnFirstCol ) endif declare integer GdipFillPolygon in gdiplus.dll ; integer nGraphics, integer nBrush, string cPoints, integer nCount, integer nFillMode This.gdipStatus = GdipFillPolygon( This.gdipHandle, toBrush.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8,evl(m.tnFillMode,GDIPLUS_FillMode_Alternate) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillpolygonfromcursor && Fill a polygon from a cursor defining coordinates lparameters toBrush, tcAlias, tcExprX, tcExprY, tnFillMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toBrush)='O' and vartype(m.tnFillMode)$'LN' ) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcPoints lcPoints = This.MakeGdipArrayFFromCursor( m.tcAlias, 2, m.tcExprX, m.tcExprY ) declare integer GdipFillPolygon in gdiplus.dll ; integer nGraphics, integer nBrush, string cPoints, integer nCount, integer nFillMode This.gdipStatus = GdipFillPolygon( This.gdipHandle, toBrush.GetHandle() ; , m.lcPoints, len(m.lcPoints)/8,evl(m.tnFillMode,GDIPLUS_FillMode_Alternate) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillrectangle && Fill a rectangle lparameters toBrush, tXOrRect,tnY,tnW,tnH * Parameters either ( brush, x,y,w,h ) * or ( brush, rect ) #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS do case case vartype(m.toBrush)!='O' * Brush must be given (assume object is of correct type!) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. case vartype(m.tXOrRect)='N' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='NNN' * OK case vartype(m.tXOrRect)='O' ; and vartype(m.tnY)+vartype(m.tnW)+vartype(m.tnH)=='LLL' ; and pemstatus(m.tXOrRect,'X',5) and pemstatus(m.tXOrRect,'W',5) * OK otherwise * Parameters do not pass the test error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase #endif declare Integer GdipFillRectangle in gdiplus.dll ; integer nGraphics, integer nBrush, single,single,single,single if vartype(m.tXOrRect)='O' This.gdipStatus = GdipFillRectangle( This.gdipHandle, toBrush.GetHandle() ; , m.tXOrRect.X,m.tXOrRect.Y, m.tXOrRect.W,m.tXOrRect.H ) else This.gdipStatus = GdipFillRectangle( This.gdipHandle, toBrush.GetHandle() ; , m.tXOrRect,m.tnY, m.tnW,m.tnH ) endif return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillrectangles && Fill a series of rectangles defined by a 4-column array of coordinates lparameters toBrush, taRects, tnFirstCol #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toBrush)='O' and (vartype(taRects)='C' or type("taRects[1,1]")='N')) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcRects if vartype(taRects)='C' lcRects = m.taRects else lcRects = This.MakeGdipArrayF( @taRects, 4, m.tnFirstCol ) endif declare integer GdipFillRectangles in gdiplus.dll ; integer nGraphics, integer nPen, string cRects, integer nCount This.gdipStatus = GdipFillRectangles( This.gdipHandle, toBrush.GetHandle() ; , m.lcRects, len(m.lcRects)/16 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE fillrectanglesfromcursor && Fill a series of rectangles defined by a cursor containing x,y,w,h values lparameters toBrush, tcAlias, tcExprX, tcExprY, tcExprW, tcExprH #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(toBrush)='O') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif local lcRects lcRects = This.MakeGdipArrayFFromCursor( m.tcAlias, 4, m.tcExprX, m.tcExprY, m.tcExprW, m.tcExprH ) declare integer GdipFillRectangles in gdiplus.dll ; integer nGraphics, integer nPen, string cRects, integer nCount This.gdipStatus = GdipFillRectangles( This.gdipHandle, toBrush.GetHandle() ; , m.lcRects, len(m.lcRects)/16 ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE flush && Force execution of all pending graphics operations lparameters tnFlushIntention #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnFlushIntention)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipFlush in gdiplus.dll ; integer nGraphics, integer nFlushIntention This.gdipStatus = GdipFlush(This.gdipHandle,m.tnFlushIntention) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE gethdc && Get handle to device context associated with this Graphics object. #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif local lnHDC lnHDC = 0 declare integer GdipGetDC in gdiplus.dll ; integer, integer @ This.gdipStatus = GdipGetDC( This.gdipHandle, @lnHDC ) if GDIPLUS_STATUS_OK == This.gdipStatus return m.lnHDC else return cast(null as I) endif ENDPROC PROCEDURE interpolationmode_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetInterpolationMode in gdiplus.dll ; integer nGraphics, integer @ local nMode nMode = 0 This.gdipStatus = GdipGetInterpolationMode ( This.gdipHandle, @nMode) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nMode,cast(null as I)) ENDPROC PROCEDURE interpolationmode_assign LPARAMETERS tnInterpMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnInterpMode)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetInterpolationMode in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetInterpolationMode ( This.gdipHandle,m.tnInterpMode) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE measurestringa && Measures ANSI text string when drawn with the specified Font and formatting lparameters tcAnsiString, toFont, tvLayoutArea, toStringFormat, rnCharsFitted, rnLinesFilled #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcAnsiString)='C' and vartype(m.toFont)$'OL' ; and vartype(m.toStringFormat)$'OL') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return null endif #endif local lcRectF && layout rectangle do case case vartype(tvLayoutArea)$'CQ' && String or varbinary do case case len(m.tvLayoutArea)==8 && sizeF lcRectF = replicate(chr(0),8)+m.tvLayoutArea case len(m.tvLayoutArea)==16 && rect lcRectF = cast(m.tvLayoutArea as C(16)) otherwise * Empty lcRectF = replicate(chr(0),16) endcase case vartype(m.tvLayoutArea) == 'O' do case case pemstatus(m.tvLayoutArea,'gdipRectF',5) && Rect lcRect = tvLayoutArea.GdipRectF case pemstatus(m.tvLayoutArea,'GdipSizeF',5) && Size lcRect = replicate(chr(0),8)+tvLayoutArea.GdipSizeF otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return null endcase case vartype(m.tvLayoutArea) == 'N' && Width only lcRectF = replicate(chr(0),8)+bintoc(m.tvLayoutArea,'F')+replicate(chr(0),4) otherwise * Not given lcRectF = replicate(chr(0),16) endcase declare integer GdipMeasureString in gdiplus.dll ; integer nGraphics,string cUnicode,integer nLength ; ,integer nFont,string cLayoutRect,integer nStringFormat ; , string @cRectOut, integer @nChars, integer @nLines local lcBoundingBox as String, lnCharsFitted as Integer, lnLinesFilled as Integer lcBoundingBox = replicate(chr(0),16) && empty rectangle lnCharsFitted = 0 lnLinesFilled = 0 This.gdipStatus = GdipMeasureString( ; This.gdipHandle ; , strconv(m.tcAnsiString,5) ; , len(m.tcAnsiString) ; , iif(vartype(m.toFont)='O',toFont.GetHandle(),0) ; , m.lcRectF ; , iif(vartype(m.toStringFormat)='O',toStringFormat.GetHandle(),0) ; , @ lcBoundingBox ; , @lnCharsFitted, @lnLinesFilled ; ) if GDIPLUS_STATUS_OK == This.gdipStatus * Return result rnCharsFitted = m.lnCharsFitted rnLinesFilled = m.lnLinesFilled * return size - the SECOND 8 bytes of the rectF structure return This.ObjFactory('gpgraphics.measurestring',GDIPLUS_CLASS_SIZE,substr(m.lcBoundingBox,9)) else return null && Failed endif ENDPROC PROCEDURE measurestringw && Measures Unicode text string when drawn with the specified Font and formatting lparameters tcUnicodeString, toFont, tvLayoutArea, toStringFormat, rnCharsFitted, rnLinesFilled #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcUnicodeString)='C' and vartype(m.toFont)$'OL' ; and vartype(m.toStringFormat)$'OL') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return null endif #endif local lcRectF && layout rectangle do case case vartype(tvLayoutArea)$'CQ' && String or varbinary do case case len(m.tvLayoutArea)==8 && sizeF lcRectF = replicate(chr(0),8)+m.tvLayoutArea case len(m.tvLayoutArea)==16 && rect lcRectF = cast(m.tvLayoutArea as C(16)) otherwise * Empty lcRectF = replicate(chr(0),16) endcase case vartype(m.tvLayoutArea) == 'O' * Assume GpSize object lcRectF = replicate(chr(0),8)+tvLayoutArea.GdipSizeF case vartype(m.tvLayoutArea) == 'N' && Width only lcRectF = replicate(chr(0),8)+bintoc(m.tvLayoutArea,'F')+replicate(chr(0),4) otherwise * Not given lcRectF = replicate(chr(0),16) endcase declare integer GdipMeasureString in gdiplus.dll ; integer nGraphics,string cUnicode,integer nLength ; ,integer nFont,string cLayoutRect,integer nStringFormat ; , string @cRectOut, integer @nChars, integer @nLines local lcBoundingBox as String, lnCharsFitted as Integer, lnLinesFilled as Integer lcBoundingBox = replicate(chr(0),16) && empty rectangle lnCharsFitted = 0 lnLinesFilled = 0 This.gdipStatus = GdipMeasureString( ; This.gdipHandle ; , m.tcUnicodeString ; , len(m.tcUnicodeString)/2 ; , iif(vartype(m.toFont)='O',toFont.GetHandle(),0) ; , m.lcRectF ; , iif(vartype(m.toStringFormat)='O',toStringFormat.GetHandle(),0) ; , @ lcBoundingBox ; , @lnCharsFitted, @lnLinesFilled ; ) if GDIPLUS_STATUS_OK == This.gdipStatus * Return result rnCharsFitted = m.lnCharsFitted rnLinesFilled = m.lnLinesFilled * return size - the SECOND 8 bytes of the rectF structure return This.ObjFactory('gpgraphics.measurestring',GDIPLUS_CLASS_SIZE,substr(m.lcBoundingBox,9)) else return null && Failed endif ENDPROC PROCEDURE pagescale_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare integer GdipGetPageScale in gdiplus.dll ; integer nGraphics, single @ local nPageScale nPageScale = 0.0 This.gdipStatus = GdipGetPageScale( This.gdipHandle, @nPageScale) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nPageScale,cast(null as B)) ENDPROC PROCEDURE pagescale_assign LPARAMETERS tnScale #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnScale)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetPageScale in gdiplus.dll ; integer nGraphics, single This.gdipStatus = GdipSetPageScale( This.gdipHandle,m.tnScale) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE pageunit_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetPageUnit in gdiplus.dll ; integer nGraphics, integer @ local nUnit nUnit = 0 This.gdipStatus = GdipGetPageUnit( This.gdipHandle, @nUnit) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nUnit,cast(null as I)) ENDPROC PROCEDURE pageunit_assign LPARAMETERS tnUnit #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnUnit)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetPageUnit in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetPageUnit( This.gdipHandle,m.tnUnit) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE pixeloffsetmode_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetPixelOffsetMode in gdiplus.dll ; integer nGraphics, integer @ local nMode nMode = 0 This.gdipStatus = GdipGetPixelOffsetMode( This.gdipHandle, @nMode) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nMode,cast(null as I)) ENDPROC PROCEDURE pixeloffsetmode_assign LPARAMETERS tnMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnMode)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetPixelOffsetMode in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetPixelOffsetMode ( This.gdipHandle,m.tnMode) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE releasehdc && Release device context previously obtained with GetHdc() lparameters tnHDC as integer #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnHDC)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipReleaseDC in gdiplus.dll ; integer, integer This.gdipStatus = GdipReleaseDC( This.gdipHandle, tnHDC ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE renderingorigin_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif declare integer GdipGetRenderingOrigin in gdiplus.dll ; integer nGraphics, integer @ x, integer @ y local lnX, lnY lnX = 0 lnY = 0 This.gdipStatus = GdipGetRenderingOrigin( This.gdipHandle, @lnX, @lnY ) if This.gdipStatus==GDIPLUS_STATUS_OK return This.ObjFactory('gpgraphics.renderingorigin_access',GDIPLUS_CLASS_POINT,m.lnX,m.lnY) else return null endif ENDPROC PROCEDURE renderingorigin_assign LPARAMETERS toPoint #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toPoint)='O' and pemstatus(toPoint,'X',5)) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetRenderingOrigin in gdiplus.dll ; integer nGraphics, integer x, integer y This.gdipStatus = GdipSetRenderingOrigin( This.gdipHandle,m.toPoint.X,m.toPoint.Y) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE resettransform && Reset the world transform matrix (to no transformation) #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare integer GdipResetWorldTransform in gdiplus.dll ; integer nGraphics This.gdipStatus = GdipResetWorldTransform( This.gdipHandle ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE restore && Restore previously saved state lparameters tnGraphicsState #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnGraphicsState)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipRestoreGraphics in gdiplus.dll ; integer, integer This.gdipStatus = GdipRestoreGraphics( This.gdipHandle, m.tnGraphicsState ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE rotatetransform && Prepend rotation by specified angle to this object's transformation matrix lparameters tnAngle, tnMatrixOrder #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnAngle)='N' and vartype(m.tnMatrixOrder)$'LN') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipRotateWorldTransform in gdiplus.dll ; integer nGraphics, single nAngle, integer nMatrixOrder This.gdipStatus = GdipRotateWorldTransform( This.gdipHandle ; , m.tnAngle, evl(m.tnMatrixOrder,GDIPLUS_MatrixOrder_Prepend) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE save && Save current state and return token (for later restore) lparameters rnGraphicsState #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif local lnState lnState = 0 declare integer GdipSaveGraphics in gdiplus.dll ; integer, integer @ This.gdipStatus = GdipSaveGraphics( This.gdipHandle, @lnState ) if GDIPLUS_STATUS_OK == This.gdipStatus rnGraphicsState = m.lnState return .T. else return .F. endif ENDPROC PROCEDURE scaletransform && Apply scaling to transformation matrix for this graphics object lparameters tnScaleX, tnScaleY, tnMatrixOrder #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnScaleX)='N' and vartype(m.tnScaleY)='N' and vartype(m.tnMatrixOrder)$'LN') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipScaleWorldTransform in gdiplus.dll ; integer nGraphics, single nScaleX, single nScaleY, integer nMatrixOrder This.gdipStatus = GdipScaleWorldTransform( This.gdipHandle ; , m.tnScaleX, m.tnScaleY, evl(m.tnMatrixOrder,GDIPLUS_MatrixOrder_Prepend) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE smoothingmode_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetSmoothingMode in gdiplus.dll ; integer nGraphics, integer @ local nSmoothingMode nSmoothingMode = 0 This.gdipStatus = GdipGetSmoothingMode( This.gdipHandle, @nSmoothingMode) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nSmoothingMode,cast(null as I)) ENDPROC PROCEDURE smoothingmode_assign LPARAMETERS tnMode #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnMode)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetSmoothingMode in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetSmoothingMode( This.gdipHandle,m.tnMode) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE textcontrast_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetTextContrast in gdiplus.dll ; integer nGraphics, integer @ local nValue nValue = 0 This.gdipStatus = GdipGetTextContrast( This.gdipHandle, @nValue) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nValue,cast(null as I)) ENDPROC PROCEDURE textcontrast_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetTextContrast in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetTextContrast( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE textrenderinghint_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetTextRenderingHint in gdiplus.dll ; integer nGraphics, integer @ local nHint nHint = 0 This.gdipStatus = GdipGetTextRenderingHint( This.gdipHandle, @nHint) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nHint,cast(null as I)) ENDPROC PROCEDURE textrenderinghint_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipSetTextRenderingHint in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetTextRenderingHint( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE translatetransform && Add translate by (x,y) to this graphics object's transformation matrix lparameters tnOffsetX, tnOffsetY, tnMatrixOrder #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnOffsetX)='N' and vartype(m.tnOffsetY)='N' and vartype(m.tnMatrixOrder)$'LN') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipTranslateWorldTransform in gdiplus.dll ; integer nGraphics, single nOffsetX, single nOffsetY, integer nMatrixOrder This.gdipStatus = GdipTranslateWorldTransform( This.gdipHandle ; , m.tnOffsetX, m.tnOffsetY, evl(m.tnMatrixOrder,GDIPLUS_MatrixOrder_Prepend) ) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE visibleclipbounds_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif declare integer GdipGetVisibleClipBounds in gdiplus.dll ; integer nGraphics, string @ pRectF local lcRectF, loRect lcRectF = replicate(chr(0),16) This.gdipStatus = GdipGetVisibleClipBounds( This.gdipHandle, @lcRectF ) if This.gdipStatus==GDIPLUS_STATUS_OK and len(m.lcRectF)==16 return This.ObjFactory('gpgraphics.visibleclipbounds_access',GDIPLUS_CLASS_RECT,@lcRectF) else return null endif ENDPROC PROCEDURE visibleclipbounds_assign LPARAMETERS vNewVal error 1743, 'VisibleClipBounds' ENDPROC ENDDEFINE DEFINE CLASS gphatchbrush AS gpbrush OF "_gdiplus.vcx" && A brush object which fills with a hatch pattern. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: backgroundcolor_access *m: backgroundcolor_assign *m: create && Create solid brush in given color *m: foregroundcolor_access *m: foregroundcolor_assign *m: hatchstyle_access *m: hatchstyle_assign *p: backgroundcolor && Color of space between hatch lines *p: foregroundcolor && Color of hatch lines *p: hatchstyle && Hatch style of this brush object * * hatchstyle = 0 Name = "gphatchbrush" _memberdata = * PROCEDURE backgroundcolor_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetHatchBackgroundColor in gdiplus.dll ; integer, integer @ local nARGB nARGB = 0 This.gdipStatus = GdipGetHatchBackgroundColor( This.gdipHandle, @nARGB ) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nARGB,cast(null as I)) ENDPROC PROCEDURE backgroundcolor_assign LPARAMETERS tvColor error 1743, 'BackgroundColor' ENDPROC PROCEDURE create && Create solid brush in given color lparameters tnStyle, tvForeColor, tvBackColor * tnStyle must be HatchStyle constant #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnStyle)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif this.Destroy() local nHandle nHandle = 0 Declare Integer GdipCreateHatchBrush In GDIPlus.Dll ; integer nHatchStyle, integer nForeColor, integer nBackColor, Integer @nBrush This.gdipStatus = GdipCreateHatchBrush( ; m.tnStyle ; , iif(vartype(m.tvForeColor)='O',m.tvForeColor.ARGB,iif(vartype(m.tvForeColor)='N',m.tvForeColor,0xFF000000)) ; , iif(vartype(m.tvBackColor)='O',m.tvBackColor.ARGB,iif(vartype(m.tvBackColor)='N',m.tvBackColor,0xFFFFFFFF)) ; , @nHandle) This.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE foregroundcolor_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetHatchForegroundColor in gdiplus.dll ; integer, integer @ local nARGB nARGB = 0 This.gdipStatus = GdipGetHatchForegroundColor( This.gdipHandle, @nARGB ) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nARGB,cast(null as I)) ENDPROC PROCEDURE foregroundcolor_assign LPARAMETERS tvColor error 1743, 'ForegroundColor' ENDPROC PROCEDURE hatchstyle_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetHatchStyle in gdiplus.dll ; integer, integer @ local nHatchStyle nHatchStyle = 0 This.gdipStatus = GdipGetHatchStyle( This.gdipHandle, @nHatchStyle ) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nHatchStyle,cast(null as I)) ENDPROC PROCEDURE hatchstyle_assign LPARAMETERS vNewVal error 1743, 'HatchStyle' ENDPROC PROCEDURE Init lparameters tnStyle, tvForeColor, tvBackColor if not dodefault() return .F. endif if pcount()>0 return This.Create(m.tnStyle, m.tvForeColor, m.tvBackColor) endif ENDPROC ENDDEFINE DEFINE CLASS gpimage AS gpobject OF "_gdiplus.vcx" && Encapsulates a GDI+ image, and serves as the base class for specific image types (for example, the gpBitmap class). *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: createfromfile && Create Image object from a file on disk *m: flags_access *m: flags_assign *m: getbounds && Get a bounding rectangle in the specified units *m: getdecoderclsid && Get the CLSID for the Decoder for a specific image format (eg "image/jpeg") *m: getencoderclsid && Get the CLSID for the Encoder for a specific image format (eg "image/jpeg") *m: getencoderparaminfo && Internal function, get inforrmation about an encoder parameter, given human-facing name *m: getencoderparamsfromarray && Internal function, convert array into EncoderParameters array *m: getencoderparamsfromstring && Internal function, parse string into EncoderParameters array *m: getpropertycount && Gets the number of properties (pieces of metadata) stored in this Image object *m: getpropertyidlist && Gets an array of the property identifiers used in the metadata of this Image object. *m: getpropertyitem && Gets a specified property item (piece of metadata) from this Image object *m: getthumbnailimage && Create a thumbnail at the specified size, return as new GpImage object *m: horizontalresolution_access *m: horizontalresolution_assign *m: imageheight_access *m: imageheight_assign *m: imagewidth_access *m: imagewidth_assign *m: physicaldimension_access *m: physicaldimension_assign *m: pixelformat_access *m: pixelformat_assign *m: rawformat_access *m: rawformat_assign *m: rotateflip && Rotate, flip (or both) this image *m: savetofile && Save image to a disk file, using specified encoder *m: verticalresolution_access *m: verticalresolution_assign *p: flags && Attribute flags for this image *p: horizontalresolution && Horizontal resolution in pixels-per-inch *p: imageheight && Height of this image *p: imagewidth && Width of this image *p: physicaldimension && Get the width and height of this object (returned as a GpSize) *p: pixelformat && Pixel format - see GP_PIXELFORMAT constants *p: rawformat && Get the format of this image (as a GUID) *p: verticalresolution && Vertical resolution in pixels-per-inch * * Name = "gpimage" _memberdata = * PROCEDURE clone lparameters toImage as GpImage this.Destroy() local nHandle nHandle = 0 #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toImage)='O' and m.toImage.gdipHandle<>0) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif Declare Integer GdipCloneImage In GDIPlus.Dll ; integer nImage, integer @nCloneImage This.GdipStatus = GdipCloneImage( ; m.toImage.gdipHandle ; , @nHandle) this.gdipHandle= m.nHandle return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE createfromfile && Create Image object from a file on disk lparameters tcFilename as String, tlUseEmbeddedColorMgmt as Logical #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcFilename)='C' and !empty(m.tcFilename) and vartype(m.tlUseEmbeddedColorMgmt)='L') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif if m.tlUseEmbeddedColorMgmt declare integer GdipLoadImageFromFileICM in gdiplus.dll ; string wFilename, integer @ nImage this.Destroy() local nHandle nHandle = 0 This.gdipStatus = GdipLoadImageFromFileICM( ; strconv(m.tcFilename+chr(0),5) ; , @nHandle) this.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus else declare integer GdipLoadImageFromFile in gdiplus.dll ; string wFilename, integer @ nImage this.Destroy() local nHandle nHandle = 0 This.gdipStatus = GdipLoadImageFromFile( ; strconv(m.tcFilename+chr(0),5) ; , @nHandle) this.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus endif ENDPROC PROCEDURE Destroy if This.GdipHandle!=0 and This.gdipOwnsThisHandle Declare Integer GdipDisposeImage In GDIPlus.Dll ; integer nImage GdipDisposeImage(This.GdipHandle) This.GdipHandle=0 This.gdipOwnsThisHandle = .F. endif ENDPROC PROCEDURE flags_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetImageFlags in gdiplus.dll ; integer nImage, integer @ nValue local nValue nValue = 0 This.gdipStatus = GdipGetImageFlags( This.gdipHandle, @nValue) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nValue,cast(null as I)) ENDPROC PROCEDURE flags_assign lparameters newVal error 1743, "Flags" ENDPROC PROCEDURE getbounds && Get a bounding rectangle in the specified units lparameters tnUnit as integer #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnUnit)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return null endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif declare integer GdipGetImageBounds in gdiplus.dll ; integer nGraphics, string @ pRectF, integer @nUnit local lcRectF lcRectF = replicate(chr(0),16) This.gdipStatus = GdipGetImageBounds( This.gdipHandle, @lcRectF, @tnUnit ) if This.gdipStatus==GDIPLUS_STATUS_OK and len(m.lcRectF)==16 return This.ObjFactory( 'gpimage.getbounds', GDIPLUS_CLASS_RECT,@lcRectF) else return null endif ENDPROC PROCEDURE getdecoderclsid && Get the CLSID for the Decoder for a specific image format (eg "image/jpeg") lparameters tvSearchValue * When passed varbinary, search on Image format GUID * When passed char, search on mime type #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvSearchValue)='C' or (vartype(m.tvSearchValue)='Q' and len(m.tvSearchValue)=16)) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as Q) endif #endif local lnNumDecoders as Integer, lnBufferSize as integer lnNumDecoders = 0 lnBufferSize = 0 * The buffer is self-referencing: it starts with an array of ImageCodecInfo * followed by the text strings, and the array contains pointers to the text strings * To avoid the danger, however slight, of VFP moving this memory around, I allocate * Memory using GlobalAlloc. * declare integer GlobalAlloc in kernel32.dll integer nFlags, integer nSize declare integer GlobalFree in kernel32.dll integer nHandle declare integer lstrlenW in kernel32.dll as __win32_lstrlenW_ptr integer declare integer GdipGetImageDecodersSize in gdiplus.dll ; integer @numDecoders, integer @ nsize declare integer GdipGetImageDecoders in gdiplus.dll ; integer numDecoders, integer nsize, integer nBufferPtr This.gdipStatus = GdipGetImageDecodersSize( @lnNumDecoders, @lnBufferSize ) if GDIPLUS_STATUS_OK != This.gdipStatus return cast(null as Q) endif local lnBufferPtr as Integer, lnStringPtr as integer, liDecoder as integer lnBufferPtr = GlobalAlloc( 0x0040, m.lnBufferSize ) && 0x40=GMEM_FIXED|GMEM_ZEROINIT * Be careful from now on to deallocate this memory * TRY ..CATCH would be smart? This.gdipStatus = GdipGetImageDecoders( m.lnNumDecoders, m.lnBufferSize, m.lnBufferPtr ) if GDIPLUS_STATUS_OK != This.gdipStatus GlobalFree( m.lnBufferPtr ) return cast(null as Q) endif local lcFoundCLSID lcFoundCLSID = null do case case vartype(m.tvSearchValue)='C' && Search on mime type local lcUnicodeMimeType lcUnicodeMimeType = strconv(m.tvSearchValue,5) for liDecoder = 0 to m.lnNumDecoders-1 lnStringPtr = ctobin(sys(2600,m.lnBufferPtr+m.liDecoder*76+48,4),'RS') if m.lcUnicodeMimeType == sys(2600,lnStringPtr,__win32_lstrlenW_ptr(m.lnStringPtr)*2 ) lcFoundCLSID = sys(2600,m.lnBufferPtr+m.liDecoder*76,16) exit endif endfor case vartype(m.tvSearchValue)='Q' && Search on Image format GUID local lcFormatID lcFormatID = cast(m.tvSearchValue as C(16)) for liDecoder = 0 to m.lnNumDecoders-1 if m.tvSearchValue == cast( sys(2600,m.lnBufferPtr+m.liDecoder*76+16,16) as Q(16) ) lcFoundCLSID = sys(2600,m.lnBufferPtr+m.liDecoder*76,16) exit endif endfor otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter * No return here - must still free memory, see below! endcase GlobalFree( m.lnBufferPtr ) return cast( m.lcFoundCLSID as Q(16) ) ENDPROC PROCEDURE getencoderclsid && Get the CLSID for the Encoder for a specific image format (eg "image/jpeg") lparameters tvSearchValue * When passed varbinary, search on Image format GUID * When passed char, search on mime type #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvSearchValue)='C' or (vartype(m.tvSearchValue)='Q' and len(m.tvSearchValue)=16)) error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as Q) endif #endif local lnNumEncoders as Integer, lnBufferSize as integer lnNumEncoders = 0 lnBufferSize = 0 * The buffer is self-referencing: it starts with an array of ImageCodecInfo * followed by the text strings, and the array contains pointers to the text strings * To avoid the danger, however slight, of VFP moving this memory around, I allocate * Memory using GlobalAlloc. * * eg on my system, sizeof(ImageCodecInfo)=76, num encoders=5, but lnBufferSize=1040 * object is 1040 bytes * declare integer GlobalAlloc in kernel32.dll integer nFlags, integer nSize declare integer GlobalFree in kernel32.dll integer nHandle declare integer lstrlenW in kernel32.dll as __win32_lstrlenW_ptr integer declare integer GdipGetImageEncodersSize in gdiplus.dll ; integer @numEncoders, integer @ nsize declare integer GdipGetImageEncoders in gdiplus.dll ; integer numEncoders, integer nsize, integer nBufferPtr This.gdipStatus = GdipGetImageEncodersSize( @lnNumEncoders, @lnBufferSize ) if GDIPLUS_STATUS_OK != This.gdipStatus return cast(null as Q) endif local lnBufferPtr as Integer, lnStringPtr as integer, liEncoder as integer lnBufferPtr = GlobalAlloc( 0x0040, m.lnBufferSize ) && 0x40=GMEM_FIXED|GMEM_ZEROINIT * Be careful from now on to deallocate this memory * TRY ..CATCH would be smart? This.gdipStatus = GdipGetImageEncoders( m.lnNumEncoders, m.lnBufferSize, m.lnBufferPtr ) if GDIPLUS_STATUS_OK != This.gdipStatus GlobalFree( m.lnBufferPtr ) return cast(null as Q) endif local lcFoundCLSID lcFoundCLSID = null do case case vartype(m.tvSearchValue)='C' && Search on mime type local lcUnicodeMimeType lcUnicodeMimeType = strconv(m.tvSearchValue,5) for liEncoder = 0 to m.lnNumEncoders-1 lnStringPtr = ctobin( sys(2600,m.lnBufferPtr+m.liEncoder*76+48,4),'RS') if m.lcUnicodeMimeType == sys(2600,lnStringPtr,__win32_lstrlenW_ptr(m.lnStringPtr)*2 ) lcFoundCLSID = sys(2600,m.lnBufferPtr+m.liEncoder*76,16) exit endif endfor case vartype(m.tvSearchValue)='Q' && Search on Image format GUID local lcFormatID lcFormatID = cast(m.tvSearchValue as C(16)) for liEncoder = 0 to m.lnNumEncoders-1 if m.tvSearchValue == cast( sys(2600,m.lnBufferPtr+m.liEncoder*76+16,16) as Q(16) ) lcFoundCLSID = sys(2600,m.lnBufferPtr+m.liEncoder*76,16) exit endif endfor otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return cast(null as Q) endcase GlobalFree( m.lnBufferPtr ) return cast( m.lcFoundCLSID as Q(16) ) ENDPROC PROTECTED PROCEDURE getencoderparaminfo && Internal function, get inforrmation about an encoder parameter, given human-facing name lparameters tcParamName, rqGUID, rnDataType do case case upper(m.tcParamName) == 'QUALITY' * Supported by: JPEG rqGUID = GDIPLUS_ENCODER_Quality rnDataType = GDIPLUS_ValueDataType_Long case upper(m.tcParamName) == 'TRANSFORMATION' * Supported by: JPEG rqGUID = GDIPLUS_ENCODER_Transformation rnDataType = GDIPLUS_ValueDataType_Long case upper(m.tcParamName) == 'LUMINANCETABLE' * Supported by: JPEG rqGUID = GDIPLUS_ENCODER_LuminanceTable rnDataType = GDIPLUS_ValueDataType_Short && array of ... case upper(m.tcParamName) == 'CHROMINANCETABLE' * Supported by: JPEG rqGUID = GDIPLUS_ENCODER_ChrominanceTable rnDataType = GDIPLUS_ValueDataType_Short && array of ... case upper(m.tcParamName) == 'COMPRESSION' * Supported by: TIFF rqGUID = GDIPLUS_ENCODER_Compression rnDataType = GDIPLUS_ValueDataType_Long case upper(m.tcParamName) == 'COLORDEPTH' * Supported by: TIFF rqGUID = GDIPLUS_ENCODER_ColorDepth rnDataType = GDIPLUS_ValueDataType_Long case upper(m.tcParamName) == 'SAVEFLAG' * Supported by: TIFF rqGUID = GDIPLUS_ENCODER_SaveFlag rnDataType = GDIPLUS_ValueDataType_Long * These are defined by GDI+ but not supported by any of the standard encoders *case upper(m.tcParamName) == 'COMPRESSION' *case upper(m.tcParamName) == 'SCANMETHOD' *case upper(m.tcParamName) == 'VERSION' *case upper(m.tcParamName) == 'RENDERMETHOD' otherwise return .F. endcase return .T. ENDPROC PROTECTED PROCEDURE getencoderparamsfromarray && Internal function, convert array into EncoderParameters array lparameters lqCLSIDEncoder, raEncoderParams * Internal function, convert array into EncoderParameters array * return global memory handle (pointer) external array raEncoderParams #if GDIPLUS_CHECK_PARAMS if !(type( "raEncoderParams[1]")!='U' and alen(raEncoderParams,2) >= 3) error 11 && Function argument endif #endif * Input is a 3-column array, where * array[i,1] = GUID (varbinary) or name (string) of parameter * array[i,2] = data type (se GDIPLUS_ValueDataType_xxx constants) * array[i,3] = value * Need to build an array of EncoderParameter objects * Each item is: * arraycol Offset Size Description * 1 0 16 GUID of the parameter, see GDIPLUS_ENCODER_xxx constants * 2 16 4 Number of values * 3 20 4 Data type - see * - 24 4 Pointer to buffer * 4 n/a value * Build local array of parameters local lnParamCount lnParamCount = alen(raEncoderParams,1) local laParam[m.lnParamCount,4], liParam, lcName, lqParamID,lvValue,lnValue, lnBufferSize, lnBufferPtr lnBufferSize = 4 + 28 * m.lnParamCount && 4=sizeof(ULONG), 28=sizeof(EncoderParameter) for liParam = 1 to m.lnParamCount lqParamID = null && initialise * Check input * Name -> GUID do case case vartype( raEncoderParams[m.liParam,1])=='C' * Look it up lcName = raEncoderParams[m.liParam,1] && to save having two error messages (ouch) if not This.getEncoderParamInfo( m.lcName, @lqParamID ) error _GDIPLUS_BADENCODERPARAMNAME_LOC return 0 endif laParam[m.liParam,1] = m.lqParamID case vartype( raEncoderParams[m.liParam,1])=='Q' and len(raEncoderParams[m.liParam,1])=16 laParam[m.liParam,1] = raEncoderParams[m.liParam,1] otherwise error _GDIPLUS_BADENCODERPARAMNAMETYPE_LOC endcase * Data type and value laParam[m.liParam,2]=1 && default value laParam[m.liParam,3]=raEncoderParams[m.liParam,2] lvValue = raEncoderParams[m.liParam,3] lnValue = icase( vartype(raEncoderParams[m.liParam,3])$'NY',raEncoderParams[m.liParam,3] ; ,vartype(raEncoderParams[m.liParam,3])='C',val(raEncoderParams[m.liParam,3]) ; ,null) local llOK llOK = .F. && only set to .T. if works do case case GDIPLUS_ValueDataType_Byte = laParam[m.liParam,3] if vartype(m.lvValue)$'NC' laParam[m.liParam,4] = chr(m.lnValue) llOK = .T. endif case GDIPLUS_ValueDataType_Short= laParam[m.liParam,3] if vartype(m.lvValue)$'NC' laParam[m.liParam,4] = chr(m.lnValue%256)+chr(m.lnValue/256) llOK = .T. endif case GDIPLUS_ValueDataType_Long = laParam[m.liParam,3] if vartype(m.lvValue)$'NC' laParam[m.liParam,4] = bintoc(m.lnValue,'4RS') llOK = .T. endif case GDIPLUS_ValueDataType_Rational = laParam[m.liParam,3] * must be expressed as a string in the form "num/den" if vartype(m.lvValue)=='C' and '/' $ m.lvValue laParam[m.liParam,4] = ; bintoc(val(strextract(m.lnValue,'','/')),'4RS') ; + bintoc(val(strextract(m.lnValue,'/','')),'4RS') llOK = .T. endif case GDIPLUS_ValueDataType_LongRange = laParam[m.liParam,3] * must be expressed as a string in the form "low-high" if vartype(m.lvValue)=='C' and '-' $ m.lvValue laParam[m.liParam,4] = ; bintoc(val(strextract(m.lnValue,'','-')),'4RS') ; + bintoc(val(strextract(m.lnValue,'-','')),'4RS') llOK = .T. endif case GDIPLUS_ValueDataType_ASCII = laParam[m.liParam,3] if vartype(m.lvValue)=='C' laParam[m.liParam,4] = m.lvValue + chr(0) * laParam[m.liParam,2]= len(laParam[m.liParam,4]) ? llOK = .T. endif case GDIPLUS_ValueDataType_Undefined = laParam[m.liParam,3] if vartype(m.lvValue)$'CQ' laParam[m.liParam,4] = m.lvValue laParam[m.liParam,2]= len(m.lvValue) llOK = .T. endif * Don't support rational range or pointer * otherwise llOK already false endcase if ! m.llOK error _GDIPLUS_BADENCODERPARAMVALUE_LOC return 0 endif lnBufferSize = m.lnBufferSize + len(laParam[m.liParam,4]) endfor * OK, allocate array and go for it. declare integer GlobalAlloc in kernel32.dll integer nFlags, integer nSize lnBufferPtr = GlobalAlloc( 0x0040, m.lnBufferSize ) && 0x40=GMEM_FIXED|GMEM_ZEROINIT if 0==m.lnBufferPtr * Memory allocation error error _GDIPLUS_LOC_MALLOCFAIL return null endif local lnArrayPtr, lnValuePtr lnArrayPtr = m.lnBufferPtr + 4 lnValuePtr = m.lnArrayPtr + 28*m.lnParamCount * parameter count: sys(2600,m.lnBufferPtr ,4, bintoc(m.lnParamCount,'4RS')) for liParam = 1 to m.lnParamCount sys(2600,m.lnArrayPtr,28, ; laParam[m.liParam,1]; + bintoc(laParam[m.liParam,2],'4RS') ; + bintoc(laParam[m.liParam,3],'4RS') ; + bintoc(m.lnValuePtr,'4RS') ; ) sys(2600,m.lnValuePtr,len(laParam[m.liParam,4]),laParam[m.liParam,4]) lnArrayPtr = m.lnArrayPtr + 28 lnValuePtr = m.lnValuePtr + len(laParam[m.liParam,4]) endfor return m.lnBufferPtr ENDPROC PROTECTED PROCEDURE getencoderparamsfromstring && Internal function, parse string into EncoderParameters array lparameters lqCLSIDEncoder, tcEncoderParams * Internal function, parse string into EncoderParameters array * return global memory handle (pointer) * Input is a string of the format "param1=value1, param2=value2, ..." * * This is more limited than the array version in that * - it only understands string parameter names * - it only understands those parameters it knows about * - data type is only the kind this class implements * - cannot include commas in values * but it is easier to use for the more common cases * #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcEncoderParams)=='C') error 11 && Function argument endif #endif * Short circui if empty(m.tcEncoderParams) return 0 && nothing to do endif local lnCount lnCount= occurs(",",m.tcEncoderParams)+1 local laParams[m.lnCount,3], lnPos,lcName, lcValue, lqGUID, lnType, lcScratch,liParam lcScratch = m.tcEncoderParams for liParam = 1 to m.lnCount * Find name lnPos = at('=',m.lcScratch) if m.lnPos = 0 * Invalid error _GDIPLUS_BADENCODERPARAMSTRING_LOC return 0 endif lcName = alltrim(left(m.lcScratch,m.lnPos-1)) lcScratch = substr(m.lcScratch,m.lnPos+1) lnPos = at(',',m.lcScratch) if m.lnPos = 0 lcValue = alltrim(m.lcScratch) lcScratch = '' else lcValue = alltrim(left(m.lcScratch,m.lnPos-1)) lcScratch = substr(m.lcScratch,m.lnPos+1) endif * Now look it up if not This.getEncoderParamInfo( m.lcName, @lqGUID, @lnType ) error _GDIPLUS_BADENCODERPARAMNAME_LOC return 0 endif laParams[m.liParam,1] = m.lqGUID laParams[m.liParam,2] = m.lnType do case case inlist(m.lnType ; ,GDIPLUS_ValueDataType_Byte,GDIPLUS_ValueDataType_Short,GDIPLUS_ValueDataType_Long ) laParams[m.liParam,3] = val(m.lcValue) * rationals? otherwise laParams[m.liParam,3] = m.lcValue endcase endfor return This.getEncoderParamsFromArray( m.lqCLSIDEncoder, @laParams ) ENDPROC PROCEDURE getpropertycount && Gets the number of properties (pieces of metadata) stored in this Image object #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif local lnCount store 0 to lnCount declare integer GdipGetPropertyCount in gdiplus.dll ; integer nImage, integer @nCount This.gdipStatus = GdipGetPropertyCount( This.gdipHandle, @lnCount) return iif(GDIPLUS_STATUS_OK==This.gdipStatus,m.lnCount,cast(null as I)) ENDPROC PROCEDURE getpropertyidlist && Gets an array of the property identifiers used in the metadata of this Image object. lparameters raPropIDList #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif #if GDIPLUS_CHECK_PARAMS if !(type("raPropIDList[1]")!='U') This.gdipStatus = GDIPLUS_STATUS_InvalidParameter error 11 && Function argument return cast(null as I) endif #endif local lnCount, lcIdList, lnIndex lnCount = This.GetPropertyCount() if isnull(m.lnCount) or m.lnCount<1 return m.lnCount endif declare integer GdipGetPropertyIdList in gdiplus.dll ; integer nImage, integer nCount, string @ list lcIdList = replicate( chr(0), 4*m.lnCount ) This.gdipStatus = GdipGetPropertyIdList( This.gdipHandle, lnCount, @lcIdList ) * Now convert to the array dimension raPropIDList[m.lnCount] for lnIndex = 1 to m.lnCount raPropIDList[m.lnIndex] = ctobin(substr(m.lcIdList,m.lnIndex*4-3,4),'RS') endfor return m.lnCount ENDPROC PROCEDURE getpropertyitem && Gets a specified property item (piece of metadata) from this Image object lparameters tnPropID as Integer #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnPropID)='N') This.gdipStatus = GDIPLUS_STATUS_InvalidParameter error 11 && Function argument return cast(null as I) endif #endif declare integer GlobalAlloc in kernel32.dll integer nFlags, integer nSize declare integer GlobalFree in kernel32.dll integer nHandle declare integer lstrlenA in kernel32.dll as __win32_lstrlenA_ptr integer declare integer GdipGetPropertyItemSize in gdiplus.dll ; integer nImage, integer nPropID, integer @ nBufSize declare integer GdipGetPropertyItem in gdiplus.dll ; integer nImage, integer nPropID, integer nBufSize, integer nBufferPtr local lnBufferSize as integer, lnBufferPtr as Integer, lnStringPtr as integer lnBufferSize = 0 This.gdipStatus = GdipGetPropertyItemSize( This.gdipHandle, m.tnPropID, @lnBufferSize ) if GDIPLUS_STATUS_OK != This.gdipStatus return null endif lnBufferPtr = GlobalAlloc( 0x0040, m.lnBufferSize ) && 0x40=GMEM_FIXED|GMEM_ZEROINIT if 0==m.lnBufferPtr * Memory allocation error error _GDIPLUS_MALLOCFAIL_LOC return null endif This.gdipStatus = GdipGetPropertyItem( This.gdipHandle, m.tnPropID, m.lnBufferSize, m.lnBufferPtr ) if GDIPLUS_STATUS_OK != This.gdipStatus GlobalFree( m.lnBufferPtr ) return null endif * Now decode the parameter * PropertyItem * Offset Size Description * 0 4 ID (32 bit int) * 4 4 Length of value * 8 4 Data type - GP_PROPERTYTAGTYPE_xxx * 12 4 Pointer to value * 16 (probably) The value itself local lnPropertyTagType, lnValueLen, lnValuePtr, lvReturn lnPropertyTagType = ctobin(sys(2600,m.lnBufferPtr+8,4),'RS') lnValueLen = ctobin(sys(2600,m.lnBufferPtr+4,4),'RS') lnValuePtr = ctobin(sys(2600,m.lnBufferPtr+12,4),'RS') do case case inlist(m.lnPropertyTagType,0,6,7,8) && nothing or undefined lvReturn = null && warning: this is also error value case 1 == m.lnPropertyTagType && Byte lvReturn = asc( sys(2600,m.lnValuePtr,1)) case 2 == m.lnPropertyTagType && ASCII string (_not_ unicode) * trim null byte off end, but only if there! (It *should* be, but..) lvReturn = strextract(sys(2600,m.lnValuePtr,m.lnValueLen),'',chr(0),1,2) case 3 == m.lnPropertyTagType && Short (16 bit) lvReturn = asc(sys(2600,m.lnValuePtr,1))+256*asc(sys(2600,m.lnValuePtr+1,1)) case 4 == m.lnPropertyTagType && Long (32 bit) lvReturn = ctobin(sys(2600,m.lnValuePtr,4),'RS') case 5 == m.lnPropertyTagType && Rational(two 32 bit) * return as string lvReturn = ltrim(str( ctobin(sys(2600,m.lnValuePtr,4),'RS') )) ; + '/' ; + ltrim(str( ctobin(sys(2600,m.lnValuePtr+4,4),'RS') )) case 9 == m.lnPropertyTagType && signed Long (32 bit) lvReturn = ctobin(sys(2600,m.lnValuePtr,4),'RS') if m.lvReturn>0x7FFFFFFF lvReturn = m.lvReturn - 0x100000000 endif case 10 == m.lnPropertyTagType && signed rational a/b local lnNum, lnDen lnNum = ctobin(sys(2600,m.lnValuePtr,4),'RS') lnDen = ctobin(sys(2600,m.lnValuePtr+4,4),'RS') if m.lnNum >0x7FFFFFFF lnNum = m.lnNum - 0x100000000 endif if m.lnDen >0x7FFFFFFF lnDen = m.lnDen - 0x100000000 endif lvReturn = ltrim(str(m.lnNum)) +'/'+ltrim(str(m.lnDen)) otherwise GlobalFree( m.lnBufferPtr ) error _GDIPLUS_BADPROPERTYTAGTYPE_LOC return null endcase GlobalFree( m.lnBufferPtr ) return m.lvReturn ENDPROC PROCEDURE getthumbnailimage && Create a thumbnail at the specified size, return as new GpImage object lparameters tnWidth as Integer, tnHeight as Integer #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnWidth)='N' and vartype(m.tnHeight)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipGetImageThumbnail in gdiplus.dll ; integer nSrcImage, integer nWidth, integer nHeight, integer @nNewImage,integer,integer local lnNewImage lnNewImage = 0 This.gdipStatus = GdipGetImageThumbnail( ; This.gdipHandle ; , m.tnWidth, m.tnHeight, @lnNewImage, 0, 0 ) if GDIPLUS_STATUS_OK == This.gdipStatus return This.ObjFactory('gpimage.getthumbnailimage', GDIPLUS_CLASS_IMAGE,m.lnNewImage) else return null endif ENDPROC PROCEDURE horizontalresolution_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare Integer GdipGetImageHorizontalResolution in gdiplus.dll ; integer nImage, single @ nValue local nValue nValue = 0.0 This.gdipStatus = GdipGetImageHorizontalResolution( This.gdipHandle, @nValue) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nValue,cast(null as B)) ENDPROC PROCEDURE horizontalresolution_assign lparameters newVal error 1743, "HorizontalResolution" ENDPROC PROCEDURE imageheight_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetImageHeight in gdiplus.dll ; integer nImage, integer @ nValue local nValue nValue = 0 This.gdipStatus = GdipGetImageHeight( This.gdipHandle, @nValue) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nValue,cast(null as I)) ENDPROC PROCEDURE imageheight_assign lparameters newVal error 1743, "ImageHeight" ENDPROC PROCEDURE imagewidth_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetImageWidth in gdiplus.dll ; integer nPen, integer @ nValue local nValue nValue = 0 This.gdipStatus = GdipGetImageWidth( This.gdipHandle, @nValue) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nValue,cast(null as I)) ENDPROC PROCEDURE imagewidth_assign lparameters newVal error 1743, "ImageWidth" ENDPROC PROCEDURE Init lparameters tvParam1, tvParam2 if not dodefault() return .F. endif do case case vartype(m.tvParam1) = 'N' * Handle #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvParam2)='L') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif This.SetHandle(m.tvParam1,m.tvParam2) case vartype(m.tvParam1) = 'C' * Filename, no second param #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvParam2)='L') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif return This.CreateFromFile( m.tvParam1, m.tvParam2 ) case vartype(m.tvParam1)='L' * Do nothing otherwise error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endcase return .T. ENDPROC PROCEDURE physicaldimension_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return null endif #endif declare integer GdipGetImageDimension in gdiplus.dll ; integer nGraphics, single @, single @ local lnWidth, lnHeight store 0.0 to lnWidth, lnHeight This.gdipStatus = GdipGetImageDimension ( This.gdipHandle, @lnWidth, @lnHeight ) if This.gdipStatus==GDIPLUS_STATUS_OK return This.ObjFactory('gpimage.physicaldimension_access',GDIPLUS_CLASS_SIZE, m.lnWidth, m.lnHeight) else return null endif ENDPROC PROCEDURE physicaldimension_assign lparameters newVal error 1743, "PhysicalDimension" ENDPROC PROCEDURE pixelformat_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetImagePixelFormat in gdiplus.dll ; integer nPen, integer @ nValue local nValue nValue = 0 This.gdipStatus = GdipGetImagePixelFormat( This.gdipHandle, @nValue) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nValue,cast(null as I)) ENDPROC PROCEDURE pixelformat_assign lparameters newVal error 1743, "PixelFormat" ENDPROC PROCEDURE rawformat_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as Q(16)) endif #endif declare Integer GdipGetImageRawFormat in gdiplus.dll ; integer nImage, string @ sGUID local sGUID sGUID = replicate(chr(0),16) This.gdipStatus = GdipGetImageRawFormat( This.gdipHandle, @sGUID) return cast(iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.sGUID,null) as Q(16)) ENDPROC PROCEDURE rawformat_assign lparameters newVal error 1743, "RawFormat" ENDPROC PROCEDURE rotateflip && Rotate, flip (or both) this image lparameters tnRotateFlipType #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnRotateFlipType)='N') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare integer GdipImageRotateFlip in gdiplus.dll ; integer nImage, integer nMode This.gdipStatus = GdipImageRotateFlip( This.gdipHandle, m.tnRotateFlipType ) return (GDIPLUS_STATUS_OK == This.gdipStatus) ENDPROC PROCEDURE savetofile && Save image to a disk file, using specified encoder lparameters tcFilename as String, tvCLSIDEncoder, rvEncoderParams #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcFilename)='C' and !empty(m.tcFilename)) error 11 && Function argument endif #endif local lqCLSIDEncoder * Encoder may be varbinary, or string do case case vartype(m.tvCLSIDEncoder)=='Q' lqCLSIDEncoder = m.tvCLSIDEncoder case vartype(m.tvCLSIDEncoder)=='C' if left(m.tvCLSIDEncoder,1)=='{' lqCLSIDEncoder = This.StringToGUID( m.tvCLSIDEncoder) else lqCLSIDEncoder = This.GetEncoderCLSID(m.tvCLSIDEncoder) endif otherwise error 11 endcase declare integer GdipSaveImageToFile in gdiplus.dll ; integer nImage, string wFilename, string qEncoder, integer nEncoderParamsPtr declare integer GlobalFree in kernel32.dll integer nHandle local lnEncoderParamsPtr do case case type("rvEncoderParams[1]")!='U' lnEncoderParamsPtr = This.getEncoderParamsFromArray( m.lqCLSIDEncoder, @rvEncoderParams ) case vartype(m.rvEncoderParams)=='C' lnEncoderParamsPtr = This.getEncoderParamsFromString( m.lqCLSIDEncoder, @rvEncoderParams ) case vartype(m.rvEncoderParams)=='L' and !m.rvEncoderParams lnEncoderParamsPtr = 0 otherwise error 11 && function argument return .F. endcase This.gdipStatus = GdipSaveImageToFile ( ; This.gdipHandle ; , strconv(m.tcFilename,5)+chr(0) ; , m.lqCLSIDEncoder ; , m.lnEncoderParamsPtr ) if m.lnEncoderParamsPtr!=0 GlobalFree(m.lnEncoderParamsPtr) endif return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE verticalresolution_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare Integer GdipGetImageVerticalResolution in gdiplus.dll ; integer nImage, single @ nValue local nValue nValue = 0.0 This.gdipStatus = GdipGetImageVerticalResolution( This.gdipHandle, @nValue) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nValue,cast(null as B)) ENDPROC PROCEDURE verticalresolution_assign lparameters newVal error 1743, "VerticalResolution" ENDPROC ENDDEFINE DEFINE CLASS gpobject AS gpbase OF "_gdiplus.vcx" && The abstract base class for all GDI+ objects. Provides management of GDI+ handles and the outcome of GDI+ operations. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: gdipstatus_assign *m: gethandle && Return the underlying GDI+ handle for this object *m: getstatus && Return the status code from the last GDI+ function called on this object *m: sethandle && Set the native GDI+ handle if this has been obtained from an outside source *p: gdiphandle && Underlying GDI+ handle for this object *p: gdipownsthishandle && True if this VFP object owns the corresponding GDI+ object (and thus should dispose of it in its Destroy Event) *p: gdipstatus && Status code returned from last GDI+ function called (see Status enumeration) *p: win32lasterror && Win32 error code if GetStatus() returns GP_STATUS_Win32Error * PROTECTED gdiphandle,gdipownsthishandle,gdipstatus * gdiphandle = 0 gdipstatus = 0 Name = "gpobject" win32lasterror = 0 _memberdata = * PROCEDURE gdipstatus_assign LPARAMETERS vNewVal THIS.gdipStatus = m.vNewVal do case case m.vNewVal == GDIPLUS_STATUS_Win32Error This.win32LastError = _win32_GetLastError() #if GDIPLUS_CHECK_GDIPLUSNOTINIT case m.vNewVal == GDIPLUS_STATUS_GdiplusNotInitialized error _GDIPLUS_GDIPLUSNOTINIT_LOC #endif endcase ENDPROC PROCEDURE gethandle && Return the underlying GDI+ handle for this object return This.gdipHandle ENDPROC PROCEDURE getstatus && Return the status code from the last GDI+ function called on this object return This.gdipStatus ENDPROC PROCEDURE Init declare integer GetLastError in kernel32.dll as _win32_GetLastError return dodefault() ENDPROC PROCEDURE sethandle && Set the native GDI+ handle if this has been obtained from an outside source lparameters tvNewHandle, tlOwnsHandle #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvNewHandle)='N' and vartype(m.tlOwnsHandle)='L') error 11 && function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif * Assume if we came through this function that we do NOT own the graphics handle * Thus destroy must not call GdipDelete..() on this handle * This can be overridden by passing tlOwnsHandle=.T. This.gdipHandle = m.tvNewHandle This.gdipOwnsThisHandle = m.tlOwnsHandle ENDPROC ENDDEFINE DEFINE CLASS gppen AS gpobject OF "_gdiplus.vcx" && A pen object, which is used to draw lines and curves. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: alignment_access *m: alignment_assign *m: create && Create pen in a given color *m: createfrombrush && Create pen from an existing _gdiplus brush object *m: dashcap_access *m: dashcap_assign *m: dashoffset_access *m: dashoffset_assign *m: dashstyle_access *m: dashstyle_assign *m: endcap_access *m: endcap_assign *m: linejoin_access *m: linejoin_assign *m: miterlimit_access *m: miterlimit_assign *m: pencolor_access *m: pencolor_assign *m: pentype_access *m: pentype_assign *m: penunit_access *m: penunit_assign *m: penwidth_access *m: penwidth_assign *m: startcap_access *m: startcap_assign *p: alignment && The alignment of this pen (see GP_PENALIGNMENT_ constants) *p: dashcap && The cap style at the end of dashes, for dashed lines *p: dashoffset && The distance from the start of a line to the beginning of a dash pattern *p: dashstyle && The style used for dashed lines *p: endcap && Cap style at the end of lines drawn with this Pen *p: linejoin && Join style for the ends of two consecutive lines drawn with this Pen *p: miterlimit && The limit of the thickness of the join on a mitered corner *p: pencolor && The color of this Pen object. *p: pentype && The style of lines drawn with this Pen object *p: penunit && The unit for measuring width etc, see GDIPLUS_UNIT constants *p: penwidth && Width of the pen object *p: startcap && Cap style at the start of lines drawn with this Pen * * Name = "gppen" _memberdata = * PROCEDURE alignment_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenMode in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenMode( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE alignment_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenMode in gdiplus.dll ; integer nPen, integer nValue This.gdipStatus = GdipSetPenMode( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE clone lparameters toPen as GpPen this.Destroy() local nHandle nHandle = 0 #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toPen)='O' and m.toPen.gdipHandle<>0) error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif Declare Integer GdipClonePen In GDIPlus.Dll ; integer nPen, integer @nClonePen This.GdipStatus = GdipClonePen( ; m.toPen.gdipHandle ; , @nHandle) this.gdipHandle= m.nHandle return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE create && Create pen in a given color lparameters tvColor, tnWidth as Number, tnUnit as Number * tvColor may be ARGB or a Color object this.Destroy() local nHandle nHandle = 0 Declare Integer GdipCreatePen1 In GDIPlus.Dll ; integer nColor, single fWidth,Integer nUnit, Integer @nPen This.GdipStatus = GdipCreatePen1( ; icase(vartype(m.tvColor)='O',m.tvColor.ARGB,vartype(m.tvColor)='N',m.tvColor,0xFF000000) ; , iif(vartype(m.tnWidth)='N',m.tnWidth,1.0) ; , iif(vartype(m.tnUnit)='N',m.tnUnit,0) ; , @nHandle) This.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE createfrombrush && Create pen from an existing _gdiplus brush object lparameters toBrush as Brush, tnWidth as Number, tnUnit as Number #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toBrush)='O' and m.toPen.gdipHandle<>0) error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif this.Destroy() local nHandle nHandle = 0 Declare Integer GdipCreatePen2 In GDIPlus.Dll ; integer nBrush, single fWidth,Integer nUnit, Integer @nPen This.GdipStatus = GdipCreatePen2( ; m.toBrush.GetHandle() ; , iif(vartype(m.tnWidth)='N',m.tnWidth,1.0) ; , iif(vartype(m.tnUnit)='N',m.tnUnit,0) ; , @nHandle) This.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE dashcap_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenDashCap197819 in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenDashCap197819( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE dashcap_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenDashCap197819 in gdiplus.dll ; integer nPen, integer nValue This.gdipStatus = GdipSetPenDashCap197819( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE dashoffset_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare Integer GdipGetPenDashOffset in gdiplus.dll ; integer nPen, single @ nType local nOffset nOffset = 0.0 This.gdipStatus = GdipGetPenDashOffset( This.gdipHandle, @nOffset) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nOffset,cast(null as B)) ENDPROC PROCEDURE dashoffset_assign LPARAMETERS tnNewValue #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnNewValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare Integer GdipSetPenDashOffset in gdiplus.dll ; integer nPen, single nValue This.gdipStatus = GdipSetPenDashOffset( This.gdipHandle,m.tnNewValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE dashstyle_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenDashStyle in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenDashStyle( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE dashstyle_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenDashStyle in gdiplus.dll ; integer nPen, integer nValue This.gdipStatus = GdipSetPenDashStyle( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE Destroy if This.GdipHandle!=0 and This.gdipOwnsThisHandle Declare Integer GdipDeletePen In GDIPlus.Dll ; integer nPen GdipDeletePen(This.GdipHandle) This.GdipHandle=0 This.gdipOwnsThisHandle=.F. endif ENDPROC PROCEDURE endcap_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenEndCap in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenEndCap( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE endcap_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenEndCap in gdiplus.dll ; integer nPen, integer nValue This.gdipStatus = GdipSetPenEndCap( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE Init lparameters tvColor, tnWidth as Number, tnUnit as Number if not dodefault() return .F. endif if pcount()>0 return This.Create(m.tvColor,m.tnWidth,m.tnUnit) endif ENDPROC PROCEDURE linejoin_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenLineJoin in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenLineJoin( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE linejoin_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenLineJoin in gdiplus.dll ; integer nPen, integer nValue This.gdipStatus = GdipSetPenLineJoin( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE miterlimit_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare Integer GdipGetPenMiterLimit in gdiplus.dll ; integer nPen, single @ nLimit local nLimit nLimit = 0.0 This.gdipStatus = GdipGetPenMiterLimit( This.gdipHandle, @nLimit) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nLimit,cast(null as B)) ENDPROC PROCEDURE miterlimit_assign LPARAMETERS tnNewValue #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnNewValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare Integer GdipSetPenMiterLimit in gdiplus.dll ; integer nPen, single nValue This.gdipStatus = GdipSetPenMiterLimit( This.gdipHandle,m.tnNewValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE pencolor_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenColor in gdiplus.dll ; integer nPen, integer @ nARGB local nARGB nARGB = 0 This.gdipStatus = GdipGetPenColor( This.gdipHandle, @nARGB ) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nARGB,cast(null as I)) ENDPROC PROCEDURE pencolor_assign LPARAMETERS tvColor #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvColor)$'ON') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenColor in gdiplus.dll ; integer nPen, integer nColor This.gdipStatus = GdipSetPenColor( This.gdipHandle,iif(vartype(m.tvColor)='O',m.tvColor.ARGB,m.tvColor)) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE pentype_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenFillType in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenFillType( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE pentype_assign LPARAMETERS vNewVal error 1743, 'PenType' ENDPROC PROCEDURE penunit_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenUnit in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenUnit( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE penunit_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenUnit in gdiplus.dll ; integer nPen, integer nValue This.gdipStatus = GdipSetPenUnit( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE penwidth_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as B) endif #endif declare Integer GdipGetPenWidth in gdiplus.dll ; integer nPen, single @ fWidth local nWidth nWidth = 0.0 This.gdipStatus = GdipGetPenWidth( This.gdipHandle, @nWidth ) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nWidth,cast(null as B)) ENDPROC PROCEDURE penwidth_assign LPARAMETERS tnNewWidth #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnNewWidth)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare Integer GdipSetPenWidth in gdiplus.dll ; integer nPen, single fWidth This.gdipStatus = GdipSetPenWidth( This.gdipHandle,m.tnNewWidth) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE startcap_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare Integer GdipGetPenStartCap in gdiplus.dll ; integer nPen, integer @ nType local nType nType = 0 This.gdipStatus = GdipGetPenStartCap( This.gdipHandle, @nType) * if !(GDIPLUS_STATUS_OK==This.gdipStatus) then error? return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nType,cast(null as I)) ENDPROC PROCEDURE startcap_assign LPARAMETERS tnValue #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnValue)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetPenStartCap in gdiplus.dll ; integer nPen, integer nValue This.gdipStatus = GdipSetPenStartCap( This.gdipHandle,m.tnValue) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC ENDDEFINE DEFINE CLASS gppoint AS gpbase OF "_gdiplus.vcx" && Encapsulates an ordered pair of x- and y-coordinates that defines a point in a two-dimensional plane. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: create && Set point from individual x,y coordinates *m: gdippointf_access *m: gdippointf_assign *m: gdippoint_access *m: gdippoint_assign *m: set && Set point from individual x,y coordinates *p: gdippoint && String representing the GDI+ Point structure (2 x 32bit integers) *p: gdippointf && String representing the GDI+ PointF structure (2 x 32bit single-precision floats) *p: x && x-coordinate of point *p: y && y-coordinate of point * * Name = "gppoint" x = 0 y = 0 _memberdata = * PROCEDURE clone lparameters toOtherPoint as GpPoint #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toOtherPoint)='O' ; and vartype(toOtherPoint.X)='N' and vartype(toOtherPoint.Y)='N') error 11 && Function argument return .F. endif #endif This.X = m.toOtherPoint.X This.Y = m.toOtherPoint.Y ENDPROC PROCEDURE create && Set point from individual x,y coordinates lparameters tx,ty #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tx)='N' and vartype(m.ty)='N') error 11 && Function argument return .F. endif #endif This.X = m.tx This.Y = m.ty ENDPROC PROTECTED PROCEDURE gdippointf_access return ; bintoc(This.X,'F') + bintoc(This.Y,'F') ENDPROC PROTECTED PROCEDURE gdippointf_assign LPARAMETERS tcPointF #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcPointF)='C' and len(m.tcPointF)=8) error 11 && Function argument return .F. endif #endif This.X = ctobin(substr(m.tcPointF,1,4),'N') This.Y = ctobin(substr(m.tcPointF,5,4),'N') ENDPROC PROTECTED PROCEDURE gdippoint_access * Convert object into 2 x 32-bit integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.X,'4RS') + bintoc(This.Y,'4RS') ENDPROC PROTECTED PROCEDURE gdippoint_assign LPARAMETERS tcPoint #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcPoint)='C' and len(m.tcPoint)=8) error 11 && Function argument return .F. endif #endif This.X = ctobin(substr(m.tcPoint,1,4),'RS') This.Y = ctobin(substr(m.tcPoint,5,4),'RS') ENDPROC PROCEDURE Init lparameters tXorPoint,ty if not dodefault() return .F. endif do case case pcount()=1 and vartype(m.tXorPoint)='O' * Passed an object - presumably an existing Point object This.Clone(m.tXorPoint) case pcount()=1 and vartype(m.tXorPoint)='C' * Passed a string (structure) * Assume PointF as this is preferred format This.gdipPointF = m.tXorPoint case pcount()>=2 * Separate components This.Create(m.tXorPoint,m.ty) endcase ENDPROC PROCEDURE set && Set point from individual x,y coordinates lparameters tx as Number,ty as Number #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tx)='N' and vartype(m.ty)='N') error 11 && Function argument return .F. endif #endif This.X = m.tx This.Y = m.ty ENDPROC ENDDEFINE DEFINE CLASS gprectangle AS gpbase OF "_gdiplus.vcx" && Encapsulates a set of four numbers that represent the location and size of a rectangle. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: create && Set rectangle from individual coordinates *m: createfrompointsize && Set rectangle from separate point and size objects *m: gdippointf_access *m: gdippointf_assign *m: gdippoint_access *m: gdippoint_assign *m: gdiprectf_access *m: gdiprectf_assign *m: gdiprect_access *m: gdiprect_assign *m: gdipsizef_access *m: gdipsizef_assign *m: gdipsize_access *m: gdipsize_assign *m: gdirect_access *m: gdirect_assign *m: gppoint_access *m: gppoint_assign *m: gpsize_access *m: gpsize_assign *m: set && Set rectangle coordinates from individual components *m: x2_access *m: x2_assign *m: y2_access *m: y2_assign *p: gdippoint && GDI+ Point (integers) structure for the x,y position of this rectange *p: gdippointf && GDI+ PointF structure for the x,y position of this rectange *p: gdiprect && String representing the GDI+ Rect structure (4 x 32bit integers) *p: gdiprectf && String representing the GDI+ RectF structure (4 x 32bit single-precision floats) *p: gdipsize && GDI+ Size (integers) structure for the width and height of this rectange *p: gdipsizef && GDI+ SizeF structure for the width and height of this rectange *p: gdirect && String containing Win32/GDI "RECT" structure (integers, x1,y1,x2,y2) *p: gppoint && Origin of the rectange (x,y) as a GpPoint object *p: gpsize && Width and Height of the rectangle as a GpSize object *p: h && Height of rectangle *p: w && Width of rectangle *p: x && x-coordinate of upper-left corner of rectangle *p: x2 && X-Coordinate of bottom right corner of rectangle *p: y && y-coordinate of upper-left corner of rectangle *p: y2 && Y-Coordinate of bottom right corner of rectangle * * h = 0 Name = "gprectangle" w = 0 x = 0 y = 0 _memberdata = * PROCEDURE clone lparameters toOtherRect do case case vartype(m.toOtherRect)='O' #if GDIPLUS_CHECK_PARAMS if !(vartype(toOtherRect.X)='N' and vartype(toOtherRect.Y)='N' ; and vartype(toOtherRect.W)='N' and vartype(toOtherRect.H)='N') error 11 && Function argument return .F. endif #endif This.X = m.toOtherRect.X This.Y = m.toOtherRect.Y This.W = m.toOtherRect.W This.H = m.toOtherRect.H case vartype(m.toOtherRect)='C' #if GDIPLUS_CHECK_PARAMS if !(len(m.toOtherRect)=16) error 11 && Function argument return .F. endif #endif * Assume RectF This.gdipRectF = m.toOtherRect otherwise error 11 return .F. endcase ENDPROC PROCEDURE create && Set rectangle from individual coordinates lparameters tx,ty,tw,th #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tx)='N' and vartype(m.ty)='N' ; and vartype(m.tw)$'LN' and vartype(m.th)$'LN') error 11 && Function argument return .F. endif #endif This.X = m.tx This.Y = m.ty This.W = evl(m.tw,0) This.H = evl(m.th,0) ENDPROC PROCEDURE createfrompointsize && Set rectangle from separate point and size objects lparameters toPoint as GpPoint, toSize as GpSize do case case empty(m.toPoint) * point not passed, (0,0) origin This.X = 0 This.Y = 0 case vartype(m.toPoint)='O' This.GpPoint = m.toPoint case vartype(m.toPoint)='C' * Assume PointF This.gdipPointF = m.toPoint otherwise error 11 return .F. endcase do case case empty(m.toSize) * size not passed, (0,0) size This.W = 0 This.H = 0 case vartype(m.toSize)='O' This.GpSize = m.toSize case vartype(m.toSize)='C' * Assume SizeF This.gdipSizeF = m.toSize otherwise error 11 return .F. endcase ENDPROC PROCEDURE gdippointf_access * Convert object into 2 x 4-byte integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.X,'F')+bintoc(This.Y,'F') ENDPROC PROCEDURE gdippointf_assign LPARAMETERS tcPointF #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcPointF)='C' and len(m.tcPointF)=8) error 11 && Function argument return .F. endif #endif * Unpack structure This.X = ctobin(substr(m.tcRectF,1,4),'N') This.Y = ctobin(substr(m.tcRectF,5,4),'N') ENDPROC PROCEDURE gdippoint_access * Return size as 2 x 32-bit integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.X,'4RS')+bintoc(This.Y,'4RS') ENDPROC PROCEDURE gdippoint_assign LPARAMETERS tcPoint as String #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcPoint)='C' and len(m.tcPoint)=8) error 11 && Function argument return .F. endif #endif This.X = ctobin(substr(m.tcPoint,1,4),'RS') This.Y = ctobin(substr(m.tcPoint,5,4),'RS') ENDPROC PROTECTED PROCEDURE gdiprectf_access return ; bintoc(This.X,'F') + bintoc(This.Y,'F') ; + bintoc(This.W,'F') + bintoc(This.H,'F') ENDPROC PROTECTED PROCEDURE gdiprectf_assign LPARAMETERS tcRectF #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcRectF)='C' and len(m.tcRectF)=16) error 11 && Function argument return .F. endif #endif * Unpack structure This.X = ctobin(substr(m.tcRectF,1,4),'N') This.Y = ctobin(substr(m.tcRectF,5,4),'N') This.W = ctobin(substr(m.tcRectF,9,4),'N') This.H = ctobin(substr(m.tcRectF,13,4),'N') ENDPROC PROTECTED PROCEDURE gdiprect_access * Convert object into 4 x 4-byte integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.X,'4RS')+bintoc(This.Y,'4RS')+bintoc(This.W,'4RS')+bintoc(This.H,'4RS') ENDPROC PROTECTED PROCEDURE gdiprect_assign LPARAMETERS tcRect #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcRect)='C' and len(m.tcRect)=16) error 11 && Function argument return .F. endif #endif This.X = ctobin(substr(m.tcRect,1,4),'RS') This.Y = ctobin(substr(m.tcRect,5,4),'RS') This.W = ctobin(substr(m.tcRect,9,4),'RS') This.H = ctobin(substr(m.tcRect,13,4),'RS') ENDPROC PROCEDURE gdipsizef_access * Convert object into 2 x 4-byte integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.W,'F')+bintoc(This.H,'F') ENDPROC PROCEDURE gdipsizef_assign LPARAMETERS tcSizeF #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcSizeF)='C' and len(m.tcSizeF)=8) error 11 && Function argument return .F. endif #endif * Unpack structure This.W = ctobin(substr(m.tcSizeF,1,4),'N') This.H = ctobin(substr(m.tcSizeF,5,4),'N') ENDPROC PROCEDURE gdipsize_access * Return size as 2 x 32-bit integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.W,'4RS')+bintoc(This.H,'4RS') ENDPROC PROCEDURE gdipsize_assign LPARAMETERS tcSize as String #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcSize)='C' and len(m.tcSize)=8) error 11 && Function argument return .F. endif #endif This.W = ctobin(substr(m.tcSize,1,4),'RS') This.H = ctobin(substr(m.tcSize,5,4),'RS') ENDPROC PROCEDURE gdirect_access * Convert object into 4 x 4-byte integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.X,'4RS')+bintoc(This.Y,'4RS') ; + bintoc(This.X2,'4RS')+bintoc(This.Y2,'4RS') ENDPROC PROCEDURE gdirect_assign LPARAMETERS tcRect as string #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcRect)='C' and len(m.tcRect)=16) error 11 && Function argument return .F. endif #endif This.X = ctobin(substr(m.tcRect,1,4),'RS') This.Y = ctobin(substr(m.tcRect,5,4),'RS') This.X2 = ctobin(substr(m.tcRect,9,4),'RS') This.Y2 = ctobin(substr(m.tcRect,13,4),'RS') ENDPROC PROCEDURE gppoint_access RETURN This.ObjFactory( 'gprectange.gppoint_access', GDIPLUS_CLASS_POINT,This.X,This.Y) ENDPROC PROCEDURE gppoint_assign LPARAMETERS toPoint #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toPoint)='O' and pemstatus(m.toPoint,'X',5)) error 11 && Function argument return .F. endif #endif This.X = m.toPoint.X This.Y = m.toPoint.Y ENDPROC PROCEDURE gpsize_access RETURN This.ObjFactory( 'gprectange.gpsize_access', GDIPLUS_CLASS_SIZE,This.W,This.H) ENDPROC PROCEDURE gpsize_assign LPARAMETERS toSize #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toSize)='O' and pemstatus(m.toSize,'W',5)) error 11 && Function argument return .F. endif #endif This.W = m.toSize.W This.H = m.toSize.H ENDPROC PROCEDURE Init lparameters tXorRectorPoint,tYorSize,tw,th if not dodefault() return .F. endif do case case pcount()=0 * empty constructor - rectangle will be empty case pcount()=1 and vartype(m.tXorRectorPoint)='O' * Passed an object - presumably an existing Rect object This.Clone(m.tXorRectorPoint) case pcount()=1 and vartype(m.tXorRectorPoint)='C' * Passed a string (structure) * Rect or RectF? Assume RectF as this is preferred format This.gdipRectF = m.tXorRectorPoint case pcount()=2 and vartype(m.tXorRectorPoint)$'OC' and vartype(m.tYorSize)$'OC' * Passed separate point and size objects? This.CreateFromPointSize(m.tXorRectorPoint, m.tYorSize) case pcount()>=4 ; and vartype(m.tXorRectorPoint)='N' and vartype(m.tYorSize)='N' ; and vartype(m.tw)='N' and vartype(m.th)='N' * Separate components This.Create(m.tXorRectorPoint,m.tYorSize,m.tw,m.th) otherwise error 11 return .F. endcase ENDPROC PROCEDURE set && Set rectangle coordinates from individual components lparameters tx as Number,ty as Number,tw as Number,th as Number #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tx)='N' and vartype(m.ty)='N' ; and vartype(m.tw)$'LN' and vartype(m.th)$'LN') error 11 && Function argument return .F. endif #endif This.X = m.tx This.Y = m.ty This.W = evl(m.tw,0) This.H = evl(m.th,0) ENDPROC PROCEDURE x2_access RETURN THIS.x+This.w ENDPROC PROCEDURE x2_assign LPARAMETERS vNewVal This.w = m.vNewVal - This.x ENDPROC PROCEDURE y2_access RETURN THIS.y+This.h ENDPROC PROCEDURE y2_assign LPARAMETERS vNewVal This.h = m.vNewVal - This.y ENDPROC ENDDEFINE DEFINE CLASS gpsize AS gpbase OF "_gdiplus.vcx" && Stores an ordered pair of numbers, typically the width and height of a rectangle. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: create && Set point from individual coordinates *m: gdipsizef_access *m: gdipsizef_assign *m: gdipsize_access *m: gdipsize_assign *m: set && Set point coordinates from individual x,y values *p: gdipsize && String representing the GDI+ Size structure (2 x 32bit integers) *p: gdipsizef && String representing the GDI+ SizeF structure (2 x 32bit single-precision floats) *p: h && height value *p: w && width value * * h = 0 Name = "gpsize" w = 0 _memberdata = * PROCEDURE clone lparameters toOtherSize #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toOtherSize)='O' ; and vartype(toOtherSize.W)='N' and vartype(toOtherSize.H)='N') error 11 && Function argument return .F. endif #endif This.W = m.toOtherSize.W This.H = m.toOtherSize.H ENDPROC PROCEDURE create && Set point from individual coordinates lparameters tw,th #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tw)='N' and vartype(m.th)='N') error 11 && Function argument return .F. endif #endif This.W = m.tw This.H = m.th ENDPROC PROTECTED PROCEDURE gdipsizef_access return ; bintoc(This.W,'F') + bintoc(This.H,'F') ENDPROC PROTECTED PROCEDURE gdipsizef_assign LPARAMETERS tcSizeF as String #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcSizeF)='C' and len(m.tcSizeF)=8) error 11 && Function argument return .F. endif #endif This.W = ctobin(substr(m.tcSizeF,1,4),'N') This.H = ctobin(substr(m.tcSizeF,5,4),'N') ENDPROC PROTECTED PROCEDURE gdipsize_access * Convert object into 2 x 32-bit integers * Modify bintoc() output into little-endian with normal sign bit return ; bintoc(This.W,'4RS')+bintoc(This.H,'4RS') ENDPROC PROTECTED PROCEDURE gdipsize_assign LPARAMETERS tcSize as String #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tcSize)='C' and len(m.tcSize)=8) error 11 && Function argument return .F. endif #endif This.W = ctobin(substr(m.tcSize,1,4),'RS') This.H = ctobin(substr(m.tcSize,5,4),'RS') ENDPROC PROCEDURE Init lparameters tWorSize,th if not dodefault() return .F. endif do case case pcount()=1 and vartype(m.tWorSize)='O' * Passed an object - presumably an existing Size object This.Clone(m.tWorSize) case pcount()=1 and vartype(m.tWorSize)='C' * Passed a string (structure) * Assume SizeF as this is preferred format This.gdipSizeF = m.tWorSize case pcount()>=2 * Separate components This.Create(m.tWorSize,m.th) endcase ENDPROC PROCEDURE set && Set point coordinates from individual x,y values lparameters tw,th #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tw)='N' and vartype(m.th)='N') error 11 && Function argument return .F. endif #endif This.W = m.tw This.H = m.th ENDPROC ENDDEFINE DEFINE CLASS gpsolidbrush AS gpbrush OF "_gdiplus.vcx" && A brush object which fills with a a solid color. *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: brushcolor_access *m: brushcolor_assign *m: create && Create solid brush in given color *p: brushcolor && Get or set color of a SolidBrush object * * Name = "gpsolidbrush" _memberdata = * PROCEDURE brushcolor_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetSolidFillColor in gdiplus.dll ; integer, integer @ local nARGB nARGB = 0 This.gdipStatus = GdipGetSolidFillColor( This.gdipHandle, @nARGB ) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nARGB,cast(null as I)) ENDPROC PROCEDURE brushcolor_assign LPARAMETERS tvColor #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvColor)$'ON') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif declare Integer GdipSetSolidFillColor in gdiplus.dll ; integer nPen, integer nColor This.gdipStatus = GdipSetSolidFillColor( This.gdipHandle,iif(vartype(m.tvColor)='O',m.tvColor.ARGB,m.tvColor)) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE create && Create solid brush in given color lparameters tvColor * tvColor may be ARGB or a Color object #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tvColor)$'ONL') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif this.Destroy() local nHandle nHandle = 0 Declare Integer GdipCreateSolidFill In GDIPlus.Dll ; integer nColor, Integer @nBrush This.gdipStatus = GdipCreateSolidFill( ; icase(vartype(m.tvColor)='O',m.tvColor.ARGB,vartype(m.tvColor)='N',m.tvColor,0xFF000000) ; , @nHandle) This.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE Init lparameters tvColor if not dodefault() return .F. endif if pcount()>0 return This.Create(m.tvColor) endif ENDPROC ENDDEFINE DEFINE CLASS gpstringformat AS gpobject OF "_gdiplus.vcx" && Object which encapsulates text layout information (such as alignment and line spacing) and display manipulations (such as ellipsis insertion and national digit substitution). *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> #INCLUDE "gdiplus.h" * *m: alignment_access *m: alignment_assign *m: create && Create StringFormat with optional flags and language *m: formatflags_access *m: formatflags_assign *m: getgenericdefault && Get generic default string format (.NET: SystemDrawing.StringFormat.GenericDefault) *m: getgenerictypographic && Get generic typographic StringFormat *m: hotkeyprefix_access *m: hotkeyprefix_assign *m: linealignment_access *m: linealignment_assign *m: trimming_access *m: trimming_assign *p: alignment && Text alignment information. *p: formatflags && Formatting Information (StringFormatFlags enumeration) *p: hotkeyprefix && Set GpHotkeyPrefix object (write-only?) *p: linealignment && Line alignment *p: trimming && String trimming * * Name = "gpstringformat" _memberdata = * PROCEDURE alignment_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetStringFormatAlign in gdiplus.dll ; integer nGraphics, integer @ local nAlignment nAlignment = cast(null as I) && predefined error value This.gdipStatus = GdipGetStringFormatAlign( This.gdipHandle, @nAlignment) return m.nAlignment ENDPROC PROCEDURE alignment_assign LPARAMETERS tnAlignment #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnAlignment)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif if !This.gdipOwnsThisHandle error _GDIPLUS_GDIPNOTOWNED_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare integer GdipSetStringFormatAlign in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetStringFormatAlign( This.gdipHandle,m.tnAlignment) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE clone lparameters toStringFormat as GpStringFormat this.Destroy() local nHandle nHandle = 0 #if GDIPLUS_CHECK_PARAMS if !(vartype(m.toStringFormat)='O' and m.toStringFormat.gdipHandle<>0) error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif Declare Integer GdipCloneStringFormat In GDIPlus.Dll ; integer nOriginal, integer @nClone This.GdipStatus = GdipCloneStringFormat( ; m.toStringFormat.gdipHandle ; , @nHandle) this.gdipHandle= m.nHandle This.gdipOwnsThisHandle = .T. return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE create && Create StringFormat with optional flags and language lparameters tnFlags, tnLangID this.Destroy() local nHandle nHandle = 0 Declare Integer GdipCreateStringFormat In GDIPlus.Dll ; integer,integer,integer @nHandle This.gdipStatus = GdipCreateStringFormat ( ; evl(tnFlags,0) ; , evl(m.tnLangID,0) ; , @nHandle ) This.SetHandle(m.nHandle,.T.) return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE Destroy if This.GdipHandle!=0 and This.gdipOwnsThisHandle Declare Integer GdipDeleteStringFormat In GDIPlus.Dll ; integer nStringFormat GdipDeleteStringFormat(This.GdipHandle) This.GdipHandle=0 This.gdipOwnsThisHandle=.F. endif ENDPROC PROCEDURE formatflags_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetStringFormatFlags in gdiplus.dll ; integer nGraphics, integer @ local nFlags nFlags = 0 This.gdipStatus = GdipGetStringFormatFlags( This.gdipHandle, @nFlags) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nFlags,cast(null as I)) ENDPROC PROCEDURE formatflags_assign LPARAMETERS tnFlags #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnFlags)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif if !This.gdipOwnsThisHandle error _GDIPLUS_GDIPNOTOWNED_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare integer GdipSetStringFormatFlags in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetStringFormatFlags( This.gdipHandle,m.tnFlags) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE getgenericdefault && Get generic default string format (.NET: SystemDrawing.StringFormat.GenericDefault) lparameters tlMakeClone this.Destroy() local nHandle nHandle = 0 Declare Integer GdipStringFormatGetGenericDefault In GDIPlus.Dll ; integer @nHandle This.gdipStatus = GdipStringFormatGetGenericDefault (@nHandle ) if This.gdipStatus <> GDIPLUS_STATUS_OK return .F. endif if m.tlMakeClone Declare Integer GdipCloneStringFormat In GDIPlus.Dll ; integer nOriginal, integer @nClone This.GdipStatus = GdipCloneStringFormat( ; (m.nHandle) ; , @nHandle) if GDIPLUS_STATUS_OK == This.GdipStatus This.SetHandle(m.nHandle,.T.) endif else This.SetHandle(m.nHandle,.F.) endif return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE getgenerictypographic && Get generic typographic StringFormat lparameters tlMakeClone this.Destroy() local nHandle nHandle = 0 Declare Integer GdipStringFormatGetGenericTypographic In GDIPlus.Dll ; integer @nHandle This.gdipStatus = GdipStringFormatGetGenericTypographic(@nHandle ) if This.gdipStatus <> GDIPLUS_STATUS_OK return .F. endif if m.tlMakeClone Declare Integer GdipCloneStringFormat In GDIPlus.Dll ; integer nOriginal, integer @nClone This.GdipStatus = GdipCloneStringFormat( ; (m.nHandle) ; , @nHandle) if GDIPLUS_STATUS_OK == This.GdipStatus This.SetHandle(m.nHandle,.T.) endif else This.SetHandle(m.nHandle,.F.) endif return GDIPLUS_STATUS_OK == This.GdipStatus ENDPROC PROCEDURE hotkeyprefix_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetStringFormatHotkeyPrefix in gdiplus.dll ; integer nGraphics, integer @ local nPrefix nPrefix = 0 This.gdipStatus = GdipGetStringFormatHotkeyPrefix( This.gdipHandle, @nPrefix) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nPrefix,cast(null as I)) ENDPROC PROCEDURE hotkeyprefix_assign LPARAMETERS tnPrefix #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnPrefix)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif if !This.gdipOwnsThisHandle error _GDIPLUS_GDIPNOTOWNED_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare integer GdipSetStringFormatHotkeyPrefix in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetStringFormatHotkeyPrefix( This.gdipHandle,m.tnPrefix) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE Init lparameters tnFlags, tnLangID if not dodefault() return .F. endif if pcount()>0 return This.Create(m.tnFlags,m.tnLangID) endif ENDPROC PROCEDURE linealignment_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetStringFormatLineAlign in gdiplus.dll ; integer nGraphics, integer @ local nAlignment nAlignment = 0 This.gdipStatus = GdipGetStringFormatLineAlign( This.gdipHandle, @nAlignment) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nAlignment,cast(null as I)) ENDPROC PROCEDURE linealignment_assign LPARAMETERS tnAlignment #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnAlignment)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif if !This.gdipOwnsThisHandle error _GDIPLUS_GDIPNOTOWNED_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare integer GdipSetStringFormatLineAlign in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetStringFormatLineAlign( This.gdipHandle,m.tnAlignment) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC PROCEDURE trimming_access #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return cast(null as I) endif #endif declare integer GdipGetStringFormatTrimming in gdiplus.dll ; integer nGraphics, integer @ local nMode nMode = 0 This.gdipStatus = GdipGetStringFormatTrimming( This.gdipHandle, @nMode) return iif(This.gdipStatus==GDIPLUS_STATUS_OK,m.nMode,cast(null as I)) ENDPROC PROCEDURE trimming_assign LPARAMETERS tnMode #if GDIPLUS_CHECK_PARAMS if !(vartype(m.tnMode)='N') error 11 && Function argument This.gdipStatus = GDIPLUS_STATUS_InvalidParameter return .F. endif #endif #if GDIPLUS_CHECK_OBJECT if This.gdipHandle==0 error _GDIPLUS_NOGDIPOBJECT_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif if !This.gdipOwnsThisHandle error _GDIPLUS_GDIPNOTOWNED_LOC This.gdipStatus = GDIPLUS_STATUS_GenericError return .F. endif #endif declare integer GdipSetStringFormatTrimming in gdiplus.dll ; integer nGraphics, integer This.gdipStatus = GdipSetStringFormatTrimming( This.gdipHandle,m.tnMode) return GDIPLUS_STATUS_OK == This.gdipStatus ENDPROC ENDDEFINE