home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Virtual_Li2023561062006.psc / ListView / clsStyle.cls < prev    next >
Text File  |  2006-08-05  |  6KB  |  221 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 = "clsStyle"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15.  
  16. ' Copyright (C) 2006 Kristian S. Stangeland
  17.  
  18. ' This program is free software; you can redistribute it and/or
  19. ' modify it under the terms of the GNU General Public License
  20. ' as published by the Free Software Foundation; either version 2
  21. ' of the License, or (at your option) any later version.
  22.  
  23. ' This program is distributed in the hope that it will be useful,
  24. ' but WITHOUT ANY WARRANTY; without even the implied warranty of
  25. ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26. ' GNU General Public License for more details.
  27.  
  28. ' You should have received a copy of the GNU General Public License
  29. ' along with this program; if not, write to the Free Software
  30. ' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  31.  
  32. ' This class is utilized to draw "styled" cells
  33.  
  34. ' Different text-drawing flags
  35. Enum TextFormat
  36.     DT_WORDBREAK = &H10
  37.     DT_VCENTER = &H4
  38.     DT_TOP = &H0
  39.     DT_TABSTOP = &H80
  40.     DT_SINGLELINE = &H20
  41.     DT_RIGHT = &H2
  42.     DT_NOCLIP = &H100
  43.     DT_LEFT = &H0
  44.     DT_EXPANDTABS = &H40
  45.     DT_INTERNAL = &H1000
  46.     DT_EXTERNALLEADING = &H200
  47.     DT_CENTER = &H1
  48.     DT_BOTTOM = &H8
  49.     DT_CALCRECT = &H400
  50. End Enum
  51.  
  52. Enum BorderStyleTypes
  53.     Border_Solid = 0
  54.     Border_Dash = 1
  55.     Border_Dot = 2
  56.     Border_DashDot = 3
  57.     Border_DashDotDot = 4
  58.     Border_Transparent = 5
  59.     Border_InsideSolid = 6
  60. End Enum
  61.  
  62. ' The color of the background square
  63. Public BackColor As Long
  64.  
  65. ' The pictures to draw
  66. Public Pictures As New Collection
  67.  
  68. ' The color of the text
  69. Public ForeColor As Long
  70.  
  71. ' Internal spacing
  72. Public Padding As New clsRect
  73.  
  74. ' External spacing
  75. Public Margin As New clsRect
  76.  
  77. ' Border-colors (should contain a collection of rects)
  78. Public Borders As New Collection
  79.  
  80. ' The style and width of the borders
  81. Public BorderStyle As BorderStyleTypes
  82. Public BorderWidth As Long
  83.  
  84. ' Text-specific flags
  85. Public Format As TextFormat
  86.  
  87. ' XP-theme background
  88. Public Theme As New clsTheme
  89.  
  90. ' The current font
  91. Public Font As New StdFont
  92.  
  93. ' The main drawing procedure
  94. Public Sub DrawCell(refSurface As Object, Dimensions As clsRect, Text As String, Images As Collection)
  95.  
  96.     Dim TextArea As New clsRect, Tell As Long, Picture As clsPicture
  97.     
  98.     ' Initialize the area to draw the text
  99.     With TextArea
  100.         .Left = Dimensions.Left + Padding.Left
  101.         .Top = Dimensions.Top + Padding.Top
  102.         .Right = Dimensions.Right - Padding.Right
  103.         .Bottom = Dimensions.Bottom - Padding.Bottom
  104.     End With
  105.  
  106.     ' Draw the backcolor
  107.     refSurface.Line (Dimensions.Left, Dimensions.Top)-(Dimensions.Right, Dimensions.Bottom), BackColor, BF
  108.     
  109.     ' Draw the XP-style
  110.     Theme.DrawTheme refSurface.hWnd, refSurface.hDC, Dimensions
  111.     
  112.     ' Then draw all the pictures in the style, ...
  113.     For Each Picture In Pictures
  114.         Picture.DrawPicture refSurface, Dimensions.Left, Dimensions.Top
  115.     Next
  116.     
  117.     ' ... as well as the given images.
  118.     For Each Picture In Images
  119.         Picture.DrawPicture refSurface, Dimensions.Left, Dimensions.Top
  120.     Next
  121.     
  122.     ' Set the border-styles
  123.     refSurface.DrawStyle = BorderStyle
  124.     refSurface.DrawWidth = BorderWidth
  125.     
  126.     ' Draw the four borders
  127.     For Tell = 0 To Borders.Count - 1
  128.         DrawLine refSurface, Dimensions.Left + Tell, Dimensions.Top + Tell, Dimensions.Left + Tell, Dimensions.Bottom - Tell, Borders(Tell + 1).Left
  129.         DrawLine refSurface, Dimensions.Left + Tell, Dimensions.Bottom - Tell, Dimensions.Right - Tell, Dimensions.Bottom - Tell, Borders(Tell + 1).Bottom
  130.         DrawLine refSurface, Dimensions.Right - Tell, Dimensions.Bottom - Tell, Dimensions.Right - Tell, Dimensions.Top + Tell, Borders(Tell + 1).Right
  131.         DrawLine refSurface, Dimensions.Right - Tell, Dimensions.Top + Tell, Dimensions.Left + Tell, Dimensions.Top + Tell, Borders(Tell + 1).Top
  132.     Next
  133.     
  134.     ' Reset the border style
  135.     refSurface.DrawStyle = 0
  136.     refSurface.DrawWidth = 1
  137.     
  138.     ' Swap the font itself
  139.     Swap refSurface.Font, Font
  140.     
  141.     ' Use the current text color
  142.     refSurface.ForeColor = ForeColor
  143.     
  144.     ' Draw the given text
  145.     DrawText refSurface.hDC, Text, Len(Text), TextArea.UDT, Format
  146.     
  147.     ' Clean up
  148.     Swap refSurface.Font, Font
  149.  
  150. End Sub
  151.  
  152. Private Sub DrawLine(refSurface As PictureBox, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, Color As Long)
  153.     
  154.     ' Make sure the color is valid
  155.     If Color <> -1 Then
  156.         refSurface.Line (X1, Y1)-(X2, Y2), Color
  157.     End If
  158.  
  159. End Sub
  160.  
  161. Private Sub Swap(Var1 As Object, Var2 As Object)
  162.  
  163.     Dim Temp As Object
  164.     
  165.     ' Save the first object
  166.     Set Temp = Var1
  167.     
  168.     ' Swap the two variables
  169.     Set Var1 = Var2
  170.     Set Var2 = Temp
  171.     
  172. End Sub
  173.  
  174. Public Function Clone() As clsStyle
  175.  
  176.     Dim Border As clsRect
  177.  
  178.     ' Firstly, create a new class
  179.     Set Clone = New clsStyle
  180.     
  181.     ' Then, copy all the data
  182.     With Clone
  183.         .BackColor = Me.BackColor
  184.         .ForeColor = Me.ForeColor
  185.         .Font.Bold = Me.Font.Bold
  186.         .Font.Charset = Me.Font.Charset
  187.         .Font.Italic = Me.Font.Italic
  188.         .Font.Name = Me.Font.Name
  189.         .Font.Size = Me.Font.Size
  190.         .Font.Strikethrough = Me.Font.Strikethrough
  191.         .Font.Underline = Me.Font.Underline
  192.         .Font.Weight = Me.Font.Weight
  193.         .Format = Me.Format
  194.         
  195.         ' Copy rects
  196.         Set .Margin = Me.Margin.Clone
  197.         Set .Padding = Me.Padding.Clone
  198.         
  199.         ' Copy all the borders
  200.         For Each Border In Me.Borders
  201.             .Borders.Add Border.Clone
  202.         Next
  203.         
  204.         ' Copy the theme
  205.         Set .Theme = Theme.Clone
  206.     
  207.     End With
  208.  
  209. End Function
  210.  
  211. Private Sub Class_Initialize()
  212.  
  213.     ' Initialize the font
  214.     Font.Name = "MS Sans Serif"
  215.     Font.Size = 8
  216.     
  217.     ' Initialize border-width
  218.     BorderWidth = 1
  219.     
  220. End Sub
  221.