aqui otra forma de crear PDF desde ASP

[lexus]

Código:

  Class PDFObject
	 Public default Property Get ClassName() 'As FontStyles
	  ClassName = "PDFObject"
	 End Property
	 Dim m_resources 'As String
	 Public m_fonts 'As Scripting.Dictionary
	 Private m_streams 'As Scripting.Dictionary
	 Public PageBreak 'As Boolean
	 Private Sub Class_Initialize()
	 Set m_fonts = CreateObject("Scripting.Dictionary")
	 Set m_streams = CreateObject("Scripting.Dictionary")
	 End Sub
	 Public Sub addStream(ByVal stream)
	 m_streams.Add stream, ""
	 End Sub
	 Public function FontExists(ByVal Font) 'As Boolean
	 Dim FontObj 'As String
	 ' FontExists = False
	 For Each FontObj In m_fonts
	 if FontObj = Font Then
	 ' FontExists = True
	 FontExists = True
	 End if
	 Next
	 FontExists = False
	 End function
	 Public function GetStream() 'As String
	 Dim sItem
	 For Each sItem In m_streams
	 GetStream = sItem
	 m_streams.Remove sItem
	 Exit function
	 Next
	 End function
	 Public function count() 'As Integer
	 count = m_streams.count
	 End function
	 Public Property Get Resources() 'As String
	 Resources = m_resources
	 End Property
	 Public Property Let Resources(ByVal Value)
	 m_resources = Value
	 End Property
	End Class
	'===================
	Class Row
	 Public default Property Get ClassName() 'As FontStyles
	  ClassName = "Row"
	 End Property
	 Private m_cells 'As Scripting.Dictionary
	 Private m_Height 'As Integer
	 Private Sub Class_Initialize()
	  Set m_cells = CreateObject("Scripting.Dictionary")
	 End Sub
	 Public Sub AddCell(ByVal myCell)
	  Dim aCell 'As cell
	  Set aCell = myCell.GetCopy
	  m_cells.Add aCell, ""
	 End Sub
	  Property Get HeightInPDFunits()
	  HeightInPDFunits = m_Height
	 End Property
	  Property Get cells() 'As Scripting.Dictionary
	  Set cells = m_cells
	 End Property
	 function CalculateHeight(ByVal width, ByVal cellpadding)
	  Dim cell 'As cell
	  Dim H 'As Integer
	  Dim w 'As Integer' Printable width
	  m_Height = 0
	  width = width / m_cells.count
	  w = width - 2 * cellpadding
	  For Each cell In m_cells
	  H = cell.CalculateHeight(w)
	  if H > m_Height Then
	 m_Height = H
	  End if
	  Next
	  m_Height = m_Height + 2 * cellpadding
	  CalculateHeight = m_Height
	 End function
	End Class
	'===================
	Class Table
	 Public default Property Get ClassName() 'As FontStyles
	  ClassName = "Table"
	 End Property
	 Private m_border 'As Borders
	 Private m_rows 'As Scripting.Dictionary
	 Private m_Height 'As Integer
	 Public CellPaddingInPDFUnits 'As Integer
	 Private m_ColumnWidth 'As Integer' PDF measurement
	 Private m_cellCount 'As Integer
	 Private m_ActualHeight 'As Integer
	 Private m_startH 'As Integer
	 Private m_StartV 'As Integer
	 Private Sub Class_Initialize()
	  Set m_rows = CreateObject("Scripting.Dictionary")
	  m_border = Borders_thick
	  CellPaddingInPDFUnits = 4
	 End Sub
	 function GetCopy()
	 End function
	 Public Property Get StartPDFH() 'As Integer
	  StartPDFH = m_startH
	 End Property
	 Public Property Let StartPDFH(ByVal MyStartInPDFUnits)
	  m_startH = MyStartInPDFUnits
	 End Property
	 Public function Draw(ByRef StartV, ByVal width, ByRef FontAlias, _
	  ByRef pagenum, ByVal TopMargin) 'As PDFObject
	  Dim pdfObj 'As PDFObject
	  Dim row 'As row
	  Dim count 'As Integer
	  Dim TotalCols 'As Integer
	  Dim stream 'As String' Text Stream
	  Dim GStream 'As String' graphics stream
	  Dim cell 'As cell
	  Dim RightH 'As Integer
	  Dim V 'As Integer
	  Dim H 'As Integer
	  Dim RowStartV 'As Integer
	  Dim cols 'As Integer
	  Dim c 'As Integer
	  Dim accumColumn 'As Integer
	  Dim RowStarty 'As Integer
	  Set pdfObj = New PDFObject
	  Call CalculateTable(width)
	  ' Save start point
	  m_StartV = StartV
	  if m_border <> Borders_none Then
	  stream = "0.0 G " + vbCr ' Black color
	  if m_border = Borders_thick Then
	 stream = "2 w " + vbCr ' Line width
	  Else
	 stream = "1 w " + vbCr ' Line width
	  End if
	  RightH = m_startH + width
	  ' Top level line of the table
	  stream = stream + line(m_startH, StartV, RightH, StartV)
	  For Each row In m_rows
	 ' Print first vertical bar For Each cell
	 V = StartV - row.HeightInPDFunits
	 stream = stream + line(m_startH, StartV, m_startH, V)
	 ' Print right vertical bar For Each cell
	 cols = 0
	 c = 1
	 accumColumn = 0
	 For Each cell In row.cells
	 cols = cols + cell.ColumnSpan
	 if c = row.cells.count Then
	  H = RightH
	 Else
	  if cell.WidthInPercent = 0 Then
	  H = m_startH + cols * m_ColumnWidth
	  Else
	  accumColumn = accumColumn + cell.WidthInPercent * width
	  H = m_startH + accumColumn
	  End if
	 End if
	 V = StartV - row.HeightInPDFunits
	 if V < 1 Then Exit For
	 stream = stream + line(H, StartV, H, V)
	 c = c + 1
	 Next
	 ' Print row divider
	 StartV = StartV - row.HeightInPDFunits
	 stream = stream + line(m_startH, StartV, RightH, StartV)
	  Next
	  End if
	  ' Print text in cells
	  V = m_StartV
	  For Each row In m_rows
	  H = m_startH
	  For Each cell In row.cells
	 cell.StartPDFH = H + CellPaddingInPDFUnits
	 cell.StartPDFV = V
	 Set pdfObj = cell.Draw(FontAlias, 1, TopMargin)
	 stream = stream + pdfObj.getStream
	 if cell.WidthInPercent = 0 Then
	 H = H + cell.ColumnSpan * m_ColumnWidth
	 Else
	 H = H + width * cell.WidthInPercent
	 End if
	  Next
	  V = V - row.HeightInPDFunits
	  if V < 1 Then Exit For
	  Next
	  pdfObj.addStream (stream)
	  Set Draw = pdfObj
	 End function
	 Sub CalculateTable(ByVal width)
	  Dim row 'As row
	  m_ActualHeight = 0
	  ' Calculate table width
	  if width = 0 Then
	  Err.Raise 100,"","Zero Width table Not supported."
	  End if
	  ' Check To see that we have a column count
	  if m_rows.count < 1 Then
	  Err.Raise 100,"","No Rows To draw."
	  End if
	  m_cellCount = CalculateCellCount()
	  ' Column width when all columns have the same width
	  m_ColumnWidth = (width - 2 * m_border) / m_cellCount
	  ' Calculate
	  For Each row In m_rows
	  row.CalculateHeight m_ColumnWidth, CellPaddingInPDFUnits
	  m_ActualHeight = m_ActualHeight + row.HeightInPDFunits + 2 * m_border
	  Next
	  m_ActualHeight = m_ActualHeight + 2 * m_border
	 End Sub
	 Public Sub setColumnWidth(ByVal width)
	  ' This method sets the width of the table columns
	  ' Columns are from index 1 To the upper bound of width(). With(0) is Not used.
	  ' Each entry In the input array becomes a percentage of the sum of all entries in the input array
	  Dim row 'As row
	  Dim cell 'As cell
	  Dim totalWidth 'As Integer
	  Dim i 'As Integer
	  Dim cols 'As Integer
	  if m_rows.count < 1 Then
	  Err.Raise 100,"","No rows."
	  End if
	  m_cellCount = CalculateCellCount()
	  if m_cellCount <> UBound(width) Then
	  Err.Raise 100,"","Number of columns doesn't match the setting For column width."
	  End if
	  For i = 1 To UBound(width)
	  totalWidth = totalWidth + width(i) ' Calculate the total
	  Next
	  if totalWidth <= 0 Then
	  Err.Raise 100,"","Can't Set column width on table."
	  End if
	  For Each row In m_rows
	  cols = 0
	  For Each cell In row.cells
	 cols = cols + cell.ColumnSpan
	 cell.WidthInPercent = Math.Round(width(cols) / totalWidth, 2) ' Percent
	  Next
	  Next
	 End Sub
	 Private function CalculateCellCount() 'As Integer
	  Dim scellCnt 'As Integer
	  Dim cellCnt 'As Integer
	  Dim row 'As row
	  Dim cell 'As cell
	  For Each row In m_rows
	  cellCnt = 0
	  For Each cell In row.cells
	 cellCnt = cellCnt + cell.ColumnSpan
	  Next
	  if scellCnt <> 0 And scellCnt <> cellCnt Then
	 Err.Raise 100,"","Uneven number of cells With column span In the row collection."
	  End if
	  scellCnt = cellCnt
	  Next
	  if cellCnt = 0 Then
	  Err.Raise 100,"","No columns/cells."
	  End if
	  CalculateCellCount = cellCnt
	 End function
	 Private function line(ByVal x, ByVal y, ByVal x1, ByVal y1) 'As String
	  Dim stream 'As String
	  stream = stream & x & " " & y & " m" + vbCr
	  stream = stream & x1 & " " & y1 & " l" + vbCr
	  stream = stream & "S" + vbCr
	  line = stream
	 End function
	 Public Property Get Border() 'As Borders
	  Border = m_border
	 End Property
	 Public Property Let Border(ByVal myBorder)
	  Select Case myBorder
	  Case Borders_none
	 m_border = myBorder
	  Case Borders_thick
	 m_border = myBorder
	  Case Borders_thin
	 m_border = myBorder
	  Case Else
	 Err.Raise 100,"","Invalid Border"
	  End Select
	 End Property
	 Public Sub AddRow(ByVal myRow)
	  m_rows.Add myRow, ""
	 End Sub
	 Public function toString() 'As String
	  toString = "Table rows: " & m_rows.count
	 End function
	End Class
	'===================