home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Print_and_2066795212007.psc / clsLynxPrint.cls < prev    next >
Text File  |  2007-05-21  |  9KB  |  248 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 = "clsLynxPrint"
  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. 'printing portions modified from Hawke's "Print preview using xml"
  17. 'html generation modified from Eoin Armstrong's "MSFlexgrid to HTML"
  18. 'To use with another grid simply modify the GridToArray Procedure
  19.  
  20. Public Enum PrintPrompt
  21.     PrintPreview = 0
  22.     StraightToPrinter = 1
  23. End Enum
  24.  
  25. Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  26. Private Declare Function CoCreateGuid Lib "ole32" (id As Any) As Long
  27.  
  28. Private Const navNoHistory As Integer = 2
  29. Private Const navNoWriteToCache As Integer = 8
  30. Private m_TempPath As String
  31. Private m_Title As String
  32. Private HeaderArray() As String
  33. Private BodyArray() As String
  34. Private m_VisibleColumnsOnly As Boolean
  35.  
  36. Public Sub PrintLynxGrid(LynxGrid1 As LynxGrid, _
  37.                          WebPreview As WebBrowser, _
  38.                          PreviewType As PrintPrompt)
  39.  
  40.     m_TempPath = GetTempDirectory & CreateGUID & ".html"
  41.     GridToArray LynxGrid1, m_VisibleColumnsOnly
  42.     ArraysToHTML
  43.     ProcessPrinting WebPreview, PreviewType
  44.  
  45. End Sub
  46.  
  47. Public Property Let DocTitle(strTitle As String)
  48.     m_Title = strTitle
  49. End Property
  50.  
  51. Public Property Get DocTitle() As String
  52.     DocTitle = m_Title
  53. End Property
  54.  
  55. Private Sub ArraysToHTML()
  56.  
  57. Dim strm As TextStream
  58. Dim lnRowCounter As Long
  59. Dim lnColCounter As Long
  60. Dim fso As New FileSystemObject
  61.     
  62.     Set strm = fso.CreateTextFile(m_TempPath, True)
  63.     strm.Write ("<html><head>" & vbNewLine)
  64.     
  65.     strm.Write ("<title>" & m_Title & "</title>" & vbNewLine)
  66.     strm.Write ("<table border=" & Chr(34) & "1" & Chr(34) & ">" & vbNewLine)
  67.     strm.Write ("<tr>" & vbNewLine)
  68.     
  69.     'write column headings
  70.     For lnColCounter = 0 To UBound(HeaderArray)
  71.         strm.Write ("   <td align=" & Chr(34) & "center" & Chr(34) & " bgcolor=" & Chr(34) & "#999999" & Chr(34) & "><b>  " & HeaderArray(lnColCounter) & "  </b></td>" & vbNewLine)
  72.     Next lnColCounter
  73.     strm.Write ("</tr>" & vbNewLine)
  74.     
  75.     'write body
  76.     For lnRowCounter = 0 To UBound(BodyArray, 2)
  77.         strm.Write ("<tr>" & vbNewLine)
  78.         For lnColCounter = 0 To UBound(BodyArray, 1)
  79.             strm.Write ("   <td align=" & Chr(34) & "left" & Chr(34) & " bgcolor=" & Chr(34) & "#999999" & Chr(34) & ">  " & BodyArray(lnColCounter, lnRowCounter) & "  </td>" & vbNewLine)
  80.         Next lnColCounter
  81.         strm.Write ("</tr>" & vbNewLine)
  82.     Next lnRowCounter
  83.     
  84.     'closing off tags
  85.     strm.Write ("</table></head></html>")
  86.  
  87. End Sub
  88.  
  89. Private Sub GridToArray(LynxGrid1 As LynxGrid, _
  90.                         VisibleColumnsOnly As Boolean)
  91.  
  92. Dim lnRowCounter As Long
  93. Dim lnColCounter As Long
  94. Dim numVisibleCols As Long
  95. Dim currCol As Long
  96.  
  97.     With LynxGrid1
  98.         'get number of columns for Array Size
  99.         For lnColCounter = 0 To .Cols
  100.             'visible?
  101.             If (.ColVisible(lnColCounter) And .ColWidth(lnColCounter) > 0) Or Not VisibleColumnsOnly Then
  102.                 numVisibleCols = numVisibleCols + 1
  103.             End If
  104.         Next lnColCounter
  105.         ReDim HeaderArray(numVisibleCols - 1)
  106.         ReDim BodyArray(numVisibleCols - 1, 0)
  107.         'start headings section -----------
  108.         For lnColCounter = 0 To .Cols
  109.             'visible?
  110.             If (.ColVisible(lnColCounter) And .ColWidth(lnColCounter) > 0) Or Not VisibleColumnsOnly Then
  111.                 HeaderArray(currCol) = .ColHeading(lnColCounter) & ""
  112.                 currCol = currCol + 1
  113.             End If
  114.         Next lnColCounter
  115.         'end headings section -------------
  116.         
  117.         'start body section ----------
  118.         For lnRowCounter = 0 To .ItemCount - 1
  119.             currCol = 0
  120.             For lnColCounter = 0 To .Cols
  121.                 'visible?
  122.                 If (.ColVisible(lnColCounter) And .ColWidth(lnColCounter) > 0) Or Not VisibleColumnsOnly Then
  123.                     BodyArray(currCol, UBound(BodyArray, 2)) = .CellText(lnRowCounter, lnColCounter) & ""
  124.                     currCol = currCol + 1
  125.                 End If
  126.             Next lnColCounter
  127.             ReDim Preserve BodyArray(UBound(BodyArray, 1), UBound(BodyArray, 2) + 1)
  128.         Next lnRowCounter
  129.         ReDim Preserve BodyArray(UBound(BodyArray, 1), UBound(BodyArray, 2) - 1)
  130.         'end body section -----------
  131.     End With
  132.  
  133. End Sub
  134.  
  135. Private Sub ProcessPrinting(WebPreview As WebBrowser, PreviewType As PrintPrompt)
  136.  
  137.     With WebPreview
  138.         .Visible = True
  139.         'navigate to page
  140.         .Navigate2 m_TempPath, navNoHistory & navNoWriteToCache
  141.         'loop until page is finished loading
  142.         While .ReadyState <> READYSTATE_COMPLETE
  143.             DoEvents
  144.         Wend
  145.         'print
  146.         If PreviewType = PrintPreview Then
  147.             .ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, 0, 0
  148.         ElseIf PreviewType = StraightToPrinter Then
  149.             .ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, 0, 0
  150.         End If
  151.         .Visible = False
  152.     End With
  153.  
  154. End Sub
  155.  
  156. Private Function CreateGUID() As String
  157.  
  158.     Dim bytID(0 To 15) As Byte
  159.     Dim lngCount As Long
  160.     
  161.     If CoCreateGuid(bytID(0)) = 0 Then
  162.         For lngCount = 0 To 15
  163.             CreateGUID = CreateGUID + IIf(bytID(lngCount) < 16, "0", "") + Hex$(bytID(lngCount))
  164.         Next
  165.         
  166.         CreateGUID = Left$(CreateGUID, 8) + "-" + Mid$(CreateGUID, 9, 4) + "-" + Mid$(CreateGUID, 13, 4) + "-" + Mid$(CreateGUID, 17, 4) + "-" + Right$(CreateGUID, 12)
  167.     End If
  168.     
  169. End Function
  170.  
  171. Private Function GetTempDirectory() As String
  172.     
  173.     Dim strTemp As String
  174.     Dim strUserName As String
  175.         
  176.     strTemp = String(100, Chr$(0))  'Create a buffer
  177.     GetTempPath 100, strTemp
  178.     strTemp = Trim(Left$(strTemp, InStr(strTemp, Chr$(0)) - 1))
  179.     
  180.     If Right(strTemp, 1) <> "\" Then strTemp = strTemp & "\"
  181.     GetTempDirectory = strTemp
  182.     
  183. End Function
  184.  
  185. Public Sub LynxGridExportToCSV(LynxGrid1 As LynxGrid, _
  186.                                filePath As String, _
  187.                                Optional strHeader As String = vbNullString, _
  188.                                Optional exportColHeaders As Boolean = True, _
  189.                                Optional VisibleColumnsOnly As Boolean = True)
  190.  
  191. Dim strm         As TextStream
  192. Dim lnRowCounter As Long
  193. Dim lnColCounter As Long
  194. Dim fso          As New FileSystemObject
  195. Dim firstColHit As Boolean
  196.  
  197.     GridToArray LynxGrid1, VisibleColumnsOnly
  198.     
  199.     Set strm = fso.CreateTextFile(filePath, True)
  200.     With LynxGrid1
  201.         'start document heading section ---------
  202.         If LenB(strHeader) <> 0 Then
  203.             strm.Write (Chr(34) & strHeader & Chr(34))
  204.             strm.Write (vbNewLine)
  205.         End If
  206.         'end document heading section ---------
  207.         
  208.         'start headings section -----------
  209.         If exportColHeaders Then
  210.             For lnColCounter = 0 To UBound(HeaderArray)
  211.                 If firstColHit Then
  212.                     strm.Write (",")
  213.                 End If
  214.                 'write
  215.                 strm.Write (Chr(34) & HeaderArray(lnColCounter) & "") & Chr(34)
  216.                 firstColHit = True
  217.             Next lnColCounter
  218.             strm.Write (vbNewLine)
  219.         End If
  220.         'end headings section -------------
  221.         
  222.         'start body section ----------
  223.         For lnRowCounter = 0 To UBound(BodyArray, 2)
  224.             firstColHit = False
  225.             For lnColCounter = 0 To UBound(BodyArray, 1)
  226.                 If firstColHit Then
  227.                     strm.Write (",")
  228.                 End If
  229.                 'write
  230.                 strm.Write (Chr(34) & BodyArray(lnColCounter, lnRowCounter) & "") & Chr(34)
  231.                 firstColHit = True
  232.             Next lnColCounter
  233.             strm.Write (vbNewLine)
  234.         Next lnRowCounter
  235.         'end body section -----------
  236.     End With
  237.  
  238. End Sub
  239.  
  240. Private Sub Class_Terminate()
  241.  
  242.     'delete file after finished
  243.     If LenB(m_TempPath) <> 0 Then
  244.         Kill m_TempPath
  245.     End If
  246.  
  247. End Sub
  248.