*======================================================================================== * GDIplus wrapper classes * * Written by Christof Wollenhaupt and placed into the public domain. *======================================================================================== Local loSystem loSystem = CreateObject("gdipSystem") Sample_2() Sample_1() *======================================================================================== * Draws a line on the screen *======================================================================================== Procedure Sample_1 Local loGraphic, loPen loGraphic = Graphics() loGraphic.FromHWND(_Screen.hWnd) loPen = Pen( Color(64,0,0,255), 1 ) loGraphic.DrawLine(m.loPen, 0, 0, 200, 100) Endproc *======================================================================================== * Fills a rectangle with a gradient *======================================================================================== Procedure Sample_2 Local loGraphic, loBrush loGraphic = Graphics() loGraphic.FromHWND(_Screen.hWnd) loBrush = LinearGradientBrush( ; PointF(0.8,1.6), ; PointF(3,2.4), ; Color(255,255,0,0), ; Color(255,0,0,255) ; ) loGraphic.SetPageUnit( Unit("Inch") ) loGraphic.FillRectangle( loBrush, 0, 0, 4, 3 ) EndProc *======================================================================================== * Base class *======================================================================================== Define Class GdiplusBase as Custom nHandle = 0 lExternal = .F. *======================================================================================== * When we release the object, we close the handle *======================================================================================== Procedure Destroy This.CloseHandle() EndProc *======================================================================================== * Subclasses override this handle *======================================================================================== Procedure CloseHandle If This.nHandle # 0 and not This.lExternal This.DoCloseHandle() EndIf This.nHandle = 0 EndProc Procedure DoCloseHandle EndProc *======================================================================================== * Specifies an external GDI handle that is not deleted *======================================================================================== Procedure FromExternal( tnHandle as Integer ) This.nHandle = m.tnHandle This.lExternal = .T. EndProc *======================================================================================== * Converts an integer value into a binary string. *======================================================================================== Procedure Int2Char( tnValue, tnBytes ) Local lcString, lnByte lcString = "" For m.lnByte = 1 to m.tnBytes lcString = m.lcString + Chr(m.tnValue%256) tnValue = Int(m.tnValue/256) Endfor Return m.lcString *======================================================================================== * Converts a floating point variable (SINGLE) into a binary string. *======================================================================================== Procedure Single2Char( tnSingle ) Local lcString lcString = Space(4) Declare RtlMoveMemory in Win32API as __SingleToChar ; String@, Single@, Integer __SingleToChar( @lcString, @tnSingle, 4 ) Return m.lcString EndDefine *======================================================================================== * GDIplus system. *======================================================================================== Define Class gdipSystem as GdiplusBase Procedure Init Local loStartUp, lnHandle Declare Long GdiplusStartup in gdiplus.dll ; Long @token, ; String input, ; String @output loStartUp = CreateObject("GdiplusStartupInput") lnHandle = 0 GdiplusStartup( @lnHandle, loStartUp.GetString(), NULL ) This.nHandle = m.lnHandle EndProc Procedure DoCleanUp Declare GdiplusShutdown in gdiplus Long token GdiplusShutdown( This.nHandle ) EndProc EndDefine *======================================================================================== * StartUp Structure *======================================================================================== Define Class GdiplusStartupInput as GdiplusBase GdiplusVersion = 1 DebugEventCallback = 0 SuppressBackgroundThread = .F. SuppressExternalCodecs = .F. Procedure GetString Local lcStructure lcStructure = ; This.Int2Char( This.GdiPlusVersion, 4 ) + ; This.Int2Char( This.DebugEventCallback, 4 ) + ; This.Int2Char( Iif(This.SuppressBackgroundThread,1,0), 4 ) + ; This.Int2Char( Iif(This.SuppressExternalCodecs,1,0), 4 ) Return m.lcStructure EndDefine *======================================================================================== * A color in GDIplus. Corresponds to the RGB() function but includes the ALPHA channel *======================================================================================== Define Class gdipColor as GdiplusBase nAlpha = 0 nRed = 0 nGreen = 0 nBlue = 0 Procedure Init( tnAlpha, tnRed, tnGreen, tnBlue ) This.nAlpha = m.tnAlpha This.nRed = m.tnRed This.nGreen = m.tnGreen This.nBlue = m.tnBlue EndProc Procedure Get Return 0x1000000*This.nAlpha + 0x10000*This.nRed + 0x100*This.nGreen + This.nBlue enddefine *======================================================================================== * The PointF class encapsulates a point in a 2-D coordinate system. *======================================================================================== Define Class gdipPointF as GdiplusBase nX = 0 nY = 0 Procedure Init( tnX, tnY ) This.nX = m.tnX This.nY = m.tnY EndProc Procedure Get Return This.Single2Char(This.nX) + This.Single2Char(This.nY) EndDefine *======================================================================================== * A RectF object stores the upper-left corner, width, and height of a rectangle. *======================================================================================== Define Class gdipRectF as GdiplusBase nX = 0 nY = 0 nWidth = 0 nHeight = 0 Procedure Init( tnX, tnY, tnWidth, tnHeight ) This.nX = m.tnX This.nY = m.tnY This.nWidth = m.tnWidth This.nHeight = m.tnHeight EndProc Procedure Get Return This.Single2Char(This.nX) + This.Single2Char(This.nY) + ; This.Single2Char(This.nWidth) + This.Single2Char(This.nHeight) EndDefine *======================================================================================== * main object to draw graphics *======================================================================================== Define Class gdipGraphics as GdiplusBase *======================================================================================== * Closes the handle *======================================================================================== Procedure DoCloseHandle Declare Long GdipDeleteGraphics in gdiplus.dll Long graphics GdipDeleteGraphics( This.nHandle ) EndProc *======================================================================================== * The FromHWND method creates a Graphics object that is associated with a specified * window. *======================================================================================== Procedure FromHWND( hWnd as Integer, icm as Boolean ) Local lnHandle Declare Long GdipCreateFromHWND in gdiplus.dll Long hwnd, Long @graphics lnHandle = 0 If GdipCreateFromHWND( m.hWnd, @lnHandle ) == 0 This.nHandle = m.lnHandle Else This.nHandle = 0 EndIf EndProc *======================================================================================== * The DrawLine method draws a line that connects two points. *======================================================================================== Procedure DrawLine LParameter toPen, tnX1, tnY1, tnX2, tnY2 Declare Long GdipDrawLine in gdiplus.dll ; Long graphics, Long pen, Single x1, Single y1, Single x2, Single y2 GdipDrawLine( This.nHandle, toPen.nHandle, m.tnX1, m.tnY1, m.tnX2, m.tnY2 ) EndProc *======================================================================================== * The FillRectangle method uses a brush to fill the interior of a rectangle. *======================================================================================== Procedure FillRectangle LParameter toBrush, tnX, tnY, tnWidth, tnHeight Declare Long GdipFillRectangle in gdiplus.dll ; Long graphics, ; Long brush, ; Single x, ; Single y, ; Single width, ; Single height GdipFillRectangle( This.nHandle, toBrush.nHandle, m.tnX, m.tnY, m.tnWidth, m.tnHeight ) EndProc *======================================================================================== * The SetPageUnit method sets the unit of measure for this Graphics object. The page unit * belongs to the page transformation, which converts page coordinates to device * coordinates. *======================================================================================== Procedure SetPageUnit( tnUnit ) Declare GdipSetPageUnit in gdiplus.dll Long graphics, Long unit GdipSetPageUnit( This.nHandle, m.tnUnit ) EndProc *======================================================================================== * The Save method saves the current state (transformations, clipping region, and quality * settings) of this Graphics object. You can restore the state later by calling the * Graphics::Restore method. *======================================================================================== Procedure Save Local lnState Declare GdipSaveGraphics in gdiplus.dll Long graphics, Long @state lnState = 0 GdipSaveGraphics( This.nHandle, @lnState ) Return m.lnState *======================================================================================== * The Restore method sets the state of this Graphics object to the state stored by a * previous call to the Graphics::Save method of this Graphics object. *======================================================================================== Procedure Restore LParameter tnState Declare GdipRestoreGraphics in gdiplus.dll Long graphics, Long state GdipRestoreGraphics( This.nHandle, m.tnState ) EndProc *======================================================================================== * The RotateTransform method updates the world transformation matrix of this Graphics * object with the product of itself and a rotation matrix. *======================================================================================== Procedure RotateTransform LParameter tnAngle, tnOrder Declare Long GdipRotateWorldTransform in gdiplus.dll ; Long graphics, Single angle, Long order GdipRotateWorldTransform( This.nHandle, m.tnAngle, m.tnOrder ) EndProc *======================================================================================== * The TranslateTransform method updates this Graphics object's world transformation * matrix with the product of itself and a translation matrix. *======================================================================================== Procedure TranslateTransform LParameter tnX, tnY, tnOrder Declare GdipTranslateWorldTransform in gdiplus.dll ; Long graphics, single dx, Single dy, Long order GdipTranslateWorldTransform( This.nHandle, m.tnX, m.tnY, m.tnOrder ) EndProc *======================================================================================== * The FillPath method uses a brush to fill the interior of a path. If a figure in the * path is not closed, this method treats the nonclosed figure as if it were closed by a * straight line that connects the figure's starting and ending points. *======================================================================================== Procedure FillPath LParameter toBrush, toGraphicsPath Declare GdipFillPath in gdiplus.dll Long graphics, Long brush, Long path GdipFillPath( This.nHandle, toBrush.nHandle, toGraphicsPath.nHandle ) EndProc *======================================================================================== *======================================================================================== Procedure DrawPath LParameter toPen, toGraphicsPath Declare GdipDrawPath in gdiplus.dll Long graphics, Long pen, Long path GdipDrawPath( This.nHandle, toPen.nHandle, toGraphicsPath.nHandle ) EndProc EndDefine *======================================================================================== * Pen *======================================================================================== Define Class gdipPen as GdiplusBase *======================================================================================== * *======================================================================================== Procedure Init Lparameters tuVal1, tuVal2 DO case Case Vartype(m.tuVal1)=="O" ; and Lower(tuVal1.Class) == "gdipcolor" This.constructorColor( m.tuVal1, m.tuVal2 ) EndCase EndProc *======================================================================================== * Creates a Pen based on a color *======================================================================================== Procedure constructorColor( toColor, tnWidth ) Local lnHandle Declare Long GdipCreatePen1 in gdiplus.dll ; Long color, ; Single width, ; Long unit, ; Long @pen lnHandle = 0 GdipCreatePen1( toColor.Get(), m.tnWidth, 0, @lnHandle ) This.nHandle = m.lnHandle EndProc *======================================================================================== * Deletes the pen *======================================================================================== Procedure DoCloseHandle Declare Long GdipDeletePen in gdiplus.dll Long pen GdipDeletePen( This.nHandle ) EndProc EndDefine *======================================================================================== * *======================================================================================== Define Class gdipBrush as GdiplusBase *======================================================================================== * Deletes the Brush *======================================================================================== Procedure DoCloseHandle Declare Long GdipDeleteBrush in gdiplus.dll Long brush GdipDeleteBrush( This.nHandle ) EndProc EndDefine *======================================================================================== * The LinearGradientBrush class defines a brush that paints a color gradient in which the * color changes evenly from the starting boundary line of the linear gradient brush to * the ending boundary line of the linear gradient brush. *======================================================================================== Define Class gdipLinearGradientBrush as gdipBrush *======================================================================================== * Determine the correct constructor *======================================================================================== Procedure Init LParameter tuVar1, tuVar2, tuVar3, tuVar4 DO case Case Pcount() == 4 ; and Vartype(m.tuVar1) == "O" ; and Lower(tuVar1.Class) == "gdippointf" ; and Vartype(m.tuVar2) == "O" ; and Lower(tuVar2.Class) == "gdippointf" ; and Vartype(m.tuVar3) == "O" ; and Lower(tuVar3.Class) == "gdipcolor" ; and Vartype(m.tuVar4) == "O" ; and Lower(tuVar4.Class) == "gdipcolor" This.constructorBoundaryPoints( m.tuVar1, m.tuVar2, m.tuVar3, m.tuVar4 ) Case Pcount() == 4 ; and Vartype(m.tuVar1) == "O" ; and Lower(tuVar1.Class) == "gdiprectf" ; and Vartype(m.tuVar2) == "O" ; and Lower(tuVar2.Class) == "gdipcolor" ; and Vartype(m.tuVar3) == "O" ; and Lower(tuVar3.Class) == "gdipcolor" ; and Vartype(m.tuVar4) == "N" This.constructorRectangleDirection( m.tuVar1, m.tuVar2, m.tuVar3, m.tuVar4 ) endcase EndProc *======================================================================================== * Creates a LinearGradientBrush object from a set of boundary points and boundary colors. *======================================================================================== Procedure constructorBoundaryPoints LParameter toPoint1, toPoint2, toColor1, toColor2 Local lnHandle Declare GdipCreateLineBrush in gdiplus.dll ; String point1, string point2, ; Long color1, Long color2, ; Long wrapMode, Long @lineGradient lnHandle = 0 GdipCreateLineBrush( ; toPoint1.Get(), toPoint2.Get(), ; toColor1.Get(), toColor2.Get(), ; 0, @lnHandle ; ) This.nHandle = m.lnHandle EndProc *======================================================================================== * Creates a LinearGradientBrush object from a set of boundary points and boundary colors. *======================================================================================== Procedure constructorRectangleDirection LParameter toRect, toColor1, toColor2, tnDirection Local lnHandle Declare Long GdipCreateLineBrushFromRect in gdiplus.dll ; String rect, Long color1, Long color2, Long mode, Long wrapMode, Long @lineGradient lnHandle = 0 GdipCreateLineBrushFromRect( ; toRect.Get(), ; toColor1.Get(), toColor2.Get(), ; m.tnDirection, ; 0, @lnHandle ; ) This.nHandle = m.lnHandle EndProc EndDefine *======================================================================================== * The SolidBrush class defines a solid color Brush object. A Brush object is used to fill * in shapes similar to the way a paint brush can paint the inside of a shape. *======================================================================================== Define Class gdipSolidBrush as gdipBrush *======================================================================================== * Creates a SolidBrush object based on a color. *======================================================================================== Procedure Init( toColor ) Local lnHandle Declare Long GdipCreateSolidFill in gdiplus.dll Long color, Long @brush lnHandle = 0 GdipCreateSolidFill( toColor.Get(), @lnHandle ) This.nHandle = m.lnHandle EndProc EndDefine *======================================================================================== * A GraphicsPath object stores a sequence of lines, curves, and shapes. You can draw the * entire sequence by calling the DrawPath method of a Graphics object. *======================================================================================== Define Class gdipGraphicsPath as GDIplusBase *======================================================================================== * Creates a GraphicsPath object and initializes the fill mode. *======================================================================================== Procedure Init LParameter tnFillMode Local lnHandle, lnFillMode Declare Long GdipCreatePath in gdiplus.dll long brushMode, long @path lnHandle = 0 If Vartype(m.tnFillMode) == "N" lnFillMode = m.tnFillMode Else lnFillMode = FillMode("Alternate") EndIf GdipCreatePath( m.lnFillMode, @lnHandle ) This.nHandle = m.lnHandle EndProc *======================================================================================== * Deletes the path. *======================================================================================== Procedure DoCloseHandle Declare Long GdipDeletePath in gdiplus.dll Long path GdipDeletePath( this.nHandle ) EndProc *======================================================================================== * The AddLine method adds a line to the current figure of this path. *======================================================================================== Procedure AddLine( toPointF1, toPointF2 ) Declare Long GdipAddPathLine in gdiplus.dll ; Long path, Single x1, Single y1, Single x2, Single y2 GdipAddPathLine( This.nHandle, toPointF1.nX, toPointF1.nY, toPointF2.nX, toPointF2.nY ) EndProc *======================================================================================== * The StartFigure method starts a new figure without closing the current figure. * Subsequent points added to this path are added to the new figure. *======================================================================================== Procedure StartFigure Declare Long GdipStartPathFigure in gdiplus.dll Long path GdipStartPathFigure( This.nHandle ) EndProc *======================================================================================== * The CloseFigure method closes the current figure of this path. *======================================================================================== Procedure CloseFigure Declare Long GdipClosePathFigure in gdiplus.dll Long path GdipClosePathFigure( This.nHandle ) EndProc EndDefine *======================================================================================== * Constructor functions *======================================================================================== Procedure Pen(tuVal1,tuVal2) Return CreateObject("gdipPen",m.tuVal1,m.tuVal2) Procedure LinearGradientBrush(tuVar1, tuVar2, tuVar3, tuVar4) Return CreateObject("gdipLinearGradientBrush", m.tuVar1, m.tuVar2, m.tuVar3, m.tuVar4) Procedure Color( tnAlpha, tnRed, tnGreen, tnBlue ) Return CreateObject( "gdipColor", m.tnAlpha, m.tnRed, m.tnGreen, m.tnBlue ) Procedure PointF( tnX, tnY ) Return CreateObject( "gdipPointF", m.tnX, m.tnY ) Procedure Graphics Return CreateObject("gdipGraphics") Procedure SolidBrush(toColor) Return CreateObject("gdipSolidBrush",m.toColor) Procedure RectF( tnX, tnY, tnWidth, tnHeight ) Return CreateObject( "gdipRectF", tnX, tnY, tnWidth, tnHeight ) Procedure GraphicsPath( tnFillMode ) Return CreateObject( "gdipGraphicsPath", m.tnFillMode ) *======================================================================================== * Enum Unit *======================================================================================== Procedure Unit LParameter tcUnit DO case Case Lower(m.tcUnit) == "world" Return 0 Case Lower(m.tcUnit) == "display" Return 1 Case Lower(m.tcUnit) == "pixel" Return 2 Case Lower(m.tcUnit) == "point" Return 3 Case Lower(m.tcUnit) == "inch" Return 4 Case Lower(m.tcUnit) == "document" Return 5 Case Lower(m.tcUnit) == "millimeter" Return 6 EndCase Return -1 *======================================================================================== * Enum LinearGradientMode *======================================================================================== Procedure LinearGradientMode LParameter tcLinearGradientMode DO case Case Lower(m.tcLinearGradientMode) == "horizontal" Return 0 Case Lower(m.tcLinearGradientMode) == "vertical" Return 1 Case Lower(m.tcLinearGradientMode) == "forwarddiagonal" Return 2 Case Lower(m.tcLinearGradientMode) == "backwarddiagonal" Return 3 endcase Return -1 *======================================================================================== * Enum MatrixOrder *======================================================================================== Procedure MatrixOrder LParameter tcOrder DO case Case Lower(m.tcOrder) == "prepend" Return 0 Case Lower(m.tcOrder) == "append" Return 1 EndCase Return -1 *======================================================================================== * Enum FillMode *======================================================================================== Procedure FillMode LParameter tcFillMode DO case case Lower(m.tcFillMode) == "alternate" Return 0 case Lower(m.tcFillMode) == "winding" Return 1 EndCase Return -1 *======================================================================================== * Report Listener with some utility methods to help with GDI+ output *======================================================================================== Define Class gdipReportListener as ReportListener *======================================================================================== * Returns a record in the FRX file as an object *======================================================================================== Procedure GetFRXRecord( tnRecNo ) Local lnDataSession, loRecord lnDataSession = Set("Datasession") Set Datasession To This.FRXDataSession Go m.tnRecNo in FRX Scatter name m.loRecord Memo Set Datasession To m.lnDataSession Return m.loRecord EndDefine