home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / FYI__GDI+_2097811162008.psc / gdipPathWarper.cls < prev   
Text File  |  2008-02-16  |  26KB  |  564 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "gdipPathWarper"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. Private Declare Function GdipReversePath Lib "gdiplus" (ByVal path As Long) As Long
  16.  
  17. ' sources for warping and matrix math
  18. ' http://www.codeguru.com/cpp/g-m/gdi/gdi/article.php/c3657/
  19. ' http://www.java2s.com/Tutorial/VB/0040__Data-Type/Solveequationsusingmatrices.htm
  20.  
  21. ' Note: The class requires two calls (any order) before anything can be rendered to a DC
  22. ' 1) Call to SetPathString to set the string to be displayed
  23. ' 2) Call to SetPathDest_Points or SetPathDest_Rect to set destination drawing area
  24.  
  25. ' Last but not least. I included options to add rectangles & ellipses. Feel free
  26. ' to add code for Lines, Pies, Arcs, Curves, etc, etc.  The SetPathShape_Ellipse and
  27. ' SetPathShape_Rectangle functions can be used as templates.
  28.  
  29. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  30.  
  31. ' GDI+ functions
  32. ' ---====| GDI+ Rendering quality |====---
  33. Private Declare Function GdipSetSmoothingMode Lib "gdiplus" (ByVal graphics As Long, ByVal SmoothingMode As SmoothingMode) As Long
  34. Private Declare Function GdipSetInterpolationMode Lib "gdiplus" (ByVal graphics As Long, ByVal interpolation As InterpolationMode) As Long
  35. Private Declare Function GdipSetPixelOffsetMode Lib "gdiplus" (ByVal graphics As Long, ByVal PixOffsetMode As PixelOffsetMode) As Long
  36.  
  37. ' ---====| GDI+ Pens & Brushes |====---
  38. Private Declare Function GdipCreatePen1 Lib "gdiplus" (ByVal Color As Long, ByVal Width As Single, ByVal unit As Long, Pen As Long) As Long
  39. Private Declare Function GdipDeletePen Lib "gdiplus" (ByVal Pen As Long) As Long
  40. Private Declare Function GdipCreateSolidFill Lib "gdiplus" (ByVal argb As Long, Brush As Long) As Long
  41. Private Declare Function GdipDeleteBrush Lib "gdiplus" (ByVal Brush As Long) As Long
  42. Private Declare Function GdipCreateLineBrushFromRectI Lib "gdiplus" (ByRef pRect As RECTL, ByVal color1 As Long, ByVal color2 As Long, ByVal mode As Long, ByVal wrapMode As Long, ByRef lineGradient As Long) As Long
  43.  
  44. ' ---====| GDI+ graphics object |====---
  45. Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, hGraphics As Long) As Long
  46. Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
  47.  
  48.  
  49. ' ---====| GDI+ Path functions |====---
  50. Private Declare Function GdipDrawPath Lib "gdiplus" (ByVal graphics As Long, ByVal Pen As Long, ByVal path As Long) As Long
  51. Private Declare Function GdipFillPath Lib "gdiplus" (ByVal graphics As Long, ByVal Brush As Long, ByVal path As Long) As Long
  52. Private Declare Function GdipClonePath Lib "gdiplus.dll" (ByVal path As Long, ByRef clonePath As Long) As Long
  53. Private Declare Function GdipCreatePath Lib "gdiplus.dll" (ByVal brushMode As gdiFillMode, ByRef path As Long) As Long
  54. Private Declare Function GdipCreatePath2 Lib "gdiplus.dll" (ByVal pPointsPtr As Long, ByVal typesPtr As Long, ByVal Count As Long, ByVal fillMode As Long, ByRef path As Long) As Long
  55. Private Declare Function GdipDeletePath Lib "gdiplus.dll" (ByVal path As Long) As Long
  56. Private Declare Function GdipGetPathData Lib "gdiplus.dll" (ByVal path As Long, ByVal pDataPtr As Long) As Long
  57. Private Declare Function GdipGetPathFillMode Lib "gdiplus.dll" (ByVal path As Long, ByRef fillMode As Long) As Long
  58. Private Declare Function GdipGetPathPoints Lib "gdiplus.dll" (ByVal path As Long, ByRef pPointsPtr As Long, ByVal Count As Long) As Long
  59. Private Declare Function GdipGetPathWorldBoundsI Lib "gdiplus.dll" (ByVal path As Long, ByRef Bounds As RECTL, ByVal matrix As Long, ByVal Pen As Long) As Long
  60. Private Declare Function GdipGetPointCount Lib "gdiplus.dll" (ByVal path As Long, ByRef Count As Long) As Long
  61. Private Declare Function GdipResetPath Lib "gdiplus.dll" (ByVal path As Long) As Long
  62. Private Declare Function GdipAddPathStringI Lib "gdiplus" (ByVal path As Long, ByVal str As Long, ByVal Length As Long, ByVal family As Long, ByVal Style As Long, ByVal emSize As Single, layoutRect As RECTL, ByVal StringFormat As Long) As Long
  63. Private Declare Function GdipAddPathEllipseI Lib "gdiplus" (ByVal path As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  64. Private Declare Function GdipAddPathRectangleI Lib "gdiplus" (ByVal path As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  65. Private Declare Function GdipAddPathPath Lib "gdiplus" (ByVal path As Long, ByVal addingPath As Long, ByVal pConnect As Long) As Boolean
  66.  
  67. ' ---====| GDI+ String functions |====---
  68. Private Declare Function GdipCreateFontFamilyFromName Lib "gdiplus" (ByVal name As Long, ByVal fontCollection As Long, fontFamily As Long) As Long
  69. Private Declare Function GdipDeleteFontFamily Lib "gdiplus" (ByVal fontFamily As Long) As Long
  70.  
  71. Private Enum gdiFillMode    ' used for CreatePath
  72.     FillModeAlternate = 0
  73.     FillModeWinding = 1
  74. End Enum
  75. Public Enum gdipWarpModes   ' path warping options
  76.     warpPerspective = 0
  77.     warpBilinear = 1        ' default
  78.     warpSkew = 2
  79. End Enum
  80. Private Enum gdipFontStyles ' used for AddPathString
  81.     FontStyleBold = 1
  82.     FontStyleItalic = 2
  83.     FontStyleUnderline = 4
  84.     FontStyleStrikeout = 8
  85. End Enum
  86. Public Enum LinearGradientMode      ' gradient brush options
  87.     LinearGradientModeHorizontal = 0
  88.     LinearGradientModeVertical = 1
  89.     LinearGradientModeForwardDiagonal = 2
  90.     LinearGradientModeBackwardDiagonal = 3
  91. End Enum
  92.  
  93. ' ---====| graphics quality constants & enumerations |====---
  94. Private Const QualityModeInvalid As Long = -1&
  95. Private Const QualityModeDefault As Long = 0&
  96. Private Const QualityModeLow As Long = 1&
  97. Private Const QualityModeHigh As Long = 2&
  98. Private Enum SmoothingMode
  99.     SmoothingModeInvalid = QualityModeInvalid
  100.     SmoothingModeDefault = QualityModeDefault
  101.     SmoothingModeHighSpeed = QualityModeLow
  102.     SmoothingModeHighQuality = QualityModeHigh
  103.     SmoothingModeNone = QualityModeHigh + 1
  104.     SmoothingModeAntiAlias8x4 = QualityModeHigh + 2
  105.     SmoothingModeAntiAlias = SmoothingModeAntiAlias8x4
  106.     SmoothingModeAntiAlias8x8 = QualityModeHigh + 3
  107. End Enum
  108. Private Enum InterpolationMode
  109.    InterpolationModeInvalid = QualityModeInvalid
  110.    InterpolationModeDefault = QualityModeDefault
  111.    InterpolationModeLowQuality = QualityModeLow
  112.    InterpolationModeHighQuality = QualityModeHigh
  113.    InterpolationModeBilinear
  114.    InterpolationModeBicubic
  115.    InterpolationModeNearestNeighbor
  116.    InterpolationModeHighQualityBilinear
  117.    InterpolationModeHighQualityBicubic
  118. End Enum
  119. Private Enum PixelOffsetMode
  120.    PixelOffsetModeInvalid = QualityModeInvalid
  121.    PixelOffsetModeDefault = QualityModeDefault
  122.    PixelOffsetModeHighSpeed = QualityModeLow
  123.    PixelOffsetModeHighQuality = QualityModeHigh
  124.    PixelOffsetModeNone    ' No pixel offset
  125.    PixelOffsetModeHalf     ' Offset by -0.5 -0.5 for fast anti-alias perf
  126. End Enum
  127.  
  128. ' ---====| Enumerations |====---
  129. Public Enum ePathOrder
  130.     TopLeft_Clockwise = 0 ' left-top, right-top, right-bottom, left-bottom
  131.     TopLeft_zPattern = 1  ' left-top, right-top, left-bottom, right-bottom
  132. End Enum
  133. Public Enum ePathPoint
  134.     TopLeft = 0
  135.     TopRight = 1
  136.     BottomLeft = 2
  137.     BottomRight = 3
  138. End Enum
  139. Private Enum StatusCodes
  140.     statTextApplied = 1
  141.     statBoundsApplied = 2
  142.     statCanDraw = 3
  143.     statRecalcWarp = 4
  144.     statInvalid = 8
  145. End Enum
  146.  
  147. ' ---====| User-Defined Types |====---
  148. Private Type PointF ' used by many GDI+ functions
  149.    X As Single
  150.    Y As Single
  151. End Type
  152. Private Type PathData   ' used to retrieve path points & types
  153.    Count As Long
  154.    Points As Long ' pointer to array of PointF
  155.    Types As Long ' pointer to array of gdiPathTypes
  156. End Type
  157. Private Type RECTL  ' used by many GDI+ functions
  158.    X As Long
  159.    Y As Long
  160.    mWidth As Long
  161.    mHeight As Long
  162. End Type
  163. Private Type PenBrushData   ' cached path information
  164.     Pen As Long         ' pen handle -- must be destroyed
  165.     Brush As Long       ' brush handle -- must be destroyed
  166.     PenColor As Long    ' pen/outline color
  167.     color1 As Long      ' solid brush color or 1st gradient color
  168.     color2 As Long      ' second gradient color
  169.     GradDirection As LinearGradientMode
  170.     GradBounds As RECTL ' latest warp bounds
  171. End Type
  172.  
  173. ' ---====| Class variables |====---
  174. Private m_WarpFactors() As Single   ' calc factors for manual warping
  175. Private m_Style As gdipWarpModes    ' current warp option
  176. Private m_Path As Long              ' handle to a Path -- must be destroyed
  177. Private m_SrcPts() As PointF        ' rect coordinates of non-warped path
  178. Private m_DestPts() As PointF       ' coordinates of warped path
  179. Private m_Status As StatusCodes     ' class-only status flags
  180. Private m_FillObject As PenBrushData    ' GDI+ objects, pen/brush colors, etc
  181.  
  182. Public Function SetPathString(Text As String, Font As StdFont, _
  183.                             Optional X As Long, Optional Y As Long, _
  184.                             Optional hDC As Long, Optional ResetPath As Boolean = True) As Boolean
  185.  
  186.     ' if function returns zero; failed to create path from passed Font -- true type fonts only!
  187.     
  188.     ' Text is the formatted text, including vbCrLf characters if appropriate
  189.     ' Font is the font to be used with Text. Use TrueType fonts
  190.     ' X & Y are where in the path the string should start
  191.     ' hDC if provided will draw the updated path to the passed DC
  192.     
  193.     Dim fRect As RECTL, fontFam As Long, fontStyle As Long
  194.     Dim tPath As Long
  195.     
  196.     ' get font style from passed font object
  197.     With Font
  198.         fontStyle = (Abs(.Italic) * FontStyleItalic) Or (Abs(.Strikethrough) * FontStyleStrikeout) _
  199.         Or (Abs(.Underline) * FontStyleUnderline) Or (Abs(.Bold) * FontStyleBold)
  200.     End With
  201.  
  202.     ' create new path and add text as the path
  203.     Call GdipCreateFontFamilyFromName(StrPtr(Font.name), 0, fontFam)
  204.     If fontFam Then
  205.         If GdipCreatePath(FillModeAlternate, tPath) = 0& Then
  206.             fRect.X = X: fRect.Y = Y
  207.             Call GdipAddPathStringI(tPath, StrPtr(Text), -1, fontFam, fontStyle, Font.Size, fRect, 0&)
  208.             GdipDeleteFontFamily fontFam
  209.             SetPathString = AppendPath(tPath, ResetPath, hDC)
  210.         Else
  211.             GdipDeleteFontFamily fontFam
  212.         End If
  213.     End If
  214. End Function
  215.  
  216. Public Function SetPathShape_Rectangle(Left As Long, Top As Long, _
  217.                             Right As Long, Bottom As Long, _
  218.                             Optional hDC As Long, Optional ResetPath As Boolean = True) As Boolean
  219.  
  220.     ' if function returns false; failed to create path
  221.     
  222.     ' Left & Top are where the rectangle starts
  223.     ' Right & Bottom are where it ends
  224.     ' hDC if provided will draw the updated path to the passed DC
  225.     
  226.     Dim tPath As Long
  227.         
  228.     If GdipCreatePath(FillModeAlternate, tPath) = 0& Then
  229.         GdipAddPathRectangleI tPath, Left, Top, Right - Left + 1, Bottom - Top + 1
  230.         If AppendPath(tPath, ResetPath, 0&) Then
  231.             SetPathDest_Rect Left, Top, Right, Bottom, hDC
  232.             SetPathShape_Rectangle = True
  233.         End If
  234.     End If
  235.  
  236. End Function
  237.  
  238. Public Function SetPathShape_Ellipse(Left As Long, Top As Long, _
  239.                             Right As Long, Bottom As Long, _
  240.                             Optional hDC As Long, Optional ResetPath As Boolean = True) As Boolean
  241.  
  242.     ' if function returns false; failed to create path
  243.     
  244.     ' Left & Top are where the ellipsis starts
  245.     ' Right & Bottom are where it ends
  246.     ' hDC if provided will draw the updated path to the passed DC
  247.     
  248.     Dim tPath As Long
  249.         
  250.     If GdipCreatePath(FillModeAlternate, tPath) = 0& Then
  251.         GdipAddPathEllipseI tPath, Left, Top, Right - Left + 1, Bottom - Top + 1
  252.         If AppendPath(tPath, ResetPath, 0&) Then
  253.             SetPathDest_Rect Left, Top, Right, Bottom, hDC
  254.             SetPathShape_Ellipse = True
  255.         End If
  256.     End If
  257.  
  258. End Function
  259.  
  260. Public Sub SetPathDest_Points(Points() As Single, ByVal Order As ePathOrder, Optional ByVal hDC As Long)
  261.     
  262. '    // warp points are arranged in Z-configuration internally
  263. '    //
  264. '    //      0 ------- 1
  265. '    //      |         |
  266. '    //      |         |
  267. '    //      2 ------- 3
  268. '    //
  269.     
  270.     ' Points must be a 2D array: (0 to 1, 0 to 3)
  271.     ' If Order = TopLeft_Clockwise then point order is
  272.     '   (0,0)=TopLeft-X     (1,0)=TopLeft-Y
  273.     '   (0,1)=TopRight-X    (1,1)=TopRight-Y
  274.     '   (0,2)=BotRight-X    (1,2)=BotRight-Y
  275.     '   (0,3)=BotLeft-X     (1,3)=BotLeft-Y
  276.     ' if Order = TopLeft_zPattern then
  277.     '   (0,0)=TopLeft-X     (1,0)=TopLeft-Y
  278.     '   (0,1)=TopRight-X    (1,1)=TopRight-Y
  279.     '   (0,2)=BotLeft-X     (1,2)=BotLeft-Y
  280.     '   (0,3)=BotRight-X    (1,3)=BotRight-Y
  281.     ' hDC if provided will draw the updated path to the passed DC
  282.     On Error GoTo EH
  283.     
  284.     If UBound(Points, 2) = 3 And UBound(Points, 1) = 1 Then
  285.         If LBound(Points, 2) = 0 And LBound(Points, 1) = 0 Then
  286.             If Order = TopLeft_zPattern Then
  287.                 CopyMemory m_DestPts(0), Points(0, 0), 32&
  288.             ElseIf Order = TopLeft_Clockwise Then
  289.                 CopyMemory m_DestPts(0), Points(0, 0), 16&
  290.                 CopyMemory m_DestPts(3), Points(2, 0), 8&
  291.                 CopyMemory m_DestPts(2), Points(3, 0), 8&
  292.             Else
  293.                 Exit Sub
  294.             End If
  295.             If m_Style = warpSkew Then
  296.                 m_DestPts(3).X = m_DestPts(1).X + (m_DestPts(2).X - m_DestPts(0).X)
  297.                 m_DestPts(3).Y = m_DestPts(1).Y + (m_DestPts(2).Y - m_DestPts(0).Y)
  298.             End If
  299.             BuildWarpMatrix hDC
  300.         End If
  301.     End If
  302. EH:
  303.     If Err Then Err.Clear ' passed wrong dimension array
  304. End Sub
  305.  
  306. Public Sub SetPathDest_Rect(rectLeft As Long, rectTop As Long, _
  307.                         rectRight As Long, rectBottom As Long, Optional hDC As Long)
  308.  
  309.     ' // warp points are arranged in Z-configuration -- See SetPathDest_Points routine
  310.     ' hDC if provided will draw the updated path to the passed DC
  311.     
  312.     m_DestPts(0).X = rectLeft: m_DestPts(0).Y = rectTop
  313.     m_DestPts(1).X = rectRight: m_DestPts(1).Y = rectTop
  314.     m_DestPts(2).X = rectLeft: m_DestPts(2).Y = rectBottom
  315.     m_DestPts(3).X = rectRight: m_DestPts(3).Y = rectBottom
  316.     BuildWarpMatrix hDC
  317.  
  318. End Sub
  319.  
  320. Public Function UpdateDestPoint(ByVal X As Single, ByVal Y As Single, ByVal whichPoint As ePathPoint, Optional hDC As Long) As Boolean
  321.     ' update a single point in the warp bounds
  322.     ' hDC if provided will draw the updated path to the passed DC
  323.     
  324.     ' when skewing, the warp shape must be a parallelogram. This requires calculating
  325.     ' and also modifying the opposite corner point from the one being updated
  326.     If (m_Status And statBoundsApplied) = statBoundsApplied Then
  327.         Select Case whichPoint
  328.         Case TopLeft, BottomRight ' pts 0,3 modifies 3,0
  329.             m_DestPts(whichPoint).X = X: m_DestPts(whichPoint).Y = Y
  330.             If m_Style = warpSkew Then
  331.                 m_DestPts(3 - whichPoint).X = m_DestPts(Abs(whichPoint - 1)).X + m_DestPts(Abs(whichPoint - 2)).X - m_DestPts(whichPoint).X
  332.                 m_DestPts(3 - whichPoint).Y = m_DestPts(Abs(whichPoint - 1)).Y + m_DestPts(Abs(whichPoint - 2)).Y - m_DestPts(whichPoint).Y
  333.             End If
  334.             BuildWarpMatrix hDC
  335.             UpdateDestPoint = True
  336.         
  337.         Case TopRight, BottomLeft ' pts 1,2 modifies 2,1
  338.             m_DestPts(whichPoint).X = X: m_DestPts(whichPoint).Y = Y
  339.             If m_Style = warpSkew Then
  340.                 m_DestPts(3 - whichPoint).X = m_DestPts((whichPoint - 1) * 3).X + m_DestPts((2 - whichPoint) * 3).X - m_DestPts(whichPoint).X
  341.                 m_DestPts(3 - whichPoint).Y = m_DestPts((whichPoint - 1) * 3).Y + m_DestPts((2 - whichPoint) * 3).Y - m_DestPts(whichPoint).Y
  342.             End If
  343.             BuildWarpMatrix hDC
  344.             UpdateDestPoint = True
  345.         End Select
  346.     End If
  347. End Function
  348.  
  349. Public Function OffsetDestination(ByVal Xoffset As Single, ByVal Yoffset As Single, Optional hDC As Long) As Boolean
  350.  
  351.     ' function shifts the path by X,Y offsets
  352.     ' hDC if provided will draw the updated path to the passed DC
  353.     
  354.     If (m_Status And statBoundsApplied) = statBoundsApplied Then
  355.         On Error Resume Next ' errors? Possibly if user sets huge offset & overflow occurs
  356.         Dim I As Long, tPts() As PointF
  357.         tPts() = m_DestPts()
  358.         For I = 0 To 3
  359.             m_DestPts(I).X = m_DestPts(I).X + Xoffset
  360.             m_DestPts(I).Y = m_DestPts(I).Y + Yoffset
  361.         Next
  362.         If Err Then
  363.             Err.Clear
  364.             m_DestPts = tPts
  365.         Else
  366.             BuildWarpMatrix hDC
  367.             OffsetDestination = True
  368.         End If
  369.     End If
  370. End Function
  371.  
  372. Public Property Let WarpStyle(Style As gdipWarpModes)
  373.     ' option to set the warp mode/style
  374.     If Style >= warpPerspective And Style <= warpSkew Then
  375.         If Not Style = m_Style Then
  376.             m_Style = Style
  377.             If m_Style = warpSkew Then
  378.                 ' UpdateDestPoint will recalc the bottom right corner as needed
  379.                 UpdateDestPoint m_DestPts(0).X, m_DestPts(0).Y, TopLeft
  380.             Else
  381.                 BuildWarpMatrix 0&
  382.             End If
  383.         End If
  384.     End If
  385. End Property
  386. Public Property Get WarpStyle() As gdipWarpModes
  387.     WarpStyle = m_Style
  388. End Property
  389.  
  390. Public Sub SetOutLine(ByVal PenThickness As Single, ByVal PenColor As Long, Optional ByVal Opacity As Long = 100)
  391.     ' Outline pen color or null color
  392.     ' Pass -1 for PenColor to assign a null pen
  393.     If m_FillObject.Pen Then GdipDeletePen m_FillObject.Pen
  394.     m_FillObject.Pen = 0&
  395.     m_FillObject.PenColor = PenColor
  396.     If PenColor > -1 Then
  397.         If CreateBGRobject(m_FillObject.PenColor, Opacity) Then
  398.             GdipCreatePen1 m_FillObject.PenColor, PenThickness, 2, m_FillObject.Pen
  399.         End If
  400.     End If
  401. End Sub
  402.  
  403. Public Sub SetBrush(ByVal Color As Long, Optional ByVal gradientColor As Long = -1, Optional gradientDirection As LinearGradientMode, Optional ByVal Opacity As Long = 100)
  404.     ' Fill brush, either solid, gradient or null
  405.     ' Pass -1 for Color to assign a null brush
  406.     With m_FillObject
  407.         If .Brush Then GdipDeleteBrush .Brush
  408.         .Brush = 0&
  409.         .color1 = Color
  410.         .GradDirection = -1 ' non-gradient brush, default
  411.         If .color1 > -1 Then
  412.             If CreateBGRobject(.color1, Opacity) Then
  413.                 .color2 = gradientColor
  414.                 If .color2 > -1 Then
  415.                     If CreateBGRobject(.color2, Opacity) Then
  416.                         .GradDirection = gradientDirection
  417.                         If (m_Status And statRecalcWarp) = 0& Then
  418.                             GdipCreateLineBrushFromRectI .GradBounds, .color1, .color2, .GradDirection, 0&, .Brush
  419.                         End If
  420.                     End If
  421.                 End If
  422.                 If .GradDirection = -1 Then ' use solid brush
  423.                     GdipCreateSolidFill .color1, m_FillObject.Brush
  424.                 End If
  425.             End If
  426.         End If
  427.     End With
  428. End Sub
  429.  
  430. Public Sub GetBoundingRect(Left As Long, Top As Long, Right As Long, Bottom As Long)
  431.     ' Retrieves the bounding rectangle of the current warped path
  432.     If m_Path = 0& Then
  433.         Left = 0&: Top = 0&
  434.         Right = 0&: Bottom = 0&
  435.     Else
  436.         Dim tPath As Long, srcPts() As Single, ptTypes() As Byte
  437.         If (m_Status And statRecalcWarp) = statRecalcWarp Then
  438.             tPath = WarpPoints(srcPts, ptTypes)
  439.             If tPath Then GdipDeletePath tPath
  440.         End If
  441.         With m_FillObject
  442.             Left = .GradBounds.X: Top = .GradBounds.Y
  443.             Right = .GradBounds.mWidth + Left
  444.             Bottom = .GradBounds.mHeight + Top
  445.         End With
  446.     End If
  447.  
  448. End Sub
  449.  
  450. Public Function GetBoundingPoints(Points() As Single) As Long
  451.  
  452. '   If function retuns zero, the points array should be considered null
  453. '       Array is returned as 2D :: (0 to 1, 0 to nrPoints-1)
  454. '       The 1st element of 1st dim are X values, the 2nd are Y values
  455. '       There are always four points in the array
  456.  
  457. '    // bouding points are arranged in Z-configuration
  458. '    //
  459. '    //      0 ------- 1
  460. '    //      |         |
  461. '    //      |         |
  462. '    //      2 ------- 3
  463. '    //
  464.     If (m_Status And statBoundsApplied) = statBoundsApplied Then
  465.         ReDim Points(0 To 1, 0 To 3)
  466.         CopyMemory Points(0, 0), m_DestPts(0), 32&
  467.         GetBoundingPoints = 4
  468.     End If
  469. End Function
  470.  
  471. Public Function GetPathPoints(Points() As Single, PointType() As Byte) As Long
  472.         ' returns the path points & path types
  473.         ' Points when returned is 2D array: (0 to 1, 0 to nrPts-1)
  474.         '       the X coords are 1D 0 element, Y is 1 element
  475.         ' PointType are members of the GDI+ documented PathPointType enumeration
  476.         ' If function returns 0 consider arrays null
  477.         If m_Path Then
  478.             Dim tPath As Long, Count As Long
  479.             tPath = WarpPoints(Points, PointType, Count)
  480.             If tPath Then GdipDeletePath tPath
  481.             GetPathPoints = Count
  482.         End If
  483.  
  484. End Function
  485.  
  486.  
  487. Private Function AppendPath(fromPath As Long, bReset As Boolean, hDC As Long) As Boolean
  488.  
  489.     Dim fRect As RECTL
  490.     
  491.     m_Status = m_Status Or statRecalcWarp Or statTextApplied
  492.     
  493.     If m_Path = 0& Then
  494.         m_Path = fromPath
  495.     Else
  496.         If bReset Then GdipResetPath m_Path
  497.         GdipAddPathPath m_Path, fromPath, True
  498.         GdipDeletePath fromPath
  499.     End If
  500.     ' get the actual bounds of the path before any warping is applied
  501.     GdipGetPathWorldBoundsI m_Path, fRect, 0&, 0&
  502.     m_SrcPts(0).X = fRect.X: m_SrcPts(0).Y = fRect.Y
  503.     m_SrcPts(1).X = fRect.mWidth + fRect.X: m_SrcPts(1).Y = m_SrcPts(0).Y
  504.     m_SrcPts(2).X = m_SrcPts(0).X: m_SrcPts(2).Y = fRect.mHeight + m_SrcPts(0).Y
  505.     m_SrcPts(3).X = m_SrcPts(1).X: m_SrcPts(3).Y = m_SrcPts(2).Y
  506.         
  507.     ' recalculate the warp matrix only if destination points have been set
  508.     If (m_Status And statBoundsApplied) = statBoundsApplied Then BuildWarpMatrix hDC
  509.     AppendPath = True
  510.     
  511. End Function
  512. Private Function CreateBGRobject(Color As Long, ByVal Opacity As Long) As Boolean
  513.     ' Local use to create RGB color to BGRA
  514.     If Opacity < 1 Then
  515.         Exit Function
  516.     ElseIf Opacity > 100 Then
  517.         Opacity = 100
  518.     End If
  519.     Opacity = (255 * Opacity) \ 100
  520.     Color = ((Color And &H7ThenrrTo 3+ty < 1 Then
  521.    slBxit FunctoSCThen) Opa * Opaa WarpPointen
  522.   +k0n poAltecalcula * Opaa Wad Function
  523. en
  524.   * OElseIf Opacity  2 ------- 3
  525. '         LecR PoimoothingMrnd If
  526.  
  527. nerRa-)d Functiono,reateWatTeed Then BuildApoAltecalculaeIf OpoaTo 3+ty < l draw umembers the warp modeoAltecalc
  528.     
  529. End Fucal RGB colllllllouldfce(alc
  530.     
  531. End Fucal RGB c< 1 Then
  532.    sln
  533. e warpf
  534.     Enevers the wagawarpf
  535.   sI ' Local use to create RGB color to B-embero Nimo warpf
  536.     Enevro Nimo w a+Functi 
  537.     ' recalcula
  538.     EnePts(0 draw the updated  a+ eIf Opaci-      Opa'ee.local usecti  1D 0 ti rovided will draw the updated path to the passed DC
  539.     
  540.     If (m_Status And statBoundsApplied) = statBoundsApplied Then
  541.         On Error Resume Next ' errors? Possibly if user sets he(alc
  542.     
  543. End Fucal RGB c< 1 Then
  544.    Ith poin',ctioTo 3Rect.Y
  545.     m_Sbrl e pen conten'user sets ha-)d FunctinrrToal RGB c< 1 T# And statBokts ha-)w umembers tu m_SrcPts(0).Y
  546. ts ha-)w umembers tu X2D)epaci-umemberse   // c< 1< 1 T#           m_Sr.X = m_S atng, Top As Long, Ri soRect.Y1& rrTo 3+ty  Enevers tcal RGot + 1, Bottom ).X eIf OmRe Functioyr + 1,     ' reca2).Y = fRectF reca2).Y = fRec'5 by  Opacity tBound = (25(nd = (me ;ba      Opacity tBound = (earGradientMode   
  547. End Fucal RGB c< 1 Thena  Entioyr + 1, RGB c<  
  548.          f to B by ca2).Y oculaeIf OpoaTo 3+ty <tfal RGB e ;ba  oaTo 3ctF rcalc
  549. kdientMode   llllllllllllllllllllllllllllcreate RGB color to B-embero Nir)c
  550. kdientMode   l0dipi<ateWa= m_Destvero; failednBrxtsl2).Y.atrieves the bounding recAc
  551. ka2).Y ocugl pending p AppendPath = True
  552.     
  553. End Function
  554. Private Function CreateBGRobject(Color As Long, ByVal Opacity As Long) As Boolean
  555.     ' Local use toecalxns the city
  556.    End If
  557.     En_Destv tu m_SrcPtssssssssssss,ate FucPtssssss    mn
  558.     ' Local use toea    e RGB color to B-emto ns the2Applied) hfRec'5lcula
  559.     Enie BuildWarpMa up toea  gl pending citysaemo ns the2Applied) hfR
  560.         End sssss) hfR8khPoint).ied) (ip OpoaTo 3+tyt, 0&, 0&ip OpoaTo 3+tyt,0&, 0&
  561.     m_SmoaTo 3+tyt, 0&, 0&ip OpoaTo&, 0 1,  3+tyt, -ual bounds of '_S atng,onal hDC3+tyt,0&, 0&tyt,0&, 0&aemo n).X3+tythe2Ap -updated pa&ae (ip OpoaTo 3+t+tythe2Ap -ythe2Ap -ythe2+e0ythe2Ap Ap -ythe2+e0 atng,onal hDC3+tyt,0&0&, 0&atng,onal hDC3+tyt,0&0&, 0&a>onal ersyr +e0ythe2A path to)N have been d  f to B by ca2).Y oculaeIf OpoaTo 3+ty <tfal RGB e ;ba  oaTo 3ctF rcalinn ottom = .GradBounds.mHeighunds.mHeighunds.mHeignal ms((p Or statTextApplied
  562.  &, 0&aeignal mspending citysaestaAp Ap -ythe2+e0 atng,onal hD 0&, 0&ip &, )ml h)GRobj7X coords are 1s(2).Y =aoysaestaAp = TopLeft_Clockwise .GradBokHeignD, )ml h)GRobj7X coortoea   Else
  563.       Left =eie   Left =eie   rns 0 consider ar&eml h)GRobj7X co;ba  oaTo 3ctF he2Apm_SrcPts(1).X = fRe    ErEtApplieYCe2Apm_SrcPts(1)>fRe eft =eie   rns 0 consider ar&eml hs he1m h)GRobj7X coorx &, 0&aeibjeTopLeft_ClockriyncteH+ (m_ ((Color And yh
  564.      onathPoi'7r+ on7.X    rns 0 cgilor