romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
53d9f1c64ade901ee2deeca7f778bf86c6c840d2
comun/clase/_gdiplus.vc2

7364 lines
228 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
PROTECTED haderror,lasterrormessage
*<PropValue>
allowmodalmessages = (inlist(_VFP.StartMode,0,4))
appname = GDI+ FFC Library
lasterrormessage = ('')
Name = "gpbase"
quietonerror = (not inlist(_VFP.StartMode,0,4))
_memberdata = <VFPData>
<memberdata name="allowmodalmessages" type="property" display="AllowModalMessages"/>
<memberdata name="appname" type="property" display="AppName"/>
<memberdata name="clearerrors" type="method" display="ClearErrors"/>
<memberdata name="clone" type="method" display="Clone" favorites="True"/>
<memberdata name="geterrorstatus" type="method" display="GetErrorStatus"/>
<memberdata name="getlasterrormessage" type="method" display="GetLastErrorMessage"/>
<memberdata name="guidtostring" type="method" display="GUIDToString" favorites="True"/>
<memberdata name="haderror" type="property" display="hadError"/>
<memberdata name="ignoreerrors" type="property" display="IgnoreErrors" favorites="True"/>
<memberdata name="lasterrormessage" type="property" display="lastErrorMessage"/>
<memberdata name="makegdiparrayf" type="method" display="MakeGdipArrayF" favorites="True"/>
<memberdata name="makegdiparrayffromcursor" type="method" display="MakeGdipArrayFFromCursor" favorites="True"/>
<memberdata name="makegdippointf" type="method" display="MakeGdipPointF" favorites="True"/>
<memberdata name="makegdiprectf" type="method" display="MakeGdipRectF" favorites="True"/>
<memberdata name="makegdipsizef" type="method" display="MakeGdipSizeF" favorites="True"/>
<memberdata name="quietonerror" type="property" display="QuietOnError"/>
<memberdata name="stringtoguid" type="method" display="StringToGUID" favorites="True"/>
<memberdata name="objfactory" type="method" display="ObjFactory"/>
<memberdata name="objfactoryhook" type="method" display="ObjFactoryHook"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gpbitmap"
_memberdata = <VFPData>
<memberdata name="create" type="method" display="Create" favorites="True"/>
<memberdata name="createfromgraphics" type="method" display="CreateFromGraphics" favorites="True"/>
<memberdata name="getpixel" type="method" display="GetPixel" favorites="True"/>
<memberdata name="setpixel" type="method" display="SetPixel" favorites="True"/>
<memberdata name="setresolution" type="method" display="SetResolution" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<PropValue>
Name = "gpbrush"
_memberdata = <VFPData>
<memberdata name="gdiphandle" type="property" display="gdipHandle"/>
<memberdata name="gdipownsthishandle" type="property" display="gdipOwnsThisHandle"/>
<memberdata name="gdipstatus" type="property" display="gdipStatus"/>
<memberdata name="gethandle" type="method" display="GetHandle" favorites="True"/>
<memberdata name="getstatus" type="method" display="GetStatus" favorites="True"/>
<memberdata name="sethandle" type="method" display="SetHandle" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
argb = -16777216
Name = "gpcolor"
_memberdata = <VFPData>
<memberdata name="alpha" type="property" display="Alpha" favorites="True"/>
<memberdata name="argb" type="property" display="ARGB" favorites="True"/>
<memberdata name="blue" type="property" display="Blue" favorites="True"/>
<memberdata name="foxrgb" type="property" display="FoxRGB" favorites="True"/>
<memberdata name="green" type="property" display="Green" favorites="True"/>
<memberdata name="red" type="property" display="Red" favorites="True"/>
<memberdata name="set" type="method" display="Set" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gpfont"
_memberdata = <VFPData>
<memberdata name="fontname" type="property" display="FontName" favorites="True"/>
<memberdata name="getheight" type="method" display="GetHeight" favorites="True"/>
<memberdata name="getheightgivendpi" type="method" display="GetHeightGivenDPI" favorites="True"/>
<memberdata name="create" type="method" display="Create" favorites="True"/>
<memberdata name="size" type="property" display="Size" favorites="True"/>
<memberdata name="style" type="property" display="Style" favorites="True"/>
<memberdata name="sizeinpoints" type="property" display="SizeInPoints" favorites="True"/>
<memberdata name="unit" type="property" display="Unit" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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.
*</DefinedPropArrayMethod>
*<PropValue>
gdipfontcollectionhandle = 0
Name = "gpfontfamily"
_memberdata = <VFPData>
<memberdata name="create" type="method" display="Create" favorites="True"/>
<memberdata name="fontname" type="property" display="FontName" favorites="True"/>
<memberdata name="gdipfontcollectionhandle" type="property" display="gdipFontCollectionHandle"/>
<memberdata name="getcellascent" type="method" display="GetCellAscent" favorites="True"/>
<memberdata name="getcelldescent" type="method" display="GetCellDescent" favorites="True"/>
<memberdata name="getemheight" type="method" display="GetEmHeight" favorites="True"/>
<memberdata name="getgenericmonospace" type="method" display="GetGenericMonospace" favorites="True"/>
<memberdata name="getgenericsansserif" type="method" display="GetGenericSansSerif" favorites="True"/>
<memberdata name="getgenericserif" type="method" display="GetGenericSerif" favorites="True"/>
<memberdata name="getlinespacing" type="method" display="GetLineSpacing" favorites="True"/>
<memberdata name="getname" type="method" display="GetName" favorites="True"/>
<memberdata name="isstyleavailable" type="method" display="IsStyleAvailable" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gpgraphics"
pageunit =
pixeloffsetmode = 0
_memberdata = <VFPData>
<memberdata name="clear" type="method" display="Clear" favorites="True"/>
<memberdata name="clipbounds" type="property" display="ClipBounds" favorites="True"/>
<memberdata name="compositingmode" type="property" display="CompositingMode" favorites="True"/>
<memberdata name="compositingquality" type="property" display="CompositingQuality" favorites="True"/>
<memberdata name="createfromhdc" type="method" display="CreateFromHDC" favorites="True"/>
<memberdata name="createfromhwnd" type="method" display="CreateFromHWND" favorites="True" override="True"/>
<memberdata name="createfromimage" type="method" display="CreateFromImage" favorites="True"/>
<memberdata name="dpix" type="property" display="DpiX" favorites="True"/>
<memberdata name="dpiy" type="property" display="DpiY" favorites="True"/>
<memberdata name="drawarc" type="method" display="DrawArc" favorites="True"/>
<memberdata name="drawbezier" type="method" display="DrawBezier" favorites="True"/>
<memberdata name="drawbeziers" type="method" display="DrawBeziers" favorites="True"/>
<memberdata name="drawbeziersfromcursor" type="method" display="DrawBeziersFromCursor" favorites="True"/>
<memberdata name="drawcachedbitmap" type="method" display="DrawCachedBitmap" favorites="True"/>
<memberdata name="drawclosedcurve" type="method" display="DrawClosedCurve" favorites="True"/>
<memberdata name="drawclosedcurvefromcursor" type="method" display="DrawClosedCurveFromCursor" favorites="True"/>
<memberdata name="drawcurve" type="method" display="DrawCurve" favorites="True"/>
<memberdata name="drawcurvefromcursor" type="method" display="DrawCurveFromCursor" favorites="True"/>
<memberdata name="drawellipse" type="method" display="DrawEllipse" favorites="True"/>
<memberdata name="drawellipser" type="method" display="DrawEllipseR" favorites="True"/>
<memberdata name="drawimageat" type="method" display="DrawImageAt" favorites="True"/>
<memberdata name="drawimageportionat" type="method" display="DrawImagePortionAt" favorites="True"/>
<memberdata name="drawimageportionscaled" type="method" display="DrawImagePortionScaled" favorites="True"/>
<memberdata name="drawimagescaled" type="method" display="DrawImageScaled" favorites="True"/>
<memberdata name="drawline" type="method" display="DrawLine" favorites="True"/>
<memberdata name="drawlines" type="method" display="DrawLines" favorites="True"/>
<memberdata name="drawlinesfromcursor" type="method" display="DrawLinesFromCursor" favorites="True"/>
<memberdata name="drawpie" type="method" display="DrawPie" favorites="True"/>
<memberdata name="drawpier" type="method" display="DrawPieR" favorites="True"/>
<memberdata name="drawpolygon" type="method" display="DrawPolygon" favorites="True"/>
<memberdata name="drawpolygonfromcursor" type="method" display="DrawPolygonFromCursor" favorites="True"/>
<memberdata name="drawrectangle" type="method" display="DrawRectangle" favorites="True" override="True"/>
<memberdata name="drawrectangler" type="method" display="DrawRectangleR" favorites="True"/>
<memberdata name="drawrectangles" type="method" display="DrawRectangles" favorites="True"/>
<memberdata name="drawrectanglesfromcursor" type="method" display="DrawRectanglesFromCursor" favorites="True"/>
<memberdata name="drawstringa" type="method" display="DrawStringA" favorites="True"/>
<memberdata name="drawstringw" type="method" display="DrawStringW" favorites="True"/>
<memberdata name="fillclosedcurve" type="method" display="FillClosedCurve" favorites="True"/>
<memberdata name="fillclosedcurvefromcursor" type="method" display="FillClosedCurveFromCursor" favorites="True"/>
<memberdata name="fillellipse" type="method" display="FillEllipse" favorites="True"/>
<memberdata name="fillellipser" type="method" display="FillEllipseR" favorites="True"/>
<memberdata name="fillpie" type="method" display="FillPie" favorites="True"/>
<memberdata name="fillpier" type="method" display="FillPieR" favorites="True"/>
<memberdata name="fillpolygon" type="method" display="FillPolygon" favorites="True"/>
<memberdata name="fillpolygonfromcursor" type="method" display="FillPolygonFromCursor" favorites="True"/>
<memberdata name="fillrectangle" type="method" display="FillRectangle" favorites="True"/>
<memberdata name="fillrectangler" type="method" display="FillRectangleR" favorites="True"/>
<memberdata name="fillrectangles" type="method" display="FillRectangles" favorites="True"/>
<memberdata name="fillrectanglesfromcursor" type="method" display="FillRectanglesFromCursor" favorites="True"/>
<memberdata name="flush" type="method" display="Flush" favorites="True"/>
<memberdata name="interpolationmode" type="property" display="InterpolationMode" favorites="True"/>
<memberdata name="interpolationmode_access" type="method" display="InterpolationMode_access"/>
<memberdata name="interpolationmode_assign" type="method" display="InterpolationMode_assign"/>
<memberdata name="measurestringa" type="method" display="MeasureStringA" favorites="True"/>
<memberdata name="measurestringw" type="method" display="MeasureStringW" favorites="True"/>
<memberdata name="pagescale" type="property" display="PageScale" favorites="True"/>
<memberdata name="pagescale_access" type="method" display="PageScale_access"/>
<memberdata name="pagescale_assign" type="method" display="PageScale_assign"/>
<memberdata name="pageunit" type="property" display="PageUnit" favorites="True"/>
<memberdata name="pageunit_access" type="method" display="PageUnit_access"/>
<memberdata name="pageunit_assign" type="method" display="PageUnit_assign"/>
<memberdata name="pixeloffsetmode" type="property" display="PixelOffsetMode" favorites="True"/>
<memberdata name="pixeloffsetmode_access" type="method" display="PixelOffsetMode_access"/>
<memberdata name="pixeloffsetmode_assign" type="method" display="PixelOffsetMode_assign"/>
<memberdata name="renderingorigin" type="property" display="RenderingOrigin" favorites="True"/>
<memberdata name="resettransform" type="method" display="ResetTransform" favorites="True"/>
<memberdata name="restore" type="method" display="Restore" favorites="True"/>
<memberdata name="rotatetransform" type="method" display="RotateTransform" favorites="True"/>
<memberdata name="save" type="method" display="Save" favorites="True"/>
<memberdata name="scaletransform" type="method" display="ScaleTransform" favorites="True"/>
<memberdata name="smoothingmode" type="property" display="SmoothingMode" favorites="True"/>
<memberdata name="textcontrast" type="property" display="TextContrast" favorites="True"/>
<memberdata name="textrenderinghint" type="property" display="TextRenderingHint" favorites="True"/>
<memberdata name="translatetransform" type="method" display="TranslateTransform" favorites="True"/>
<memberdata name="visibleclipbounds" type="property" display="VisibleClipBounds" favorites="True"/>
<memberdata name="gethdc" type="method" display="GetHdc" favorites="True"/>
<memberdata name="releasehdc" type="method" display="ReleaseHdc" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
hatchstyle = 0
Name = "gphatchbrush"
_memberdata = <VFPData>
<memberdata name="backgroundcolor" type="property" display="BackgroundColor" favorites="true"/>
<memberdata name="create" type="method" display="Create" favorites="true"/>
<memberdata name="foregroundcolor" type="property" display="ForegroundColor" favorites="true"/>
<memberdata name="hatchstyle" type="property" display="HatchStyle" favorites="true"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gpimage"
_memberdata = <VFPData>
<memberdata name="createfromfile" type="method" display="CreateFromFile" favorites="True"/>
<memberdata name="flags" type="property" display="Flags" favorites="True"/>
<memberdata name="getbounds" type="method" display="GetBounds" favorites="True"/>
<memberdata name="getdecoderclsid" type="method" display="GetDecoderCLSID" favorites="True"/>
<memberdata name="getencoderclsid" type="method" display="GetEncoderCLSID" favorites="True"/>
<memberdata name="getthumbnailimage" type="method" display="GetThumbnailImage" favorites="True"/>
<memberdata name="horizontalresolution" type="property" display="HorizontalResolution" favorites="True"/>
<memberdata name="imageheight" type="property" display="ImageHeight" favorites="True"/>
<memberdata name="imagewidth" type="property" display="ImageWidth" favorites="True"/>
<memberdata name="physicaldimension" type="property" display="PhysicalDimension" favorites="True"/>
<memberdata name="pixelformat" type="property" display="PixelFormat" favorites="True"/>
<memberdata name="rawformat" type="property" display="RawFormat" favorites="True"/>
<memberdata name="savetofile" type="method" display="SaveToFile" favorites="True"/>
<memberdata name="verticalresolution" type="property" display="VerticalResolution" favorites="True"/>
<memberdata name="getpropertycount" type="method" display="GetPropertyCount" favorites="True"/>
<memberdata name="getpropertyidlist" type="method" display="GetPropertyIDList" favorites="True"/>
<memberdata name="getpropertyitem" type="method" display="GetPropertyItem" favorites="True"/>
<memberdata name="rotateflip" type="method" display="RotateFlip" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
PROTECTED gdiphandle,gdipownsthishandle,gdipstatus
*<PropValue>
gdiphandle = 0
gdipstatus = 0
Name = "gpobject"
win32lasterror = 0
_memberdata = <VFPData>
<memberdata name="gdiphandle" type="property" display="gdipHandle"/>
<memberdata name="gdipownsthishandle" type="property" display="gdipOwnsThisHandle"/>
<memberdata name="gdipstatus" type="property" display="gdipStatus"/>
<memberdata name="gethandle" type="method" display="GetHandle" favorites="True"/>
<memberdata name="getstatus" type="method" display="GetStatus" favorites="True"/>
<memberdata name="sethandle" type="method" display="SetHandle" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gppen"
_memberdata = <VFPData>
<memberdata name="create" type="method" display="Create" favorites="True"/>
<memberdata name="createfrombrush" type="method" display="CreateFromBrush" favorites="True"/>
<memberdata name="dashcap" type="property" display="DashCap" favorites="True"/>
<memberdata name="dashoffset" type="property" display="DashOffset" favorites="True"/>
<memberdata name="dashstyle" type="property" display="DashStyle" favorites="True"/>
<memberdata name="endcap" type="property" display="EndCap" favorites="True"/>
<memberdata name="linejoin" type="property" display="LineJoin" favorites="True"/>
<memberdata name="miterlimit" type="property" display="MiterLimit" favorites="True"/>
<memberdata name="pencolor" type="property" display="PenColor" favorites="True"/>
<memberdata name="pentype" type="property" display="PenType" favorites="True"/>
<memberdata name="penunit" type="property" display="PenUnit" favorites="True"/>
<memberdata name="penwidth" type="property" display="PenWidth" favorites="True"/>
<memberdata name="startcap" type="property" display="StartCap" favorites="True"/>
<memberdata name="alignment" type="property" display="Alignment" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gppoint"
x = 0
y = 0
_memberdata = <VFPData>
<memberdata name="create" type="method" display="Create" favorites="True"/>
<memberdata name="set" type="method" display="Set" favorites="True"/>
<memberdata name="gdippoint" type="property" display="GdipPoint" favorites="True"/>
<memberdata name="gdippointf" type="property" display="GdipPointF" favorites="True"/>
<memberdata name="x" type="property" display="x" favorites="True"/>
<memberdata name="y" type="property" display="y" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
h = 0
Name = "gprectangle"
w = 0
x = 0
y = 0
_memberdata = <VFPData>
<memberdata name="create" type="method" display="Create" favorites="True"/>
<memberdata name="createfrompointsize" type="method" display="CreateFromPointSize" favorites="True"/>
<memberdata name="set" type="method" display="Set" favorites="True"/>
<memberdata name="gdippoint" type="property" display="GdipPoint" favorites="True"/>
<memberdata name="gdippointf" type="property" display="GdipPointF" favorites="True"/>
<memberdata name="x" type="property" display="x" favorites="True"/>
<memberdata name="y" type="property" display="y" favorites="True"/>
<memberdata name="gdipsize" type="property" display="GdipSize" favorites="True"/>
<memberdata name="gdipsizef" type="property" display="GdipSizeF" favorites="True"/>
<memberdata name="w" type="property" display="w" favorites="True"/>
<memberdata name="h" type="property" display="h" favorites="True"/>
<memberdata name="x2" type="property" display="x2" favorites="True"/>
<memberdata name="y2" type="property" display="y2" favorites="True"/>
<memberdata name="gdiprect" type="property" display="GdipRect" favorites="True"/>
<memberdata name="gdiprectf" type="property" display="GdipRectF" favorites="True"/>
<memberdata name="gdirect" type="property" display="GdiRect" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
h = 0
Name = "gpsize"
w = 0
_memberdata = <VFPData>
<memberdata name="create" type="method" display="Create" favorites="True"/>
<memberdata name="set" type="method" display="Set" favorites="True"/>
<memberdata name="gdipsize" type="property" display="GdipSize" favorites="True"/>
<memberdata name="gdipsizef" type="property" display="GdipSizeF" favorites="True"/>
<memberdata name="w" type="property" display="w" favorites="True"/>
<memberdata name="h" type="property" display="h" favorites="True"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*m: brushcolor_access
*m: brushcolor_assign
*m: create && Create solid brush in given color
*p: brushcolor && Get or set color of a SolidBrush object
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gpsolidbrush"
_memberdata = <VFPData>
<memberdata name="brushcolor" type="property" display="BrushColor" favorites="true"/>
<memberdata name="create" type="method" display="Create" favorites="true"/>
</VFPData>
*</PropValue>
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"
*<DefinedPropArrayMethod>
*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
*</DefinedPropArrayMethod>
*<PropValue>
Name = "gpstringformat"
_memberdata = <VFPData>
<memberdata name="create" type="method" display="Create"/>
<memberdata name="getgenericdefault" type="method" display="GetGenericDefault"/>
<memberdata name="getgenerictypographic" type="method" display="GetGenericTypographic"/>
<memberdata name="alignment" type="property" display="Alignment"/>
<memberdata name="formatflags" type="property" display="FormatFlags"/>
<memberdata name="hotkeyprefix" type="property" display="HotkeyPrefix"/>
<memberdata name="linealignment" type="property" display="LineAlignment"/>
<memberdata name="trimming" type="property" display="Trimming"/>
</VFPData>
*</PropValue>
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
Reference in New Issue View Git Blame Copy Permalink