El post que buscas se encuentra eliminado, pero este también te puede interesar

Manipulacion y Creacion de PDF VB.NET 2 Parte


Este codigo manipula el formato PDF esta testeado en VB.NET 2010
La clase es esta:



Imports System.Collections.Specialized
Imports System.Text

Public Class clsPdfWriter
#Region "Enums"
Public Enum pdfPaperSize
'-- American paper sizes
pdfLetter = 0
pdfLegal = 1
pdfLedger = 2
pdfTabloid = 3
pdfExecutive = 4
'-- ISO A paper sizes
pdfA0 = 5
pdfA1 = 6
pdfA2 = 7
pdfA3 = 8
pdfA4 = 9
pdfA5 = 10
pdfA6 = 11
pdfA7 = 12
'-- Add more paper size if you need them here.
End Enum

Public Enum pdfTextAlign
pdfAlignLeft = 0
pdfAlignRight = 1
pdfCenter = 2
End Enum

Public Enum pdfStandardFonts
'-- These fonts, or their font metrics and suitable substitution fonts,
'-- must be available to the consumer application.
Times_Roman = 1
Times_Bold = 2
Times_Italic = 3
Times_BoldItalic = 4
Helvetica = 5
Helvetica_Bold = 6
Helvetica_Oblique = 7
Helvetica_BoldOblique = 8
Courier = 9
Courier_Bold = 10
Courier_Oblique = 11
Courier_BoldOblique = 12
Symbol = 13
ZapfDingbats = 14
End Enum

Public Enum pdfTrueTypeFonts
TT_Times_Roman = 1
TT_Times_Bold = 2
TT_Times_Italic = 3
TT_Times_BoldItalic = 4
TT_Arial = 5
TT_Arial_Bold = 6
TT_Arial_Italic = 7
TT_Arial_BoldItalic = 8
TT_CourierNew = 9
TT_CourierNewBold = 10
TT_CourierNewItalic = 11
TT_CourierNewBoldItalic = 12
TT_Symbol = 13
TT_SymbolBold = 14
TT_SymbolItalic = 15
TT_SymbolBoldItalic = 16
End Enum

Private Enum pdfColorSpace
'-- Some color spaces are related to device color representation (grayscale, RGB, CMYK)
pdfRGB = 0
pdfGrayScale = 1
End Enum

#End Region

#Region "Structure"
Private Structure FontDescriptor
Dim BaseFont As String
Dim FirstChar As String
Dim LastChar As String
Dim Parameters As String
Dim Widths As String
Dim MissingWidth As String
End Structure

Private Structure ImageDictionary
Dim ImgDicWidth As Long
Dim ImgDicHeight As Long
Dim ImgDicColorSpace As String
Dim ImgDicBitsPerComponent As Long
Dim ImgDicFilter As String
Dim ImgDicDataStream As Object
Dim ImgDicDots As String
Dim ImgDicFileSize As Long
End Structure
#End Region

#Region "Private Variables"

'-- I want to be able to keep up with each object and it offset using collection.
'-- This will be a name value pair Example "1 obj" 08
Private colCrossReferenceTable As New NameValueCollection
Private colFonts As New NameValueCollection
Private colPageText As New NameValueCollection
Private colLineCode As New NameValueCollection
Private colCircles As New NameValueCollection
Private colDrawImages As New NameValueCollection
Private colXobjectImages As New NameValueCollection
Public colImages As New NameValueCollection
'-- Keep up with the fonts used in the program.
Private dicFontsUsed As New Dictionary(Of String, Integer)

Private FileText As New StringBuilder
Private intpdfObjectCount As Integer = 0
Private intFontCount As Integer = 0
Private intStreamLength As Integer = 0
'-- Information Dictionary members
Private _pdfTitle As String = ""
Private _pdfAuthor As String = ""
Private _pdfSubject As String = ""
Private _pdfKeyWords As String = ""
Private _pdfCreator As String = ""
Private _pdfProducer As String = ""
Private _pdfPageCount As Integer = 1
Private _pdfCommentFile As Boolean = False
'-- Use to create the size of paper to draw upon
Private mvarPaperSize As pdfPaperSize
Private intPageWidth As Integer = 612 '-- Default Size
Private intPageHeight As Integer = 864 '-- Default Size
Private intPageTree As Integer '-- Keeps up with our page tree
Private intPageCount As Integer '-- Keeps up with our page number
Private intStringCount As Integer '-- Keep up with string on pages
Private intLineCount As Integer '-- Keep up with the lines in the file/page
Private intCircleCount As Integer '-- Keep up with the Circles in the file/page
Private intDrawImagesCount As Integer '-- Keep up with the Draw Images in the file/page
Private intXObjectCount As Integer '-- Keep up with the XObject in the file
Private intFontDescriptorCount As Integer '-- Keep up with Font Descriptors
'-- Used for our Jpeg files only.
Private strImageJPEG As New ImageDictionary

#End Region


If colImages.Item(intCount).ToString.ToUpper.EndsWith("JPG" Or colImages.Item(intCount).ToString.ToUpper.EndsWith("JPEG" = True Then
'-- Load up any Jpeg Images in the Collection
FileText.Append(LoadImgFromJPEGFile(colImages.GetKey(intCount).ToString, colImages.Item(intCount).ToString))
End If
Next

FileText.Append(rootCatalog)
FileText.Append(OutLines)
FileText.Append(PageTree)
FileText.Append(Resources)

'-- Need to call page for every page of the count
For intCounter = 1 To _pdfPageCount
FileText.Append(Page)
FileText.Append(ContentStream)
FileText.Append(StreamLengthObj)
Next


'-- Need to know where the reffence table starts
Dim intCrossRefOffSet As Integer
'-- The next entry is the cross reffence table so add one to the lenght of the string
'-- to point to the cross reffence table start point.
intCrossRefOffSet = FileText.Length + 1
'-- Now build or cross reffernce table
FileText.Append(buildCrossReffenceTable)
FileText.Append(FileTrailer(intCrossRefOffSet))

'-- Save the file to disk. New Code...
'My.Computer.FileSystem.WriteAllText(strFilePath, FileText.ToString, False)

'-- This old code will work but the new code does not. I found the problem but not the answer to it.
'-- When writing the image data the (My.Computer.FileSystem.WriteAllText) changes the Hex value of Null(00) to Space(20)
'-- which in turn corrupt the image file. Until I find a solution I must use old vb6 code.

Dim intFileNumber As Integer = 0
'-- FreeFile Returns an Integer representing the next file number available for use by the Open statement
intFileNumber = FreeFile()
'-- You must open a file before any I/O operation can be performed on it.
FileOpen(intFileNumber, strFilePath, OpenMode.Output)
'-- All data written to the file using Print is internationally aware;
'-- that is, the data is properly formatted using the appropriate decimal separator.
'-- If the user wishes to output data for use by multiple locales, then Write should be used.
'-- MSDN describes the Print method as follows so I should be able to find new version once I get the program working.
'-- Public Sub Print( ByVal FileNumber As Integer, ByVal ParamArray Output() As Object )
Print(intFileNumber, FileText.ToString)
'-- Just close the file and save it to disk.
FileClose(intFileNumber)


End Sub

Public Sub ShowingText(ByVal intPage As Integer, ByVal sngHorzOffSet As Single, ByVal sngVertOffSet As Single, ByVal strTextToShow As String, ByRef FontName As pdfStandardFonts, ByVal Fontsize As Single, ByVal Color As System.Drawing.Color, Optional ByVal Align As pdfTextAlign = pdfTextAlign.pdfAlignLeft, Optional ByVal Rotate As Integer = 0)
'-- Ok I want to add any text for a page to the collection for that page.

Select Case Align
Case pdfTextAlign.pdfAlignLeft
'-- The default showing.
Case pdfTextAlign.pdfAlignRight
sngHorzOffSet = intPageWidth - (sngHorzOffSet + (strTextToShow.Length * Fontsize))
Case pdfTextAlign.pdfCenter
sngHorzOffSet = intPageWidth / 2 + sngHorzOffSet
End Select

'-- Keep Up with our fonts that are used in the program
'-- Test if the Font key exists, and then add it if it doesn't.
If Not dicFontsUsed.ContainsKey("pdfStandardFonts." + FontName.ToString) Then
intFontCount += 1
dicFontsUsed.Add("pdfStandardFonts." + FontName.ToString, intFontCount)
End If


Dim strCodeText As String = ""

'-- rg- Set RGB color for nonstroking operations
strCodeText += Color.R.ToString & " " & Color.G.ToString & " " & Color.B.ToString & " rg" + vbCrLf

'-- BT- Begin text object
strCodeText += "BT" + vbCrLf
'-- Tf - Set text font and size
strCodeText += "/F" + dicFontsUsed.Item("pdfStandardFonts." + FontName.ToString).ToString + " " + Fontsize.ToString + " Tf" + vbCrLf
'-- Now do we need to rotate it
If Rotate <> 0 Then
'-- System.Math.Sin and System.Math.Cos is in radians. we need to convert to degrees
Dim dblDegrees As Double = System.Math.PI / 180
'-- Little Math reminder long time ago since I study math 30plus years
'-- There is 360 degrees in a circle and we will pivot around the start point of the text.
'-- The ratio of the height to the hypotenuse is called the sine
Dim sngSinAngle As Single = System.Math.Sin(dblDegrees * Rotate)
'-- The ratio of the base to the hypotenuse is called the cosine
Dim sngCosAngle As Single = System.Math.Cos(dblDegrees * Rotate)
Dim fmt As String = "000.###"
'-- Tm- Set text matrix and text line matrix
'-- Using the + operator caused a error in compiler so had to go back to VB6 style string concatenation to get over exception.
strCodeText += sngCosAngle.ToString(fmt) & " " & sngSinAngle.ToString(fmt) & " " & -sngSinAngle.ToString(fmt) & " " & sngCosAngle.ToString(fmt) & " " & sngHorzOffSet.ToString & " " & sngVertOffSet.ToString & " Tm" & vbCrLf
Else
'--
'-- Where to place the string on the page Td- Move text position
strCodeText += sngHorzOffSet.ToString + " " + sngVertOffSet.ToString + " Td" + vbCrLf
End If


'-- Text to display on page
strCodeText += "(" + CheckReserveChar(strTextToShow) + " Tj" + vbCrLf


'-- End the Text block
strCodeText += "ET" + vbCrLf
'-- Need to keep keys unique
intStringCount += 1
colPageText.Add(intPage.ToString + "." + intStringCount.ToString, strCodeText)
End Sub

Public Sub ShowingText(ByVal intPage As Integer, ByVal sngHorzOffSet As Single, ByVal sngVertOffSet As Single, ByVal strTextToShow As String, ByRef FontName As pdfTrueTypeFonts, ByVal FontSize As Single, ByVal Color As System.Drawing.Color, Optional ByVal Align As pdfTextAlign = pdfTextAlign.pdfAlignLeft, Optional ByVal Rotate As Integer = 0)
'-- Need to update the alignment when I wake up. with the code from old file.
Select Case Align
Case pdfTextAlign.pdfAlignLeft
'-- The default showing.
Case pdfTextAlign.pdfAlignRight
Dim sngLength As Single
sngLength = TT_StringLength(strTextToShow, FontName.ToString, FontSize)
sngHorzOffSet = intPageWidth - (sngLength + sngHorzOffSet)

Case pdfTextAlign.pdfCenter

Dim sngLength As Single
sngLength = TT_StringLength(strTextToShow, FontName.ToString, FontSize)
'-- When Center forget about the offset to make the text center
'-- This could be overloaded to allow center plus offset
sngHorzOffSet = ((intPageWidth / 2) - (sngLength / 2)) '+ sngHorzOffSet
End Select
'-- Keep Up with our fonts that are used in the program
'-- Test if the Font key exists, and then add it if it doesn't.
If Not dicFontsUsed.ContainsKey("pdfTrueTypeFonts." + FontName.ToString) Then
intFontCount += 1
dicFontsUsed.Add("pdfTrueTypeFonts." + FontName.ToString, intFontCount)
End If
Dim strCodeText As String = ""

'-- rg- Set RGB color for nonstroking operations
strCodeText += Color.R.ToString & " " & Color.G.ToString & " " & Color.B.ToString & " rg" + vbCrLf

'-- BT- Begin text object
strCodeText += "BT" + vbCrLf
'-- Tf - Set text font and size
strCodeText += "/F" + dicFontsUsed.Item("pdfTrueTypeFonts." + FontName.ToString).ToString + " " + FontSize.ToString + " Tf" + vbCrLf
'-- Now do we need to rotate it
If Rotate <> 0 Then
'-- System.Math.Sin and System.Math.Cos is in radians. we need to convert to degrees
Dim dblDegrees As Double = System.Math.PI / 180
'-- Little Math reminder long time ago since I study math 30plus years
'-- There is 360 degrees in a circle and we will pivot around the start point of the text.
'-- The ratio of the height to the hypotenuse is called the sine
Dim sngSinAngle As Single = System.Math.Sin(dblDegrees * Rotate)
'-- The ratio of the base to the hypotenuse is called the cosine
Dim sngCosAngle As Single = System.Math.Cos(dblDegrees * Rotate)
Dim fmt As String = "000.###"
'-- Tm- Set text matrix and text line matrix
'-- Using the + operator caused a error in compiler so had to go back to VB6 style string concatenation to get over exception.
strCodeText += sngCosAngle.ToString(fmt) & " " & sngSinAngle.ToString(fmt) & " " & -sngSinAngle.ToString(fmt) & " " & sngCosAngle.ToString(fmt) & " " & sngHorzOffSet.ToString & " " & sngVertOffSet.ToString & " Tm" & vbCrLf
Else
'--
'-- Where to place the string on the page Td- Move text position
strCodeText += sngHorzOffSet.ToString + " " + sngVertOffSet.ToString + " Td" + vbCrLf
End If


'-- Text to display on page
strCodeText += "(" + CheckReserveChar(strTextToShow) + " Tj" + vbCrLf


'-- End the Text block
strCodeText += "ET" + vbCrLf
'-- Need to keep keys unique
intStringCount += 1
colPageText.Add(intPage.ToString + "." + intStringCount.ToString, strCodeText)
End Sub

#Region "Graphic Paths"
Public Sub LineHorizontal(ByVal intPage As Integer, ByVal sngHorzOffSet As Single, ByVal sngVertOffSet As Single, ByVal LineLength As Single, ByVal LineColor As System.Drawing.Color, ByVal intThickness As Integer)
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to LineHorizontal " + vbCrLf
End If
Dim strCodeLine As String = strComment
Dim fmt As String = "000.###"
'-- Set the color of the line
strCodeLine += LineColor.R.ToString & " " & LineColor.G.ToString & " " & LineColor.B.ToString & " RG" + vbCrLf
'-- Set the thickness of the line
strCodeLine += intThickness.ToString + " w" + vbCrLf
'-- m - Begin a new subpath by moving the current point to coordinates (x, y),
'-- omitting any connecting line segment. If the previous path construction operator
'-- in the current path was also m, the new m overrides it; no vestige of the previous m
'-- operation remains in the path.
'-- This is the Starting point of the line
strCodeLine += sngHorzOffSet.ToString(fmt) + " " + sngVertOffSet.ToString(fmt) + " m" + vbCrLf
'-- This draws the line to the length from the start point
'-- Line draws from right of page to left of page.
Dim sngLenght As Single = sngHorzOffSet - LineLength
'-- l - Append a straight line segment from the current point to the point (x, y).
strCodeLine += sngLenght.ToString(fmt) + " " + sngVertOffSet.ToString(fmt) + " l" + vbCrLf
'-- The S is for paint the line (path) Stroked
strCodeLine += "S" + vbCrLf
'-- Need to keep keys unique
intLineCount += 1
colLineCode.Add(intPage.ToString + "." + intLineCount.ToString, strCodeLine)

End Sub

Public Sub LineVertical(ByVal intPage As Integer, ByVal sngHorzOffSet As Single, ByVal sngVertOffSet As Single, ByVal LineLength As Single, ByVal LineColor As System.Drawing.Color, ByVal intThickness As Integer)
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to LineVertical " + vbCrLf
End If
Dim strCodeLine As String = strComment
Dim fmt As String = "000.###"
'-- Set the color of the line
strCodeLine += LineColor.R.ToString & " " & LineColor.G.ToString & " " & LineColor.B.ToString & " RG" + vbCrLf
'-- Set the thickness of the line
strCodeLine += intThickness.ToString + " w" + vbCrLf
'-- m - Begin a new subpath by moving the current point to coordinates (x, y),
'-- omitting any connecting line segment. If the previous path construction operator
'-- in the current path was also m, the new m overrides it; no vestige of the previous m
'-- operation remains in the path.
'-- This is the Starting point of the line
strCodeLine += sngHorzOffSet.ToString(fmt) + " " + sngVertOffSet.ToString(fmt) + " m" + vbCrLf

'-- Line draws from bottom of page to top of page.
Dim sngHeight As Single = sngVertOffSet - LineLength
'-- l - Append a straight line segment from the current point to the point (x, y).
strCodeLine += sngHorzOffSet.ToString(fmt) + " " + sngHeight.ToString(fmt) + " l" + vbCrLf
'-- The S is for paint the line(path) Stroked
strCodeLine += "S" + vbCrLf
'-- Need to keep keys unique
intLineCount += 1
colLineCode.Add(intPage.ToString + "." + intLineCount.ToString, strCodeLine)

End Sub

Public Sub DrawImg(ByVal intPage As Integer, ByVal Name As String, ByVal sngHorzLeftOffSet As Single, ByVal sngVertBottomOffSet As Single, ByVal imgWidth As Single, ByVal ImgHeight As Single, ByVal BitMapFile As Boolean)
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to DrawImg " + vbCrLf
End If
Dim strBitMap As String
'-- Found JPEG Files was draw upside down from Bitmap files in the transform matric
If BitMapFile = True Then
strBitMap = " 0 0 -"
Else
strBitMap = " 0 0 "
End If
'-- The page size divide by 72 equal 1 inch so 612/72 = 8.5
'-- The Horizontal offset must be between
If sngHorzLeftOffSet > intPageWidth Then
'-- Just keep the image on the page
sngHorzLeftOffSet = intPageWidth - 20
ElseIf sngHorzLeftOffSet < 0 Then
'-- Just keep the image on the page
sngHorzLeftOffSet = 20
End If
If sngVertBottomOffSet > intPageHeight Then
'-- Just keep the image on the page
sngVertBottomOffSet = intPageHeight - 20
ElseIf sngVertBottomOffSet < 0 Then
'-- Just keep the image on the page
sngVertBottomOffSet = 20
End If
If imgWidth > intPageWidth Then
'-- Dont let the image be larger than the page.
imgWidth = intPageWidth - 20
End If
If ImgHeight > intPageHeight Then
'-- Dont let the image be larger than the page.
ImgHeight = intPageHeight - 20
End If
Dim fmt As String = "####.00"
Dim strDrawImage As String = strComment
'-- q - Save graphics state
strDrawImage = "q" + vbCrLf
strDrawImage += imgWidth.ToString(fmt) + strBitMap
strDrawImage += ImgHeight.ToString(fmt) + " "
strDrawImage += sngHorzLeftOffSet.ToString(fmt) + " "
'-- cm - Concatenate matrix to current transformation matrix
strDrawImage += sngVertBottomOffSet.ToString(fmt) + " cm "
'-- Do - Invoke named XObject
strDrawImage += "/" + Name + " Do "
'-- Q - Restore graphics state
strDrawImage += "Q" + vbCrLf
'-- Need to keep keys unique
intDrawImagesCount += 1
colDrawImages.Add(intPage.ToString + "." + intDrawImagesCount.ToString, strDrawImage)

End Sub

Public Sub DrawCircle(ByVal intPage As Integer, ByVal Center As Point, ByVal Radius As Single, ByVal LineColor As System.Drawing.Color)
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to DrawCircle " + vbCrLf
End If
'-- Given the coordinates of the four points of the BezierCurve
'-- the curve is generated by varying the Parameter T from 0.0 to 1.0
Dim sngParameterT As Single = 0.55
Dim strCircle As String = strComment
Dim fmt As String = "000.###"
'-- Set the color of the line
strCircle += LineColor.R.ToString & " " & LineColor.G.ToString & " " & LineColor.B.ToString & " RG" + vbCrLf
'-- Set our center point
Dim Point0 As New Point(Center.X, Center.Y - Radius)
strCircle += Point0.X.ToString(fmt) + " " + Point0.Y.ToString(fmt) + " m" + vbCrLf

Dim Point1 As New Point(Center.X + sngParameterT * Radius, Center.Y - Radius)
Dim Point2 As New Point(Center.X + Radius, Center.Y - sngParameterT * Radius)
Dim Point3 As New Point(Center.X + Radius, Center.Y)
'-- Our First Curve
strCircle += BezierCurve(Point1, Point2, Point3)
Dim Point4 As New Point(Center.X + Radius, Center.Y + sngParameterT * Radius)
Dim Point5 As New Point(Center.X + sngParameterT * Radius, Center.Y + Radius)
Dim Point6 As New Point(Center.X, Center.Y + Radius)
'-- Our Second Curve
strCircle += BezierCurve(Point4, Point5, Point6)
Dim Point7 As New Point(Center.X - sngParameterT * Radius, Center.Y + Radius)
Dim Point8 As New Point(Center.X - Radius, Center.Y + sngParameterT * Radius)
Dim Point9 As New Point(Center.X - Radius, Center.Y)
'-- Our Third Curve
strCircle += BezierCurve(Point7, Point8, Point9)

Dim Point10 As New Point(Center.X - Radius, Center.Y - sngParameterT * Radius)
Dim Point11 As New Point(Center.X - sngParameterT * Radius, Center.Y - Radius)
Dim Point12 As New Point(Center.X, Center.Y - Radius)
'-- Our Closing Curve
strCircle += BezierCurve(Point10, Point11, Point12)
'-- The S is for paint the line (path) Stroked
strCircle += "S" + vbCrLf

'-- Need to keep keys unique
intCircleCount += 1
colCircles.Add(intPage.ToString + "." + intCircleCount.ToString, strCircle)
End Sub

Private Function BezierCurve(ByVal ControlPoint1 As Point, ByVal ControlPoint2 As Point, ByVal FinalPoint As Point) As String
'-- To Do Need to Overload this function to make it public use or private use later
'-- Curved path segments are specified as cubic Bézier curves. Such curves are defined by four points:
'-- the two endpoints (the current point P0 and the final point P3 ) and two control points P1 and P2
'-- This function should only be called after the Start point has been created using the Move m control char in pdf.
Return ControlPoint1.X.ToString + " " + ControlPoint1.Y.ToString + " " + ControlPoint2.X.ToString + " " + ControlPoint2.Y.ToString + " " + FinalPoint.X.ToString + " " + FinalPoint.Y.ToString + " c" + vbCrLf
End Function

#End Region

#Region "Helper Subs"
Private Sub upDateReffenceTable()
'-- This just keep up with each pdf obj that is created an added to the cross reffence table at the
'-- end of the file.
intpdfObjectCount += 1
colCrossReferenceTable.Add(intpdfObjectCount.ToString + " 0 obj", FileText.Length.ToString)
End Sub
#End Region

#Region "File Flow Function"
Private Function FileHeader() As String
'-- The first line of a PDF file is a header identifying the version of the PDF
'-- specification to which the file conforms
'-- %PDF−1.0
'-- %PDF−1.1
'-- %PDF−1.2
'-- %PDF−1.3
'-- %PDF−1.4
'-- %PDF−1.5
'-- %PDF−1.6
'-- %PDF-1.7 This is the Refernce I used to create the file but only using version 1.3
'-- of the Features so I am hard coding it for now maybe later pass in the values
Dim strFileHeader As String = "%PDF-1.4"
'-- Note: If a PDF file contains binary data, as most do (see Section 3.1, “Lexical Conventions”),
'-- it is recommended that the header line be immediately followed by a comment line containing at
'-- least four binary characters—that is, characters whose codes are 128 or greater
'-- %âãÏÓ these seem to be the standard on files I have tested.
strFileHeader += "%âãÏÓ" + vbCrLf
'-- Now give it back

Return strFileHeader
'-- After this function is called you must call the pdfFileInfo function
End Function

Private Function pdfFileInfo() As String
'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to pdfFileInfo " + vbCrLf
End If
Dim strFileInfo As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf
'-- Any entry whose value is not known should be omitted from the dictionary
'-- rather than included with an empty string as its value.
If _pdfTitle.Length > 0 Then
strFileInfo += "<< /Title (" + _pdfTitle + "" + vbCrLf
Else
strFileInfo += "<< "
End If
If _pdfAuthor.Length > 0 Then
strFileInfo += "/Author (" + _pdfAuthor + "" + vbCrLf
End If
If _pdfCreator.Length > 0 Then
strFileInfo += "/Creator (" + _pdfCreator + "" + vbCrLf
End If
If _pdfKeyWords.Length > 0 Then
strFileInfo += "/Keywords (" + _pdfKeyWords + "" + vbCrLf
End If
If _pdfSubject.Length > 0 Then
strFileInfo += "/Subject (" + _pdfSubject + "" + vbCrLf
End If
If _pdfProducer.Length > 0 Then
strFileInfo += "/Producer (" + _pdfProducer + "" + vbCrLf
End If
'-- We should alway show the Creation Date of the file.
'-- A date is an ASCII string of the form( D : YYYYMMDDHHmmSSOHH ' mm ' )
'-- HH followed by ' is the absolute value of the offset from UT in hours (00–23)
'-- Here in the Easter Time zone of the US we are 5 hours behind UT time.
strFileInfo += "/CreationDate (D:" & Format(Now, "yyyymmddhhmmss" & "-05'00')" + vbCrLf
'strFileInfo += "/ModDate (D:" & Format(Now, "yyyymmddhhmmss" & "-05'00')" + vbCrLf
strFileInfo += ">>" + vbCrLf
strFileInfo += "endobj" + vbCrLf

Return strFileInfo
'-- After this function is called you must call the rootCatalog function
End Function

Private Function rootCatalog() As String
'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to rootCatalog " + vbCrLf
End If
'-- The catalog contains references to other objects defining the document’s contents,
'-- outline, article threads (PDF 1.1), named destinations, and other attributes.
'-- In addition, it contains information about how the document should be displayed on the screen,
'-- such as whether its outline and thumbnail page images should be displayed automatically and
'-- whether some location other than the first page should be shown when the document is opened.

Dim strRoot As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf
'-- *Required* The type of PDF object that this dictionary describes; must be Catalog for the catalog dictionary.
strRoot += "<< /Type /Catalog" + vbCrLf
'-- Hard Coding does not work break ever time I change code...........
Dim intAvailableObject As Integer = intpdfObjectCount + 1
strRoot += "/Outlines " + intAvailableObject.ToString + " 0 R" + vbCrLf
intAvailableObject += 1
'-- *Required* The page tree node that is the root of the document’s page tree.
strRoot += "/Pages " + intAvailableObject.ToString + " 0 R" + vbCrLf
'-- *Optional* A name object specifying the page layout to be used when the document is opened
'-- SinglePage Display one page at a time
'-- OneColumn Display the pages in one column
'-- TwoColumnLeft Display the pages in two columns, with odd-numbered pages on the left
'-- TwoColumnRight Display the pages in two columns, with odd-numbered pages on the right
'-- TwoPageLeft(PDF 1.5) Display the pages two at a time, with odd-numbered pages on the left
'-- TwoPageRight(PDF 1.5) Display the pages two at a time, with odd-numbered pages on the right
'--Default value: SinglePage.
' strRoot += "/PageLayout /SinglePage" + vbCrLf
'-- *Optional* A name object specifying how the document should be displayed when opened
'-- UseNone Neither document outline nor thumbnail images visible
'-- UseOutlines Document outline visible
'-- UseThumbs Thumbnail images visible
'-- FullScreen Full-screen mode, with no menu bar, window controls, or any other window visible
'-- UseOC(PDF 1.5) Optional content group panel visible
'-- UseAttachments(PDF 1.6) Attachments panel visible
'-- Default value: UseNone
' strRoot += "/PageMode /UseNone" + vbCrLf
'-- *Optional* (PDF 1.4) A language identifier specifying the natural language for all text in the document
'-- except where overridden by language specifications for structure element
'-- ISO 639-1: two-letter codes, one per language or macrolanguage
'-- Example:
'-- English - en
'-- español - es
'-- Japanese - ja
'-- Korean - ko
' strRoot += "/Lang (en)" + vbCrLf
'-- *Optional* A viewer preferences dictionary specifying the way the document is to be displayed
'-- on the screen. If this entry is absent, applications should use their own current user preference settings.
'-- *Optional* HideToolbar - A flag specifying whether to hide the viewer application’s tool bars when the document is active.
'-- *Optional* DisplayDocTitle - A flag specifying whether the window’s title bar should display the document title taken from the Title entry
'-- of the document Information Dictionary
'-- *Optional* HideWindowUI - A flag specifying whether to hide user interface elements in the document’s window (such as scroll bars and navigation controls), leaving only the document’s contents displayed
'-- Not used but available are listed below
'-- FitWindow boolean/true false
'-- CenterWindow boolean/true false
'-- HideMenubar boolean/true false
' strRoot += "/ViewerPreferences << /HideToolbar false /DisplayDocTitle true /HideWindowUI false >>" + vbCrLf
strRoot += ">>" + vbCrLf
strRoot += "endobj" + vbCrLf


Return strRoot
'-- After this function is called you must call the OutLines function
End Function

Private Function OutLines() As String
'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to OutLines " + vbCrLf
End If
'-- I have not implemented this yet but it needed so I left it in the code.
Dim strOutLine As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf
strOutLine += "<< /Type /Outlines" + vbCrLf
strOutLine += "/Count 0" + vbCrLf
strOutLine += ">>" + vbCrLf
strOutLine += "endobj" + vbCrLf
Return strOutLine
'-- After this function is called you must call the PageTree function
End Function

Private Function PageTree() As String
'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to PageTree " + vbCrLf
End If
'-- The pages of a document are accessed through a structure known as the page tree,
'-- which defines the ordering of pages in the document
'-- The tree contains nodes of two types—intermediate nodes, called page tree nodes,
'-- and leaf nodes, called page objects
Dim strPageTree As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf
intPageTree = intpdfObjectCount
'-- The simplest structure would consist of a single page tree node that references all
'-- of the document’s page objects directly.
'-- *Required* The type of PDF object that this dictionary describes; must be Pages for a page tree node.
strPageTree += "<< /Type /Pages" + vbCrLf
'-- *Required* Kids - An array of indirect references to the immediate children of this node. The children may
'-- be page objects or other page tree nodes.
Dim intKids As Integer = intpdfObjectCount
'-- We must have at least one page in the file
'-- The 2 comes from 1 for the PageTree object and 1 for the Resources object
intKids += 2
strPageTree += "/Kids [ " + vbCrLf
strPageTree += intKids.ToString + " 0 R " + vbCrLf
'-- If there is more than one page add there objects here.
For intCounter = 2 To _pdfPageCount
intKids += 3
strPageTree += intKids.ToString + " 0 R " + vbCrLf
Next

strPageTree += "]" + vbCrLf
'-- *Required* Count - The number of leaf nodes (page objects) that are descendants of this node within the page tree.
strPageTree += "/Count " + _pdfPageCount.ToString + vbCrLf
Dim intResources As Integer = intpdfObjectCount
intResources += 1
strPageTree += "/Resources " + intResources.ToString + " 0 R " + vbCrLf
strPageTree += ">>" + vbCrLf
strPageTree += "endobj" + vbCrLf
Return strPageTree
'-- After this function is called you must call the Resources function
End Function

Private Function Resources() As String
'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to Resources " + vbCrLf
End If
Dim strResource As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf
'-- Entries in a resource dictionary Not Added yet.
'-- ExtGState - A dictionary that maps resource names to graphics state parameter dictionaries
'-- ColorSpace- A dictionary that maps each resource name to either the name of a device-dependent color space or an array describing a color space
'-- Pattern - A dictionary that maps resource names to pattern objects
'-- Shading - A dictionary that maps resource names to shading dictionaries
'-- Properties- A dictionary that maps resource names to property list dictionaries for marked content

'-- We have to have /ProcSet /PDF / Text at a min..
'-- For resource type ProcSet, the value is an array of procedure set names

strResource += "<< /ProcSet [ /PDF /Text" + IIf(colXobjectImages.Count > 0, " /ImageC", "" & "]" + vbCrLf
'-- A dictionary that maps resource names to external objects
If colXobjectImages.Count > 0 Then
strResource += "/XObject << " + vbCrLf
'-- Write the Images
For intCount = 0 To colXobjectImages.Count - 1
strResource += "/" + colXobjectImages.GetKey(intCount).ToString + " "
strResource += colXobjectImages.Item(intCount).ToString() + vbCrLf
'-- Need to keep up with our XObject so our file trailer will point to correct object.
intXObjectCount += 1
Next
strResource += ">>" + vbCrLf
End If

'-- A dictionary that maps resource names to font dictionaries
If colFonts.Count > 0 Then
strResource += "/Font << " + vbCrLf
'-- Here we need to loop through the collection of fonts.
For Each key In colFonts.Keys
strResource += "/" + key.ToString + " " + colFonts.Item(key).ToString + " 0 R " + vbCrLf
Next key
strResource += ">>" + vbCrLf
End If


strResource += ">>" + vbCrLf
strResource += "endobj" + vbCrLf

Return strResource
'-- After this function is called you must call the Page function
End Function

Private Function Page() As String
'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to Page " + vbCrLf
End If
Dim strPage As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf
strPage += "<< /Type /Page" + vbCrLf
strPage += "/Parent " + intPageTree.ToString + " 0 R" + vbCrLf
'-- *Required* MediaBox- Defining the boundaries of the physical medium on which the page is intended to be displayed or printed
strPage += "/MediaBox [ 0 0 " + intPageWidth.ToString + " " + intPageHeight.ToString + "]" + vbCrLf
'-- *Optional* CropBox - Its contents are to be clipped (cropped) to this rectangle
strPage += "/CropBox [ 0 0 " + intPageWidth.ToString + " " + intPageHeight.ToString + "]" + vbCrLf

Dim intNextObjects As Integer = intpdfObjectCount
intNextObjects += 1
strPage += "/Contents " + intNextObjects.ToString + " 0 R" + vbCrLf
strPage += ">>" + vbCrLf
strPage += "endobj" + vbCrLf
'-- Keeps up with our human page count.
intPageCount += 1
Return strPage
'-- After this function is called you must call the ContentStream function
End Function

Private Function ContentStream() As String
'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to ContentStream " + vbCrLf
End If
Dim strContent As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf
'-- *Required* Length - The number of bytes from the beginning of the line following
'-- the keyword stream to the last byte just before the keyword endstream.
'-- If the length is not know before hand write the stream and set the length in another
'-- object and point to that object in the Length section.Example << /Length 15 0 R >>
Dim intNextObjNumber As Integer = intpdfObjectCount + 1

strContent += "<< /Length " + intNextObjNumber.ToString + " 0 R" + vbCrLf + ">>" + vbCrLf
strContent += "stream"
'-- Figure the stream length as per note above
Dim intStartOffSet As Integer = strContent.Length
strContent += vbCrLf
'-- Draw any images on this page
For intCount = 0 To colDrawImages.Count - 1
If colDrawImages.GetKey(intCount).ToString.StartsWith(intPageCount.ToString) = True Then
strContent += colDrawImages.Item(intCount).ToString()
End If
Next
'-- Write out the Text for this page
For intCount = 0 To colPageText.Count - 1
'-- Only write out the data for this page.
If colPageText.GetKey(intCount).ToString.StartsWith(intPageCount.ToString) = True Then
strContent += colPageText.Item(intCount).ToString()
End If
Next
'-- Write any lines for this page.
For intCount = 0 To colLineCode.Count - 1
If colLineCode.GetKey(intCount).ToString.StartsWith(intPageCount.ToString) = True Then
strContent += colLineCode.Item(intCount).ToString()
End If
Next
'-- Write and Circles for this page.
For intCount = 0 To colCircles.Count - 1
If colCircles.GetKey(intCount).ToString.StartsWith(intPageCount.ToString) = True Then
strContent += colCircles.Item(intCount).ToString()
End If
Next

'-- Ok done writting the Content need to figure the length
intStreamLength = strContent.Length - intStartOffSet
strContent += "endstream" + vbCrLf
strContent += "endobj" + vbCrLf
Return strContent
'-- After this function is called you must call the StreamLengthObj function
End Function



Return strFont
End Function

Private Function CheckReserveChar(ByVal strValue As String) As String
'-- Ok PDF Files have reserve meaning for the above character so proceed them with the back slash.
'-- Look for the in the Temp String and Replace it with \
'-- Then Look for ( in the Temp String and Replace it with (
'-- Then Look for ) in the Temp String and Replace it with )
Return Replace(Replace(Replace(strValue, "", "\", "(", "(", "", ""
'-- Replace- Returns a string in which a specified substring has been replaced with another substring a specified number of times.
'-- Replace(expression, find, replace[, start[, count[, compare]]])
End Function





For intCounter = 1 To TT_String.Length

bytChar = Asc(Mid(TT_String, intCounter, 1))
intStringWidth += +IIf((bytChar >= intFirstChar) And (bytChar <= intLastChar), GlyphWidths(bytChar - 1), intMissingWidth)
'-- Use in the feature of word spacing. not use right now but leave the code for later.
If bytChar = 32 Then intSpaceCount += 1 '-- Count the spaces
Next

Return (intStringWidth * Fontsize / 1000)
'-- When add other feature use the return below.
'Return ((intStringWidth * Fontsize / 1000) + (intSpaceCount * sngWordSpacing) + (TT_String.Length * sngCharSpacing)) * (sngTextScaling / 100)

End Function
#Region "Images Function"

Private Function LoadImgFromBMPFile(ByRef Name As String, ByRef FileName As String, Optional ByRef ColorSpace As pdfColorSpace = pdfColorSpace.pdfRGB) As String
'-- Byte
Dim ImgBuf(0) As Byte
Dim ImgColor(0) As Byte
Dim ImgBPP As Byte
'-- Long
Dim imgWidth As Integer
Dim ImgHeight As Integer
'-- Boolean
Dim blnFlag As Boolean

blnFlag = LawBMP(FileName, ImgBuf, ImgColor, imgWidth, ImgHeight, ImgBPP, ColorSpace)
'-- ok if we have a bitmap the load image from array
If blnFlag = True Then
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to LoadImgFromBMPFile " + vbCrLf
End If
Return strComment + LoadImgFromArray(Name, ImgBuf, ImgColor, imgWidth, ImgHeight, ImgBPP, ColorSpace)
End If

'-- Set the Flag
Return ""

End Function

Private Function LoadImgFromJPEGFile(ByRef Name As String, ByRef FileName As String) As String

'-- Ok the first thing we need to do is parse the jpeg file.
'-- Just check the file name to see if it has extensions
If FileName.Contains("." = False Then
MsgBox("File " & FileName & " does not have an extension" & vbNewLine & "Invalid filename specified.", MsgBoxStyle.Critical, "Image File - clsPdfWriter"
Return ""
End If

'-- Just check to see if it's a jpeg format file
If FileName.ToLower.EndsWith("jpg" Or FileName.ToLower.EndsWith("jpeg" Then
Dim blnPDFParse As Boolean
'-- This will assing the data from the file to a structure define by me.
blnPDFParse = LawJPG(FileName)
'-- Check to see if the Parsing failed
If blnPDFParse = False Then
Return ""
End If
Else
MsgBox("Image format not supported." & vbNewLine & "Only jpg or jpeg images are supported." & vbNewLine & "Impossible to include image in PDF file.", MsgBoxStyle.Critical, "Image File - PDFSimple"
Return ""
End If

'-- Need to set our Collection for this object
upDateReffenceTable()
Dim strComment As String = ""
If _pdfCommentFile = True Then
strComment = "% Comment- Call to LoadImgFromJPEGFile " + vbCrLf
End If
'-- The image dictionary specifies the width, height, and number of bits per component
'-- explicitly. The number of color components can be inferred from the color space specified in the dictionary

'-- Jpeg
'<</Type /XObject
'/Subtype /Image
'/Filter [/DCTDecode ]
'/Width 75
'/Height 70
'/ColorSpace /DeviceRGB
'/BitsPerComponent 8
'/Length 2307
'/Name /ImgJPEG1>>

'-- Set our Object number
Dim strImage As String = strComment + intpdfObjectCount.ToString + " 0 obj" + vbCrLf

'-- This writes out the Xobject Dictionary

strImage += "<</Type /XObject" & vbCrLf
strImage += "/Subtype /Image" & vbCrLf
strImage += "/Filter [/" + strImageJPEG.ImgDicFilter.ToString + " ]" + vbCrLf
strImage += "/Width " + strImageJPEG.ImgDicWidth.ToString + vbCrLf
strImage += "/Height " + strImageJPEG.ImgDicHeight.ToString + vbCrLf
strImage += "/ColorSpace /" + strImageJPEG.ImgDicColorSpace.ToString + vbCrLf
strImage += "/BitsPerComponent " + strImageJPEG.ImgDicBitsPerComponent.ToString + vbCrLf
strImage += "/Length " + strImageJPEG.ImgDicFileSize.ToString + vbCrLf
strImage += "/Name /" + Name.ToString + ">>" + vbCrLf
'-- Sample data is represented as a stream of bytes, interpreted as 8-bit unsigned integers in the range 0 to 255.
strImage += "stream" + vbCrLf
strImage += strImageJPEG.ImgDicDataStream.ToString + vbCrLf
strImage += "endstream" & vbCrLf
strImage += "endobj" + vbCrLf
'-- Add it to the Resource Dic
colXobjectImages.Add(Name, intpdfObjectCount.ToString + " 0 R "
Return strImage
End Function

Private Function LawBMP(ByRef FileName As String, ByRef ImgBuf() As Byte, ByRef ImgColor() As Byte, ByRef imgWidth As Integer, ByRef ImgHeight As Integer, ByRef ImgBPP As Byte, Optional ByRef ColorSpace As pdfColorSpace = pdfColorSpace.pdfRGB) As Boolean


' BITMAPFILEHEADER_Type
Dim bfType As String = "OO" ' The string “BM” (hex value &H424D).
Dim bfSize As Integer ' The size of the file, measured in .
Dim bfDummy As Short ' Not used, set to zero.
Dim bfOffBits As Integer ' The start offset of the bitmap data in the file.

' BITMAPINFOHEADER
Dim biSize As Integer ' 40 (the size of this structure).
Dim biWidth As Integer ' The width of the bitmap in pixels.
Dim biHeight As Integer ' The height of the bitmap in pixels.
Dim biPlanes As Short ' 1 (DIBs always have one plane).
Dim biBitCount As Short ' 1 for monochrome, 4 for 16 colors, 8 for 256 color, 24 for 24-bit RGB color.
Dim biCompression As Integer ' Specifies the type of compression for compressed
Dim biSizeImage As Integer ' The size of the image in bytes.
Dim biXPelsPerMeter As Integer ' Number of horizontal pixels per meter for
Dim biYPelsPerMeter As Integer ' Number of vertical pixels per meter for
Dim biClrUsed As Integer ' Number of entries in the DIB color table
Dim biClrImportant As Integer ' Number of entries in the DIB color table that


Dim fb As Short
Dim XBMP As Integer
Dim BPP As Byte
Dim intCounterOuter As Integer = 0
Dim blnFlag As Boolean
Dim TempImg() As Byte
Dim TempCol() As Byte ' RGBQUAD_Type
Dim lngGray As Integer

'-- Gets the next available free file
fb = FreeFile()
FileOpen(fb, FileName, OpenMode.Binary)

' BITMAPFILEHEADER
FileGet(fb, bfType)
FileGet(fb, bfSize)
FileGet(fb, bfDummy)
FileGet(fb, bfDummy)
FileGet(fb, bfOffBits)

'-- Test to see if the open file is type Bit Map
If bfType = "BM" Then

' BITMAPINFOHEADER
FileGet(fb, biSize)
FileGet(fb, biWidth)
FileGet(fb, biHeight)
FileGet(fb, biPlanes)
FileGet(fb, biBitCount)
FileGet(fb, biCompression)
FileGet(fb, biSizeImage)
FileGet(fb, biXPelsPerMeter)
FileGet(fb, biYPelsPerMeter)
FileGet(fb, biClrUsed)
FileGet(fb, biClrImportant)


BPP = biBitCount
'-- Check to see if the bit count is 8 or less
If BPP <= 8 Then

'-- law the palette of colors

ReDim TempCol((2 ^ BPP) * 4)
FileGet(fb, TempCol)

If ColorSpace = pdfColorSpace.pdfRGB Then
ReDim ImgColor(3 * (2 ^ BPP))
For intCounter = 0 To (2 ^ BPP) - 1
'-- Found Bug color were mixed up between red and blue so reversed the colors
ImgColor(intCounter * 3 + 1) = TempCol(intCounter * 4 + 3) ' Blue
ImgColor(intCounter * 3 + 2) = TempCol(intCounter * 4 + 2) ' green
ImgColor(intCounter * 3 + 3) = TempCol(intCounter * 4 + 1) ' Red


Next
Else
ReDim ImgColor((2 ^ BPP))
For intCounter = 0 To (2 ^ BPP) - 1
lngGray = (0.33 * TempCol(intCounter * 4 + 1) + 0.59 * TempCol(intCounter * 4 + 2) + 0.11 * TempCol(intCounter * 4 + 3))
ImgColor(intCounter + 1) = IIf(lngGray > 255, 255, lngGray)
Next
End If
End If

XBMP = ((biWidth * BPP / 8) + 3) And &HFFFFFFFC ' .

imgWidth = biWidth
ImgHeight = biHeight
ImgBPP = CByte(biBitCount)
'-- Figure our Temp Image Size the arrays are 0 base so minus one
Dim lngTempImageSize As Long = (biHeight * XBMP) - 1

ReDim TempImg(lngTempImageSize)
FileGet(fb, TempImg, bfOffBits + 1)
FileClose(fb)
'-- Ok give us a buffer the same size as the image
ReDim ImgBuf(lngTempImageSize)


If BPP > 8 Then
blnFlag = ((biWidth Mod 4) <> 0)

If ColorSpace = pdfColorSpace.pdfRGB Then
For intCounter = 0 To UBound(TempImg) - 1 Step 3
ImgBuf(3 * intCounterOuter + 0) = TempImg(intCounter + 2)
ImgBuf(3 * intCounterOuter + 1) = TempImg(intCounter + 1)
ImgBuf(3 * intCounterOuter + 2) = TempImg(intCounter)
If (((intCounterOuter + 1) Mod biWidth) = 0) And blnFlag Then
intCounter += (biWidth Mod 4)
End If

intCounterOuter += 1
Next

Else
'-- Not check this area could be a bug.
For intCounter = 0 To UBound(TempImg) - 1 Step 3
lngGray = 0.33 * TempImg(intCounter + 2) + 0.59 * TempImg(intCounter + 1) + 0.11 * TempImg(intCounter)
ImgBuf(intCounterOuter + 1) = IIf(lngGray > 255, 255, lngGray)
If (((intCounterOuter + 1) Mod biWidth) = 0) And blnFlag Then intCounter += (biWidth Mod 4)
intCounterOuter += 1
Next

ReDim Preserve ImgBuf(intCounterOuter)

End If

ElseIf BPP <= 8 Then
blnFlag = (biWidth Mod IIf(BPP = 8, 4, 8)) <> 0
For intCounter = 0 To UBound(TempImg)
ImgBuf(intCounterOuter + 1) = TempImg(intCounter)
If ((intCounterOuter + 1) Mod Int((biWidth + (8 / BPP) - 1) / (8 / BPP))) = 0 And blnFlag Then
intCounter += (XBMP - (intCounter Mod XBMP))
End If
intCounterOuter += 1
Next

ReDim Preserve ImgBuf(intCounterOuter)

End If
'-- Yes we have a bitmap file.
Return True
Else
'-- Sorry not a bitmap file
Return False
End If

'-- If the file is open then close it.
If fb > 0 Then FileClose(fb)

End Function

Private Function LawJPG(ByRef pFileName As String) As Boolean

Dim str_TChar As String
Dim sIMG As Integer
Dim inIMG As Integer

Dim in_PEnd As Integer
Dim in_idx As Integer
Dim str_SegmMk As String
Dim in_SegmSz As Integer
Dim bChar As Byte
Dim in_TmpColor As Integer
Dim in_bpc As Integer



#End Region
#End Region
End Class





En la 1da Parte are un ejemplo del uso con un form

esta aca

http://www.taringa.net/comunidades/programacionnet/1805336/Manipulacion-y-Creacion-de-PDF-VB_NET-1-Parte.html

y la comunidad NET esta Aca

http://www.taringa.net/comunidades/programacionnet/

Si les gusto por favor comenten y recomiended esta comunidad
a su amigos NET jaja..en serio programadores net...
gracias


0 comentarios - Manipulacion y Creacion de PDF VB.NET 2 Parte