home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / LaVolpe_Wo2107533262008.psc / clsPathTracker.cls < prev    next >
Text File  |  2008-02-07  |  11KB  |  251 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 = "clsPathTracker"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private Declare Function FillPath Lib "gdi32.dll" (ByVal hdc As Long) As Long
  17. Private Declare Function BeginPath Lib "gdi32.dll" (ByVal hdc As Long) As Long
  18. Private Declare Function EndPath Lib "gdi32.dll" (ByVal hdc As Long) As Long
  19.  
  20. Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  21.  
  22. Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long
  23. Private Declare Function CreateBitmap Lib "gdi32.dll" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, ByRef lpBits As Any) As Long
  24. Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
  25. Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
  26. Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  27. Private Declare Function SetTextColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
  28. Private Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal crColor As Long) As Long
  29. Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
  30. Private Declare Function GetBkColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
  31. Private Declare Function GetTextColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
  32. Private Declare Function SetDIBColorTable Lib "gdi32.dll" (ByVal hdc As Long, ByVal un1 As Long, ByVal un2 As Long, ByRef pcRGBQuad As Any) As Long
  33. Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, ByRef pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Long, ByVal Handle As Long, ByVal dw As Long) As Long
  34. Private Declare Function FrameRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
  35. Private Const BLACK_BRUSH As Long = 4
  36. Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
  37. Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  38. Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
  39. Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
  40.  
  41. Private Type BITMAPINFOHEADER
  42.     biSize As Long
  43.     biWidth As Long
  44.     biHeight As Long
  45.     biPlanes As Integer
  46.     biBitCount As Integer
  47.     biCompression As Long
  48.     biSizeImage As Long
  49.     biXPelsPerMeter As Long
  50.     biYPelsPerMeter As Long
  51.     biClrUsed As Long
  52.     biClrImportant As Long
  53. End Type
  54. Private Type BITMAPINFO
  55.     bmiHeader As BITMAPINFOHEADER
  56.     bmiColors(0 To 1) As Long   ' 2 color bitmap
  57. End Type
  58.  
  59. Private Type RECT
  60.     Left As Long
  61.     Top As Long
  62.     Right As Long
  63.     Bottom As Long
  64. End Type
  65. Private Type POINTAPI
  66.     x As Long
  67.     y As Long
  68. End Type
  69.  
  70. Private m_DC As Long
  71. Private m_Bitmap As Long
  72. Private m_OldBmp As Long
  73.  
  74. Private m_OffsetSrc As POINTAPI ' offset from left edge of m_Bitmap & start of drag image inside bitmap
  75. Private m_MouseOffset As POINTAPI
  76. Private m_DestSize As POINTAPI  ' destination width/height of m_Bitmap
  77. Private m_SrcSize As POINTAPI   ' original size of the source used to create drag image
  78. Private m_Position As POINTAPI  ' the current X,Y where drag image is rendered
  79.  
  80.  
  81.  
  82.  
  83. Public Sub InitializeSizeMove(ByVal hdc As Long, ByVal MouseX As Single, ByVal MouseY As Single, SourcePath As clsWApath)
  84.  
  85.     Dim tDC As Long, hBrush As Long, tRect As RECT
  86.     Dim tDIB As BITMAPINFO, leftTopPt As POINTAPI
  87.     
  88.     ' create a black & white, XOR-able bitmap
  89.     tDC = GetDC(0&)
  90.     
  91.     SourcePath.GetBoundingBox_Long False, leftTopPt.x, leftTopPt.y, m_SrcSize.x, m_SrcSize.y
  92.     m_DestSize.x = Sqr(m_SrcSize.x * m_SrcSize.x + m_SrcSize.y * m_SrcSize.y)
  93.     m_DestSize.y = m_DestSize.x
  94.     
  95.     With tDIB.bmiHeader
  96.         .biBitCount = 1
  97.         .biClrImportant = 2
  98.         .biClrUsed = 2
  99.         .biWidth = m_DestSize.x
  100.         .biHeight = .biWidth * 2 ' include mask half
  101.         .biPlanes = 1
  102.         .biSize = 40
  103.     End With
  104.     tDIB.bmiColors(1) = vbWhite
  105.     m_Bitmap = CreateDIBSection(tDC, tDIB, 0&, ByVal 0&, 0&, 0&)
  106.     
  107.     If m_Bitmap Then
  108.         m_DC = CreateCompatibleDC(tDC)
  109.         If m_DC = 0& Then
  110.             ReleaseDC 0&, tDC
  111.             DeleteObject m_Bitmap
  112.         Else
  113.     
  114.             m_OldBmp = SelectObject(m_DC, m_Bitmap)
  115.             ReleaseDC 0&, tDC
  116.     
  117.             ' paint the bottom half white
  118.             hBrush = GetStockObject(0&)
  119.             tRect.Top = m_DestSize.y
  120.             tRect.Bottom = m_DestSize.y * 2
  121.             tRect.Right = m_DestSize.x
  122.             FillRect m_DC, tRect, hBrush
  123.             
  124.             m_OffsetSrc.x = (m_DestSize.x - m_SrcSize.x) \ 2
  125.             m_OffsetSrc.y = (m_DestSize.y - m_SrcSize.y) \ 2
  126.             
  127.             ' using GDI, not GDI+, render the top half, then the bottom half, alternating pen colors
  128.             BeginPath m_DC
  129.             SourcePath.RenderOutline_XOR m_DC, vbBlack, , psXOR_Solid, -leftTopPt.x + m_OffsetSrc.x, -leftTopPt.y + m_OffsetSrc.y
  130.             EndPath m_DC
  131.             FillPath m_DC
  132.             StretchBlt m_DC, 0, tRect.Top, tRect.Right, tRect.Top, m_DC, 0, 0, tRect.Top, tRect.Right, vbSrcInvert
  133.             
  134.             ' draw the bitmap for first time
  135.             
  136.             
  137.             m_Position.x = leftTopPt.x - m_OffsetSrc.x
  138.             m_Position.y = leftTopPt.y - m_OffsetSrc.y
  139.             
  140.             StretchBlt hdc, m_Position.x, m_Position.y, m_DestSize.x, m_DestSize.y, m_DC, 0, 0, m_DestSize.x, m_DestSize.y, vbSrcInvert
  141.             ' create offsets from current mouse X,Y to top/left edge of path
  142.     
  143.             m_MouseOffset.x = MouseX - m_Position.x
  144.             m_MouseOffset.y = MouseY - m_Position.y
  145.             m_SrcSize = m_DestSize
  146.             
  147.         End If
  148.     End If
  149.     
  150.  
  151. End Sub
  152.  
  153. Public Sub TerminateSizeMove(ByVal hdc As Long, ByVal Cancel As Boolean, newX As Long, newY As Long, ScaleX As Single, ScaleY As Single)
  154.  
  155.     If m_DC Then
  156.         ' erase the last drawn path
  157.         StretchBlt hdc, m_Position.x, m_Position.y, m_DestSize.x, m_DestSize.y, m_DC, 0, 0, m_SrcSize.x, m_SrcSize.y, vbSrcInvert
  158.         ' clean up
  159.         If m_Bitmap Then DeleteObject SelectObject(m_DC, m_OldBmp)
  160.         DeleteDC m_DC
  161.     End If
  162.     If Not Cancel Then
  163. '        Dim tRect As RECT
  164. '        tRect.Left = m_Position.x: tRect.Top = m_Position.y
  165. '        tRect.Right = m_Position.x + m_DestSize.x
  166. '        tRect.Bottom = m_Position.y + m_DestSize.y
  167. '        FrameRect hdc, tRect, GetStockObject(0&)
  168.         
  169.         ScaleX = m_DestSize.x / m_SrcSize.x
  170.         ScaleY = m_DestSize.y / m_SrcSize.y
  171.         newX = m_Position.x + m_OffsetSrc.x * ScaleX
  172.         newY = m_Position.y + m_OffsetSrc.y * ScaleY
  173.     End If
  174.  
  175.  
  176. End Sub
  177.  
  178. Public Sub UpdateSizeMove(ByVal hdc As Long, ByVal x As Single, ByVal y As Single, ByVal mode As Long)
  179.  
  180.         
  181.     ' Mode are positions from center left edge to bottom right corner in clockwise order ....
  182.     ' Mode 0 is for moving, not sizing
  183.     
  184.     ' 2     3     4
  185.     '
  186.     ' 1           5
  187.     '
  188.     ' 8     7     6
  189.     
  190.     If m_DC Then
  191.         ' erase last drawn path
  192.         StretchBlt hdc, m_Position.x, m_Position.y, m_DestSize.x, m_DestSize.y, m_DC, 0, 0, m_SrcSize.x, m_SrcSize.y, vbSrcInvert
  193.         ' update left/top position
  194.         Select Case mode
  195.         Case 0 ' moving, not sizing
  196.             m_Position.x = x - m_MouseOffset.x
  197.             m_Position.y = y - m_MouseOffset.y
  198.         Case 1 ' left edge center, size WE
  199.             m_DestSize.x = m_DestSize.x + (m_Position.x - (x - m_MouseOffset.x))
  200.             m_Position.x = x - m_MouseOffset.x
  201.         Case 2 ' top left corner, size NWSE
  202.             m_DestSize.x = m_DestSize.x + (m_Position.x - (x - m_MouseOffset.x))
  203.             m_DestSize.y = m_DestSize.y + (m_Position.y - (y - m_MouseOffset.y))
  204.             m_Position.x = x - m_MouseOffset.x
  205.             m_Position.y = y - m_MouseOffset.y
  206.         Case 3 ' top center, size NS
  207.             m_DestSize.y = m_SrcSize.y + (m_Position.y - (y - m_MouseOffset.y))
  208.             m_Position.y = y - m_MouseOffset.y
  209.         Case 4 ' top right corner, size NESW
  210.             m_DestSize.x = m_SrcSize.x - (m_Position.x - (x - m_MouseOffset.x))
  211.             m_DestSize.y = m_DestSize.y + (m_Position.y - (y - m_MouseOffset.y))
  212.             m_Position.y = y - m_MouseOffset.y
  213.         Case 5 ' right edge center, size WE
  214.             m_DestSize.x = m_SrcSize.x - (m_Position.x - (x - m_MouseOffset.x))
  215.         Case 6 ' bottom right corner, size NWSE
  216.             m_DestSize.x = m_SrcSize.x - (m_Position.x - (x - m_MouseOffset.x))
  217.             m_DestSize.y = m_SrcSize.y - (m_Position.y - (y - m_MouseOffset.y))
  218.         Case 7 ' bottom edge center, size NS
  219.             m_DestSize.y = m_SrcSize.y - (m_Position.y - (y - m_MouseOffset.y))
  220.         Case 8 ' bottom left corner, size NESW
  221.             m_DestSize.x = m_DestSize.x + (m_Position.x - (x - m_MouseOffset.x))
  222.             m_DestSize.y = m_SrcSize.y - (m_Position.y - (y - m_MouseOffset.y))
  223.             m_Position.x = x - m_MouseOffset.x
  224.         End Select
  225.         
  226.         ' render at new position
  227.         StretchBlt hdc, m_Position.x, m_Position.y, m_DestSize.x, m_DestSize.y, m_DC, 0, 0, m_SrcSize.x, m_SrcSize.y, vbSrcInvert
  228.     
  229.     End If
  230.  
  231. End Sub
  232.  
  233. '   some thoughts about rubberband objects
  234. '   1. Path first created, its origin points are kept forever
  235. '   2. When moving, also move source points
  236. '   3. When resizing, maintain scaleX, scaleY values forever
  237. '   4. When rotating, maintain rotation value forever
  238. '   5. When warping, maintain warp points
  239. '   6. Original path is never modified
  240. '
  241. '   UDT would look something like the following:
  242. '       Origin(0 to 3) as PointF
  243. '       Warp(0 to 3) as PointF
  244. '       Rotation As Single
  245. '       Scaler As PointF
  246. '
  247. '   So when rendering is required:
  248. '   1. Rotate & scale using cached values
  249. '   2. Warp the scaled/rotated points
  250. '
  251.