Write Filename on PDF document and print all PDF form one folder. Print shortened PDF

From Super Medline
Jump to: navigation, search

Deutsche Beschreibung PAD compatible description EULA

PMID onto PDF using PDF XChange

  • This program writes FileName and FilePath onto every PDF document in a selected folder of your file system.

You will know where you have (initially) stored a printed PDF even years later...

  • The second task is to print only a maximum of 12 pages per PDF document

This is why I needed this program

  • I do not use bibiography formatting software or services like mendeley to cope with my research pdf collection, rather, I collect them in the 1994 style of printouts in physical folders where they remain forever.
  • I have a paper stream of 1.000 pdfs per month for personal reasons, and I wanted to shut-down costs of printing.
  • So, first I decided to printout anything up to 12 pages on 3 sheets of paper at 70% page size - a full printout for a normal sized paper, and to printout only a scout view of 4 pages of a king-sized paper.
  • With only the scout view in hands, I were in need of writing the folder and filename where it is on my pc hard disk, to be able to print-on-demand the pdf once the whole item should be read.

pmidpdf01_Print_FileName_FilePath_names_on_all_PDF_documents_in_one_folder_and_tag_these_PDFs.png

  • Some papers, many hosted on www.highwire.org, contain an extra page of metadata and an advertisement banner. The convention when saving papers in the library on usb is to a)replace the filename by its PMID pubmed ID number, and to add a small tag into the filename in case such a first-page should not be printed:
Normal  file  12345678.pdf
Spammed file  12345678,3,.pdf (,3,.pdf is the tag recognized by my program, and easy typed on the numbers block)

                                                                                         

Here it is

http://www.kidney.de/pmidpdf.zip

download the zip into your standard folder for new evluation programs. Unzip it, it generates a directory /pmidpdf/. Therein, you will find the file PMID onto PDF using PDF XChange.application this is the starting program for a clickonce installation.

more essential than my little script is the third parties program PDF XChange Viewer, here is the link:PDF-XChange Viewer. it is essential to install the latter exactly where-it-wants.

Preliminary SourceCode

for the program is shown here including in-line documentation. Especially useful for programmers ISO of things like that,sure. Some bugs in the code are fixed now. If you need the original vb express 2012 files, mailto:olpedia@kidney.de ! Dont waste your time copypasting the code fragments.

'some less required
Imports System.IO
Imports System.Drawing.Printing
Imports System.Web
Imports System.Net
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Text
Imports System.IO.IsolatedStorage 
Public Class Form16
   'this program writes the filename and directory path of a pdf (e.g. a research paper pdf) onto a pdf and   
saves it. It does so for all pdf documents which are contained in the same directory. Also, it prints all pdf 
documents which are contained in a selected directory onto the standard printer. Also, single or some 
documents can be selected from such a folder. This visual basic program writes and stores some javascript 
which is funneled to the PDFXCView.exe viewer (which is freely downloadable. e.g. at http://www.chip.de/
downloads/PDF-XChange-Viewer_29539244.html . One problem exists, things do not run stable and about 20 % of 
funneled pdf documents will not be printed out. So i have created a simple printdir print directory function 
for windows 7. 
   Public txt3 As String
   Public printarray(100000, 10) As [String]
   Public printarrayline As Integer = 1
   Public printarrayline0 As Integer = 1
   Public Printpagesettings As PageSettings
   Public printcursory0 As Integer = 0
   Public printcursorx0 As Integer = 0
   Public WithEvents dtp As New Printing.PrintDocument
   Public docprintmode = "01"
   Public lb1mode = "printout"
   Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
       'überflüssig imho
       dtp.Dispose()
       Array.Clear(printarray, 1, printarrayline)
       printarrayline = 1 : printarrayline0 = 1
       printcursory0 = 0 : printcursorx0 = 0
   End Sub
   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
       ' this functions writes some javascript code into a file which is further handled by
 C:\Program Files\Tracker Software\PDF Viewer\PDFXCview.exe , the marvellous PDXC viewer which can be run  
from shell / windows command-line. Such functions are available in AcroRd32 acrobat pdf reader professional  
version. The functions and parameters used by PDFXC view are the same. google for some javascript functions 
to get the original adobe documentation.
       ' this case, PDFXCview.exe writes some lines of text - the original filename and directory path as 
well as a users comment - at a specified location onto the pdf document and saves the modified pdf document.
       Dim vart1 As Integer
       Dim idir1 As String
       Dim ifil1 As String
       Dim fileNameR As String = ""
       Dim shellstr As String = ""
       Dim filedata As String = ""
       Dim runjs As String = ""
       Dim testjs As String = ""
       Dim desigl1 As Date
       Dim desigls As String = "modified"
       Dim des0 As Integer
       Dim des1 As Integer
       ttx("(1) open the folder which you want to tag" + vbCrLf + "(2) sort the files by date" + vbCrLf + 
"(3) select the newest PDF [which has not been marked, yet]" + vbCrLf + "===> all 'older' PDF's will be 
tagged now with filename and your comments")
       Dim basisfile As String = indirfull("c:\", "All PDFs|*.pdf")
       vart1 = basisfile.LastIndexOf("\")
       Dim filedirectory As String = basisfile.Substring(0, vart1 + 1)
       ifil1 = basisfile.Substring(vart1 + 1)
       Dim restnum As Integer = 0
       Dim desigl0 As Date = My.Computer.FileSystem.GetFileInfo(basisfile).LastWriteTime.ToString
       Dim zweistring As String = InputBox("Note wich appears on all documents page 2")
       macdir(filedirectory + "\TESTDIR")
       Dim filenamex As String = ""
       Do While desigls = "modified"
           desigls = ""
           restnum = 0
           For Each fileName As String In My.Computer.FileSystem.GetFiles(filedirectory)
               vart1 = fileName.LastIndexOf("\")
               idir1 = fileName.Substring(0, vart1 + 1)
               ifil1 = fileName.Substring(vart1 + 1)
               'desigl1 = My.Computer.FileSystem.GetFileInfo(fileName).CreationTime.ToString
               desigl1 = My.Computer.FileSystem.GetFileInfo(fileName).LastWriteTime.ToString
               des1 = Date.Compare(desigl0, desigl1)
               If des1 = 1 Then
                   desigls = "modified"
                   restnum = restnum + 1
                   fileNameR = idir1 + "   " + ifil1
                   If InStr(fileName, ".pdf") > 0 Then
                       TextBox1.Text = fileName
                       TextBox1.Refresh()
                       runjs = ""
                       runjs = "for (var p = 0; p < 10; p++) "
                       runjs = runjs + "{  "
                       runjs = runjs + "var annot2 = this.addAnnot({ "
                       runjs = runjs + "name: §annot2name§, "
                       runjs = runjs + "page: 1, "
                       runjs = runjs + "type: §FreeText§, "
                       runjs = runjs + "rect : [25,10,580,30], "
                       runjs = runjs + "textSize : 16, "
                       runjs = runjs + "textFont : font.Helv, "
                       runjs = runjs + "strokeColor: color.black,"
                       runjs = runjs + "fillColor: color.white, "
                       runjs = runjs + "contents: §" + zweistring + "§});"
                       runjs = runjs + "};"
                       runjs = runjs + "for (var p = 0; p < this.numPages; p++) "
                       runjs = runjs + "{  "
                       runjs = runjs + "var annot1 = this.addAnnot({ "
                       runjs = runjs + "name: §annot1name§, "
                       runjs = runjs + "page: 0, "
                       runjs = runjs + "type: §FreeText§, "
                       runjs = runjs + "rect : [25,10,580,40], "
                       runjs = runjs + "textSize : 13, "
                       runjs = runjs + "textFont : font.Helv, "
                       runjs = runjs + "strokeColor: color.black,"
                       runjs = runjs + "fillColor: color.yellow, "
                       runjs = runjs + "contents: §" + Replace(fileNameR, "\", "/") + "§});"
                       runjs = runjs + "};"
                       If InStr(fileName, "3,.pdf") > 0 Then
                           runjs = ""
                           runjs = "for (var p = 0; p < 10; p++) "
                           runjs = runjs + "{  "
                           runjs = runjs + "var annot2 = this.addAnnot({ "
                           runjs = runjs + "name: §annot2name§, "
                           runjs = runjs + "page: 2, "
                           runjs = runjs + "type: §FreeText§, "
                           runjs = runjs + "rect : [25,10,580,30], "
                           runjs = runjs + "textSize : 16, "
                           runjs = runjs + "textFont : font.Helv, "
                           runjs = runjs + "strokeColor: color.black,"
                           runjs = runjs + "fillColor: color.white, "
                           runjs = runjs + "contents: §" + zweistring + "§});"
                           runjs = runjs + "};"
                           runjs = runjs + "for (var p = 0; p < this.numPages; p++) "
                           runjs = runjs + "{  "
                           runjs = runjs + "var annot1 = this.addAnnot({ "
                           runjs = runjs + "name: §annot1name§, "
                           runjs = runjs + "page: 1, "
                           runjs = runjs + "type: §FreeText§, "
                           runjs = runjs + "rect : [25,10,580,40], "
                           runjs = runjs + "textSize : 13, "
                           runjs = runjs + "textFont : font.Helv, "
                           runjs = runjs + "strokeColor: color.black,"
                           runjs = runjs + "fillColor: color.yellow, "
                           runjs = runjs + "contents: §" + Replace(fileNameR, "\", "/") + "§});"
                           runjs = runjs + "};"
                       End If
                       runjs = runjs + "app.execMenuItem(§Save§, this);"
                       ' runjs = runjs + "this.closeDoc(true); "
                       runjs = Replace(runjs, "§", Chr(34))
                       filenamex = Replace(fileName, "\", "")
                       filenamex = Replace(filenamex, ".", "")
                       filenamex = Replace(filenamex, ":", "")
                       testjs = filedirectory + "\TESTDIR\TestJS." + filenamex + ".txt"
                       prfilestr(testjs, runjs)
                       shellstr = "C:\Program Files\Tracker Software\PDF Viewer\PDFXCview.exe /runjs §" + 
testjs + "§ §" + fileName + "§"
                       shellstr = Replace(shellstr, "§", Chr(34))
                       Shell(shellstr)
                   End If
                   timmer(1)
               End If
           Next
           ttx("Some PDFs are encrypted and cannot be modified with this application. Others will be ready in 
a few rounds. Note which files are written in the bottom display line. Usually, press OK. If there remain a 
few of such recurrences, write anything in the textline of this infobox, then press OK. This will terminate 
the program.")
           runjs = InputBox("OK to proceed, type anything into the box to stop", restnum)
           If runjs <> "" Then Exit Sub
           runjs = MessageBox.Show("OK to proceed another round. If number above remains constant then 
cancel.", CStr(restnum), MessageBoxButtons.OKCancel)
           If runjs = Windows.Forms.DialogResult.Cancel Then Exit Sub
       Loop
       ttx("All PDFs carry file names and your common comment at the bas of p1 and p2")
   End Sub

                                                                                         

   Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
       Dim alwin As String = ""
       Dim filecnt As Integer = 0
       Dim filedirectory As String = indirpathname("c:\", "All PDFs|*.pdf")
       For Each fileName As String In My.Computer.FileSystem.GetFiles(filedirectory)
           filecnt = filecnt + 1
           timmer(7)
           pdfprint(fileName, "12/3i")
           If filecnt = 100 Then
               filecnt = 0
               alwin = InputBox("To print the next 100 PDF's, press Enter/OK")
           End If
       Next
   End Sub
   Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
       Dim alwin As Integer = 1
       Dim vart1 As Integer
       Dim idir1 As String
       Dim ifil1 As String
       ttx("Click a random file to select the appropriate Directory.")
       Dim filedirectory As String = indirpathname("c:\", "All PDFs|*.pdf")
       txt3 = filedirectory
       For Each fileName As String In My.Computer.FileSystem.GetFiles(filedirectory)
           vart1 = fileName.LastIndexOf("\")
           idir1 = fileName.Substring(0, vart1 + 1)
           ifil1 = fileName.Substring(vart1 + 1)
           ListBox1.Items.Add(ifil1)
       Next
   End Sub

                                                                                         

   Function pdfprint(ByVal fileName As String, ByVal pdftyp As String)
       'this functions writes some javascript code into a file which is further handled 
by C:\Program Files\Tracker Software\PDF Viewer\PDFXCview.exe , the marvellous PDXC viewer which can be run 
from shell / windows command-line. Such functions are available in AcroRd32 acrobat pdf reader professional 
version. The functions and parameters used by PDFXC view are the same. google for some javascript functions 
to get the original adobe documentation.
       Dim alwin As String = ""
       Dim shellstr As String = ""
       Dim filedata As String = ""
       Dim runjs As String = ""
       Dim testjs As String = ""
       Dim filedirectory As String
       Dim vart1 As String
       Dim filenamex As String = ""
       vart1 = fileName.LastIndexOf("\")
       filedirectory = fileName.Substring(0, vart1 + 1)
       macdir(filedirectory + "\TESTDIR")
       If InStr(fileName, ".pdf") > 0 Then
           If docprintmode = "01" Then
               TextBox1.Text = fileName
               TextBox1.Refresh()
               runjs = ""
               runjs = runjs + "printParams = this.getPrintParams();"
               runjs = runjs + "printParams.interactive = printParams.constants.interactionLevel.automatic;"
               runjs = runjs + "printParams.firstPage = 0;"
               runjs = runjs + "if ( this.numPages > 12 ) { printParams.lastPage = 3; } "
               runjs = runjs + "printParams.pageHandling = printParams.constants.handling.none;"
               runjs = runjs + "this.print(printParams); "
               runjs = runjs + "this.closeDoc(true); "
               If InStr(fileName, "3,.pdf") > 0 Then
                   runjs = ""
                   runjs = runjs + "printParams = this.getPrintParams();"
                   runjs = runjs + "printParams.interactive = 
printParams.constants.interactionLevel.automatic;"
                   runjs = runjs + "printParams.firstPage = 1;"
                   runjs = runjs + "if ( this.numPages > 13 ) { printParams.lastPage = 4; } "
                   runjs = runjs + "printParams.pageHandling = printParams.constants.handling.none;"
                   runjs = runjs + "this.print(printParams); "
                   runjs = runjs + "this.closeDoc(true); "
               End If
               runjs = Replace(runjs, "§", Chr(34))
           End If
           If docprintmode = "02" Then
               'wenn <12 pages ist alles gedruckt. druckt also nur wenn >12 pages und zwar den rest
               TextBox1.Text = fileName
               TextBox1.Refresh()
               runjs = ""
               runjs = runjs + "printParams = this.getPrintParams();"
               runjs = runjs + "printParams.interactive = printParams.constants.interactionLevel.automatic;"
               runjs = runjs + "printParams.firstPage = 4;  "
               runjs = runjs + "printParams.pageHandling = printParams.constants.handling.none;"
               runjs = runjs + "this.print(printParams); "
               runjs = runjs + "this.closeDoc(true); "
               If InStr(fileName, "3,.pdf") > 0 Then
                   runjs = ""
                   runjs = runjs + "printParams = this.getPrintParams();"
                   runjs = runjs + "printParams.interactive = 
printParams.constants.interactionLevel.automatic;"
                   runjs = runjs + "printParams.firstPage = 5; "
                   runjs = runjs + "printParams.pageHandling = printParams.constants.handling.none;"
                   runjs = runjs + "this.print(printParams); "
                   runjs = runjs + "this.closeDoc(true); "
               End If
               runjs = Replace(runjs, "§", Chr(34))
           End If
           If docprintmode = "03" Then
               'alles drucken, .3 ab seite 1
               TextBox1.Text = fileName
               TextBox1.Refresh()
               runjs = ""
               runjs = runjs + "printParams = this.getPrintParams();"
               runjs = runjs + "printParams.interactive = printParams.constants.interactionLevel.automatic;"
               runjs = runjs + "printParams.firstPage = 0;  "
               runjs = runjs + "printParams.pageHandling = printParams.constants.handling.none;"
               runjs = runjs + "this.print(printParams); "
               runjs = runjs + "this.closeDoc(true); "
               If InStr(fileName, "3,.pdf") > 0 Then
                   runjs = ""
                   runjs = runjs + "printParams = this.getPrintParams();"
                   runjs = runjs + "printParams.interactive = 
printParams.constants.interactionLevel.automatic;"
                   runjs = runjs + "printParams.firstPage = 1; "
                   runjs = runjs + "printParams.pageHandling = printParams.constants.handling.none;"
                   runjs = runjs + "this.print(printParams); "
                   runjs = runjs + "this.closeDoc(true); "
               End If
               runjs = Replace(runjs, "§", Chr(34))
           End If
           filenamex = Replace(fileName, "\", "")
           filenamex = Replace(filenamex, ".", "")
           filenamex = Replace(filenamex, ":", "")
           testjs = filedirectory + "\TESTDIR\TestJS." + filenamex + ".txt"
           prfilestr(testjs, runjs)
           shellstr = "C:\Program Files\Tracker Software\PDF Viewer\PDFXCview.exe /runjs §" + testjs + "§ §" 
+ fileName + "§"
           shellstr = Replace(shellstr, "§", Chr(34))
           Shell(shellstr)
       End If
   End Function
   Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
       ' Windows 7 cannot print file directories on your printer. this poor function gives a list of all 
files which are contained in a directory and prints it out prdir, sorted by filename.
       Dim filedirectory As String = indirfull("c:\", "All PDFs|*.pdf")
       Dim vart1 As String
       Dim idir1 As String
       Dim ifil1 As String
       vart1 = filedirectory.LastIndexOf("\")
       idir1 = filedirectory.Substring(0, vart1 + 1)
       printa("================================================================", "Courier New", 14, 1, 1, 
10, -1, 700, 1000, 1)
       printa(idir1, "Courier New", 14, 1, 1, 10, 10, 700, 1000, 1)
       printa("================================================================", "Courier New", 14, 1, 1, 
10, -1, 700, 1000, 1)
       For Each fileName As String In My.Computer.FileSystem.GetFiles(idir1)
           vart1 = fileName.LastIndexOf("\")
           idir1 = fileName.Substring(0, vart1 + 1)
           ifil1 = fileName.Substring(vart1 + 1)
           printa(ifil1, "Courier New", 14, 1, 1, 10, -1, 700, 1000, 1)
       Next
       printout()
   End Sub
   'a few functions in visual basic for directory and path handling operations, a mkdir function, a get 
filename function, a get filepath function.
   'einige funktionen in visual basic, die verzeichnisse und dateinamen betreffen
   Function macdir(dirname As String)
       Dim ret As String = Dir$(dirname, vbDirectory)
       If Len(ret) < 1 Then
           MkDir(dirname)
       End If
   End Function
   Public Function indirpathname(ByVal path As String, ByVal ifil2 As String)
       Dim vart1 As Integer
       Dim idir1 As String
       Dim ifil1 As String
       Dim aka As String
       vart1 = path.LastIndexOf("\")
       idir1 = path.Substring(0, vart1 + 1)
       ifil1 = path.Substring(vart1 + 1)
       ifil2 = ifil2 + ifil1
       OpenFileDialog1.InitialDirectory = idir1
       OpenFileDialog1.Filter = ifil2
       OpenFileDialog1.FileName = idir1 + ifil1
       aka = OpenFileDialog1.ShowDialog.ToString
       path = OpenFileDialog1.FileName
       vart1 = path.LastIndexOf("\")
       indirpathname = path.Substring(0, vart1 + 1)
   End Function
   Public Function indirfull(ByVal path As String, ByVal ifil2 As String)
       Dim vart1 As Integer
       Dim idir1 As String
       Dim ifil1 As String
       Dim aka As String
       vart1 = path.LastIndexOf("\")
       idir1 = path.Substring(0, vart1 + 1)
       ifil1 = path.Substring(vart1 + 1)
       ifil2 = ifil2 + ifil1
       OpenFileDialog1.InitialDirectory = idir1
       OpenFileDialog1.Filter = ifil2
       OpenFileDialog1.FileName = idir1 + ifil1
       aka = OpenFileDialog1.ShowDialog.ToString
       indirfull = OpenFileDialog1.FileName
   End Function
   Public Function indirfilename(ByVal path As String, ByVal ifil2 As String)
       Dim vart1 As Integer
       Dim idir1 As String
       Dim ifil1 As String
       Dim aka As String
       vart1 = path.LastIndexOf("\")
       idir1 = path.Substring(0, vart1 + 1)
       ifil1 = path.Substring(vart1 + 1)
       ifil2 = ifil2 + ifil1
       OpenFileDialog1.InitialDirectory = idir1
       OpenFileDialog1.Filter = ifil2
       OpenFileDialog1.FileName = idir1 + ifil1
       aka = OpenFileDialog1.ShowDialog.ToString
       indirfilename = OpenFileDialog1.FileName
   End Function
   'these three functions (function) give a general printing model for visual basic. you can select many 
parameters. analyze the whole programm on its use
   'mit diesen funtionen wird eine druckfunktion drucken in visual basic realisiert, die viele druckparameter 
verarbeiten kann.
   Function printout()
       PageSetupDialog1.PageSettings = New System.Drawing.Printing.PageSettings
       PageSetupDialog1.PrinterSettings = New System.Drawing.Printing.PrinterSettings
       PrintDialog1.AllowSomePages = False
       PrintDialog1.ShowHelp = True
       PrintDialog1.Document = dtp
       dtp.Print()
       dtp.Dispose()
       printcursory0 = 0 : printcursorx0 = 0
   End Function
   Public Function printa(ByVal patext As String, ByVal pafont As String, ByVal pasize As String, ByVal 
patype As String, ByVal pacolor As String, ByVal pax0i As Integer, ByVal pay0i As Integer, ByVal pax1i As 
Integer, ByVal pay1i As Integer, ByVal palinmin As Integer)
       Dim panr As Integer = printarrayline
       Dim odoa As String = Chr(10)
       Dim loopstat As Boolean = True
       Dim patextodoa As Integer = 1
       Dim patextr As String = ""
       Do While loopstat = True
           patextodoa = patext.IndexOf(odoa)
           If patextodoa > 0 Then
               patextr = patext.Substring(patextodoa + 1) : patext = patext.Substring(0, patextodoa - 0)
           Else
               loopstat = False
           End If
           printarray.SetValue(patext, panr, 1)
           printarray.SetValue(pafont, panr, 2)
           printarray.SetValue(pasize, panr, 3)
           printarray.SetValue(patype, panr, 4)
           printarray.SetValue(pacolor, panr, 5)
           printarray.SetValue(CStr(pax0i), panr, 6)
           printarray.SetValue(CStr(pay0i), panr, 7)
           printarray.SetValue(CStr(pax1i), panr, 8)
           printarray.SetValue(CStr(pay1i), panr, 9)
           printarray.SetValue(CStr(palinmin), panr, 10)
           pay0i = -1
           panr = panr + 1
           printa = panr
           printarrayline = panr
           patext = patextr
       Loop
   End Function
   Public Sub dtp_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) 
Handles dtp.PrintPage
       Dim fonttext As String
       Dim fonttype As String
       Dim fontsize As Integer
       Dim fontview As FontStyle
       Dim fontcolor As Brush
       Dim fontx0 As Integer
       Dim fonty0 As Integer
       Dim fontx1 As Integer
       Dim fonty1 As Integer
       Dim fontxm As Integer
       Dim fontym As Integer
       Dim fontxa As Integer
       Dim fontya As Integer
       Dim fontpanr As Integer
       Dim nm As Integer
       Dim strwid1 As SizeF
       Dim strwid2 As Integer
       Dim strtxtp As String
       Dim strpos0 As Integer
       Dim strpos1 As Integer
       Dim strpos1a As Integer
       Dim strpos1b As Integer
       Dim plinmin As Integer
       Dim plincnt As Integer
       e.HasMorePages = False
       fontpanr = printarrayline - 1
       'fontxa = PageSetupDialog1.PageSettings.Margins.Left
       'fontya = PageSetupDialog1.PageSettings.Margins.Top
       'fontxm = PageSetupDialog1.PageSettings.Margins.Right
       'fontym = PageSetupDialog1.PageSettings.Margins.Bottom
       fontxa = e.MarginBounds.Left
       fontya = e.MarginBounds.Top
       fontxm = e.MarginBounds.Right
       fontym = e.MarginBounds.Bottom
       fontxa = 0 : fontya = 0
       If printcursory0 < fontya Then printcursory0 = fontya
       If printcursorx0 < fontxa Then printcursorx0 = fontxa
       nm = printarrayline0
       Do While e.HasMorePages = False And nm <= fontpanr
           fonttext = printarray.GetValue(nm, 1) + " "
           fonttype = printarray.GetValue(nm, 2)
           fontsize = CInt(printarray.GetValue(nm, 3))
           fontview = CInt(printarray.GetValue(nm, 4))
           fontcolor = System.Drawing.Brushes.Black
           fontx0 = CInt(printarray.GetValue(nm, 6)) + fontxa
           fonty0 = CInt(printarray.GetValue(nm, 7)) + fontya
           If fonty0 - fontya = -1 Then fonty0 = printcursory0
           fontx1 = CInt(printarray.GetValue(nm, 8)) + fontxa
           fonty1 = CInt(printarray.GetValue(nm, 9)) + fontya
           plinmin = CInt(printarray.GetValue(nm, 10))
           If fontx0 > fontxm Then fontx0 = fontxa
           If fontx1 > fontxm Then fontx1 = fontxm
           If fonty0 > fontym Then fonty0 = fontya
           If fonty1 > fontym Then fonty1 = fontya
           Dim printfont As New System.Drawing.Font(fonttype, fontsize, fontview)
           plincnt = 0
           Do While fonttext.Length > 1
               strwid2 = fontx0
               Do While strwid2 < fontx1 And strpos1 < fonttext.Length - 1
                   strpos0 = strpos1
                   strpos1a = fonttext.IndexOf(" ", strpos0 + 1) : If strpos1a = -1 Then strpos1a = 1000000
                   strpos1b = fonttext.IndexOf("-", strpos0 + 1) : If strpos1b = -1 Then strpos1b = 1000000
                   If strpos1a < strpos1b Then strpos1 = strpos1a Else strpos1 = strpos1b
                   strtxtp = fonttext.Substring(0, strpos1)
                   strwid1 = e.Graphics.MeasureString(strtxtp, printfont)
                   strwid2 = strwid1.Width + fontx0
               Loop
               If strpos1 >= fonttext.Length - 1 Then strpos0 = strpos1
               strtxtp = fonttext.Substring(0, strpos0 + 1)
               fonttext = fonttext.Substring(strpos0 + 1)
               strpos0 = 1 : strpos1 = 1
               e.Graphics.DrawString(strtxtp, printfont, fontcolor, fontx0, fonty0)
               plincnt = plincnt + 1
               If fonttype <> "IDAutomationHC39M" Then fonty0 = fonty0 + fontsize * 1.5
               printcursory0 = fonty0 : printcursorx0 = fontx0
               If fonty0 > fontym Then
                   fonty0 = 0
                   e.HasMorePages = True
                   printarrayline0 = nm
                   printarray.SetValue(fonttext, nm, 1)
                   Exit Sub
               Else
                   e.HasMorePages = False
               End If
           Loop
           If plincnt < plinmin Then
               fonty0 = fonty0 + fontsize * 1.5 * (plinmin - plincnt)
               printcursory0 = fonty0 : printcursorx0 = fontx0
               If fonty0 > fontym Then
                   fonty0 = 0
                   e.HasMorePages = True
                   printarrayline0 = nm
                   'printarray.SetValue(fonttext, nm, 1)
                   Exit Sub
               Else
                   e.HasMorePages = False
               End If
           End If
           nm = nm + 1
       Loop
       printarrayline0 = nm
   End Sub
   Public Function prfilestr(ByVal path As String, ByVal prdata As String) As String
       'data will be written into a file with visual basic with this function
       'funktion, die daten in eine datei schreibt in visual basic
       Using sw As StreamWriter = File.CreateText(path)
           sw.Write(prdata)
           sw.Close()
       End Using
       prfilestr = ""
   End Function
   Function timmer(timm As Integer)
       'a stupid timer in visual basic to get a futile cyle of some seconds to spare systems resources
       'ein primitiver timer für visual basic. dieser soll systemressourcen sparen.
       Dim StartTime As Integer
       For nm = 1 To timm
           StartTime = Now.Second
           If StartTime <> 60 Then
               Do While Now.Second = StartTime
               Loop
           End If
       Next
   End Function
   Function ttx(ttxtxt As String)
       TextBox1.Text = ttxtxt : TextBox1.Refresh()
   End Function
   Function ttxe(ttxtxt As String)
       TextBox1.Text = TextBox1.Text + vbCrLf + ttxtxt : TextBox1.Refresh()
   End Function
   Function ttxc()
       TextBox1.Text = "" : TextBox1.Refresh()
   End Function
   Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles 
ListBox1.SelectedIndexChanged
       If lb1mode = "printout" Then
           Dim filedirectory As String = txt3 + ListBox1.Text
           pdfprint(filedirectory, docprintmode)
       End If
       If lb1mode = "printoption" Then
           docprintmode = ListBox1.Text.Substring(0, 2)
           lb1mode = "printout"
           ListBox1.Text = ""
       End If
   End Sub
   Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
       'systematic errors
       ttx("(1) ErrorBoxes on PDGF/A documents. About 5% of the PDFs are in PDFA mode which will be changed. 
Checking the box 'not to do so next time' is without consequences.")
       ttxe("==> Open a single PDF/A documents with PDF-XCHANGE VIEWER from its windows directory, goto 
Werkzeuge/Anmerkungen (Tools/Notes), modify this pdf and save it. The formerly useless box apperas; set a 
mark at the box 'not to ask this again'.")
       ttxe("==> Once done, this error will not occur anymore !")
   End Sub
   Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
       ' how to clear a listbox element in visual basic
       ' wie man in visual basic ein listbox element löscht
       For i = 0 To (ListBox1.Items.Count - 1)
           ListBox1.Items.RemoveAt(0)
       Next i
       ListBox1.Refresh()
       ' how to add an item to a listbox element in visual basic
       ' wie man ein element zu einem listbox steuerelement in visual basic hinzufügt
       ListBox1.Items.Add("01: Max 12 pages, else 4 pages, 3,.pdf (means no page 1)")
       ListBox1.Items.Add("02: all pages without the first 12/4, 3,.pdf adapted")
       ListBox1.Items.Add("03: The full document; 3,.pds adapted")
       lb1mode = "printoption"
   End Sub
End Class

My VB coding skills are understandable, some euphemysm for quite primitive, but it runs well imho. I made the systems functions (printer handling) at vb6 introduction a couple of years ago. Very useful to others in other contexts.{{

Personal tools