home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Basic / GridOne / setup.EXE / GRID.CLS < prev    next >
Encoding:
Visual Basic class definition  |  2001-09-09  |  7.1 KB  |  261 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 = "CGrid"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '-----------------------------------------------------------------------------
  15. ' This is a part of the BeeGrid ActiveX control.
  16. ' Copyright ⌐ 2000 Stinga
  17. ' All rights reserved.
  18. '
  19. ' You have a right to use and distribute the BeeGrid sample files in original
  20. ' form or modified, provided that you agree that Stinga has no warranty,
  21. ' obligations, or liability for any sample application files.
  22. '-----------------------------------------------------------------------------
  23. Option Explicit
  24.  
  25. Private mcolPageColumns As New Collection
  26. Private Const EASTEUROPE_CHARSET = 238
  27.  
  28. Private miGridScaleMode As Integer
  29. Private mGrid As SGGrid
  30.  
  31.  
  32. Private Declare Function OleTranslateColor Lib "oleaut32.dll" _
  33.    (ByVal lOleColor As Long, ByVal lHPalette As Long, _
  34.    lColorRef As Long) As Long
  35.  
  36. Private Enum EConversions
  37.     TwipsPerPoint = 20
  38.     TwipsPerCharX = 120
  39.     TwipsPerCharY = 240
  40.     TwipsPerInch = 1440
  41.     TwipsPerDecimeter = 5669
  42. End Enum
  43.  
  44. Private mhFontOld As Long
  45. Private mhFont As Long
  46.  
  47. Public Function GetColAlignment(col As SGColumn, _
  48.    Optional bHeader As Boolean = False) As Long
  49.    Dim lAlignment As sgAlignment
  50.    Dim bWordWrap As Boolean
  51.    
  52.    If bHeader Then
  53.       lAlignment = col.HeadingStyle.TextAlignment
  54.       bWordWrap = col.HeadingStyle.WordWrap
  55.    Else
  56.       lAlignment = col.Style.TextAlignment
  57.       bWordWrap = col.Style.WordWrap
  58.    End If
  59.    
  60.    Select Case lAlignment
  61.       Case sgAlignGeneral
  62.          Select Case col.DataType
  63.             Case sgtString
  64.                GetColAlignment = DT_LEFT + DT_TOP
  65.             Case Else
  66.                GetColAlignment = DT_RIGHT + DT_TOP
  67.          End Select
  68.       Case sgAlignLeftTop
  69.          GetColAlignment = DT_LEFT + DT_TOP
  70.       Case sgAlignRightTop
  71.          GetColAlignment = DT_RIGHT + DT_TOP
  72.       Case sgAlignCenterTop
  73.          GetColAlignment = DT_CENTER + DT_TOP
  74.       Case sgAlignLeftCenter
  75.          GetColAlignment = DT_LEFT + DT_VCENTER
  76.       Case sgAlignRightCenter
  77.          GetColAlignment = DT_RIGHT + DT_VCENTER
  78.       Case sgAlignCenterCenter
  79.          GetColAlignment = DT_CENTER + DT_VCENTER
  80.       Case sgAlignLeftBottom
  81.          GetColAlignment = DT_LEFT + DT_BOTTOM
  82.       Case sgAlignRightBottom
  83.          GetColAlignment = DT_RIGHT + DT_BOTTOM
  84.       Case sgAlignCenterBottom
  85.          GetColAlignment = DT_CENTER + DT_BOTTOM
  86.    End Select
  87.    
  88.    If bWordWrap Then
  89.       GetColAlignment = GetColAlignment + DT_WORDBREAK
  90.    Else
  91.       GetColAlignment = GetColAlignment + DT_SINGLELINE
  92.    End If
  93. End Function
  94.  
  95. Public Function AddPageColumns() As PageColumns
  96.    Dim pcs As New PageColumns
  97.    
  98.    mcolPageColumns.Add pcs
  99.    Set AddPageColumns = pcs
  100.    Set pcs = Nothing
  101. End Function
  102.  
  103. Public Sub ClearPageCols()
  104.    Set mcolPageColumns = Nothing
  105.    Set mcolPageColumns = New Collection
  106. End Sub
  107.  
  108. Public Property Get Columns(vntIndexKey As Variant) As PageColumns
  109.    Set Columns = mcolPageColumns(vntIndexKey)
  110. End Property
  111.  
  112.  
  113.  
  114. Public Function ConvertToPixelX() As Single
  115.    ConvertToPixelX = 1
  116.    
  117.    Select Case miGridScaleMode
  118.       Case 1
  119.          ConvertToPixelX = Screen.TwipsPerPixelX
  120.       Case 2
  121.       Case 3
  122.    End Select
  123. End Function
  124.  
  125. Public Sub DeleteFont(hdc As Long)
  126.    Call SelectObject(hdc, mhFontOld)
  127.    Call DeleteObject(mhFont)
  128. End Sub
  129.  
  130. Public Function CalculateWidth(lWidth As Long)
  131.    Select Case miGridScaleMode
  132.       Case 1
  133.          CalculateWidth = lWidth
  134.       Case 2
  135.       Case 3
  136.          CalculateWidth = lWidth * ConvertToPixelX
  137.    End Select
  138. End Function
  139.  
  140. Public Function GetPadding(col As SGColumn) As Long
  141.    GetPadding = col.Style.Padding
  142. End Function
  143.  
  144. Public Function ConvertToPixelY() As Single
  145.    ConvertToPixelY = 1
  146.    
  147.    Select Case miGridScaleMode
  148.       Case 1
  149.          ConvertToPixelY = Screen.TwipsPerPixelY
  150.       Case 2
  151.       Case 3
  152.    End Select
  153. End Function
  154.  
  155.  
  156. Public Function GetPictureAlignment(col As SGColumn) As Long
  157.    GetPictureAlignment = col.Style.PictureAlignment
  158. End Function
  159.  
  160. Friend Function GetStyleAppearance _
  161.    (sStyle As String, sytapp As sgStyleAppearance) As Boolean
  162.    
  163.    OleTranslateColor mGrid.Styles(sStyle).BackColor, 0, sytapp.BackColor
  164.    
  165.    sytapp.Flat = (mGrid.Styles(sStyle).Appearance = sgFlat)
  166.    
  167.    If sStyle = "Heading" Then
  168.       If sytapp.Flat Then
  169.          OleTranslateColor mGrid.HeadingGridLinesColor, 0, sytapp.BorderColor
  170.       Else
  171.          sytapp.BorderColor = GetSysColor(COLOR_BTNSHADOW)
  172.          sytapp.BorderHighlight = GetSysColor(COLOR_BTNHIGHLIGHT)
  173.       End If
  174.       sytapp.GridLines = Not (mGrid.HeadingGridLines = sgGridLineNone)
  175.    ElseIf sStyle = "Normal" Then
  176.       OleTranslateColor mGrid.GridLinesColor, 0, sytapp.BorderColor
  177.       sytapp.GridLines = Not (mGrid.GridLines = sgGridLineNone)
  178.    End If
  179. End Function
  180.  
  181.  
  182. Public Function SetFontFromStyle(dvc As ISGDevice, sStyle As String) As Long
  183.    Dim i%, byLett As Byte
  184.    Dim clsFont As StdFont
  185.    Dim lColor As Long
  186.    Dim plf As LOGFONT
  187.    
  188.    Set clsFont = mGrid.Styles(sStyle).Font
  189.    
  190.    For i = 0 To 32
  191.       plf.lfFaceName(i) = 0
  192.    Next
  193.    
  194.    For i = 0 To Len(clsFont.Name) - 1
  195.       byLett = Asc(Mid$(clsFont.Name, i + 1, 1))
  196.       plf.lfFaceName(i) = byLett
  197.    Next
  198.    '1 point=20 twips
  199.    plf.lfHeight = (clsFont.Size * 20) / dvc.TwipsPerPixelY
  200.  
  201.    plf.lfWeight = IIf(clsFont.Bold, 800, 400)
  202.    plf.lfItalic = IIf(clsFont.Italic, 1, 0)
  203.    plf.lfUnderline = IIf(clsFont.Underline, 1, 0)
  204.    plf.lfStrikeOut = IIf(clsFont.Strikethrough, 1, 0)
  205.    
  206.    plf.lfCharSet = EASTEUROPE_CHARSET
  207.    
  208.    OleTranslateColor mGrid.Styles(sStyle).ForeColor, 0, lColor
  209.    
  210.    mhFont = CreateFontIndirect(plf)
  211.    
  212.    SetBkMode dvc.hdc, TRANSPARENT
  213.    SetTextColor dvc.hdc, lColor
  214.    mhFontOld = SelectObject(dvc.hdc, mhFont)
  215.    SetFontFromStyle = mhFont
  216. End Function
  217.  
  218. Public Function CalculateHeight(ByVal lHeight As Long) As Long
  219.    Select Case miGridScaleMode
  220.       Case 1
  221.          CalculateHeight = lHeight
  222.       Case 2
  223.       Case 3
  224.          CalculateHeight = lHeight * ConvertToPixelY
  225.    End Select
  226. End Function
  227.  
  228. Private Sub Class_Terminate()
  229.    Set mcolPageColumns = Nothing
  230.    Set mGrid = Nothing
  231. End Sub
  232.  
  233. Public Property Get Grid() As SGGrid
  234.    Set Grid = mGrid
  235. End Property
  236.  
  237. Public Property Set Grid(ByVal vNewValue As SGGrid)
  238.    Set mGrid = vNewValue
  239.    SetScaleMode
  240. End Property
  241.  
  242. Friend Function GetPageColumns(lPage As Long) As PageColumns
  243.    Dim iCurrCols As Integer
  244.  
  245.    iCurrCols = (lPage - 1) Mod mcolPageColumns.Count
  246.    Set GetPageColumns = mcolPageColumns(iCurrCols + 1)
  247. End Function
  248.  
  249. Private Sub SetScaleMode()
  250.    
  251.    On Error Resume Next
  252.  
  253.    Err = 0
  254.       
  255.    miGridScaleMode = mGrid.Parent.ScaleMode
  256.    
  257.    If Err <> 0 Then miGridScaleMode = 3
  258.       
  259. End Sub
  260.  
  261.