formpdf.frm

text生成pdf文件

VERSION 5.00
Begin VB.Form formConvertToPDF 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Text-PDF v1.0"
   ClientHeight    =   6090
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   6630
   Icon            =   "formPDF.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6090
   ScaleWidth      =   6630
   StartUpPosition =   1  'CenterOwner
   Begin VB.ComboBox cmbPageSize 
      Height          =   315
      ItemData        =   "formPDF.frx":08CA
      Left            =   3540
      List            =   "formPDF.frx":08D7
      Style           =   2  'Dropdown List
      TabIndex        =   26
      Top             =   5040
      Width           =   1065
   End
   Begin VB.ComboBox cmbFontSize 
      Height          =   315
      ItemData        =   "formPDF.frx":08FE
      Left            =   2160
      List            =   "formPDF.frx":0917
      Style           =   2  'Dropdown List
      TabIndex        =   17
      Top             =   5040
      Width           =   690
   End
   Begin VB.ComboBox cmbRotation 
      Height          =   315
      ItemData        =   "formPDF.frx":0944
      Left            =   2835
      List            =   "formPDF.frx":0954
      Style           =   2  'Dropdown List
      TabIndex        =   18
      Top             =   5040
      Width           =   690
   End
   Begin VB.ComboBox cmbFont 
      Height          =   315
      ItemData        =   "formPDF.frx":096D
      Left            =   120
      List            =   "formPDF.frx":097A
      Style           =   2  'Dropdown List
      TabIndex        =   16
      Top             =   5040
      Width           =   2055
   End
   Begin VB.Frame frmSep 
      Height          =   120
      Left            =   -60
      TabIndex        =   23
      Top             =   5385
      Width           =   6765
   End
   Begin VB.CommandButton btnClose 
      Cancel          =   -1  'True
      Caption         =   "Close"
      Height          =   420
      Left            =   5190
      TabIndex        =   21
      Top             =   5580
      Width           =   1350
   End
   Begin VB.Frame frmTitle 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   1020
      Left            =   -45
      TabIndex        =   20
      Top             =   -15
      Width           =   6720
      Begin VB.Label lblCaption 
         BackColor       =   &H00FFFFFF&
         Caption         =   "Convert Text to PDF"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   18
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   585
         Left            =   210
         TabIndex        =   22
         Top             =   225
         Width           =   5025
      End
      Begin VB.Image imgIcon 
         Height          =   630
         Left            =   5715
         Picture         =   "formPDF.frx":099B
         Stretch         =   -1  'True
         Top             =   135
         Width           =   570
      End
   End
   Begin VB.TextBox txtTitle 
      Height          =   360
      Left            =   1470
      TabIndex        =   9
      Top             =   3045
      Width           =   5100
   End
   Begin VB.CommandButton btnConvert 
      Caption         =   "&Produce PDF"
      Default         =   -1  'True
      Height          =   420
      Left            =   3750
      TabIndex        =   19
      Top             =   5580
      Width           =   1350
   End
   Begin VB.CommandButton btnSave 
      Caption         =   "Br&owse.."
      Height          =   330
      Left            =   4980
      TabIndex        =   15
      Top             =   5010
      Width           =   1560
   End
   Begin VB.TextBox txtOutputFile 
      Height          =   345
      Left            =   120
      TabIndex        =   14
      Top             =   4650
      Width           =   6420
   End
   Begin VB.CommandButton btnOpen 
      Caption         =   "&Browse.."
      Height          =   330
      Left            =   4980
      TabIndex        =   12
      Top             =   4140
      Width           =   1560
   End
   Begin VB.TextBox txtFilename 
      Height          =   345
      Left            =   120
      TabIndex        =   11
      Top             =   3780
      Width           =   6420
   End
   Begin VB.TextBox txtSubject 
      Height          =   360
      Left            =   1470
      TabIndex        =   7
      Top             =   2565
      Width           =   5100
   End
   Begin VB.TextBox txtKeywords 
      Height          =   360
      Left            =   1470
      TabIndex        =   5
      Top             =   2100
      Width           =   5100
   End
   Begin VB.TextBox txtCreator 
      Height          =   360
      Left            =   1470
      TabIndex        =   3
      Top             =   1635
      Width           =   5100
   End
   Begin VB.TextBox txtAuthor 
      Height          =   360
      Left            =   1470
      TabIndex        =   1
      Top             =   1185
      Width           =   5100
   End
   Begin VB.Label lblCredits 
      Caption         =   "Based on code posted by NaramCheez"
      ForeColor       =   &H00808080&
      Height          =   210
      Index           =   1
      Left            =   75
      TabIndex        =   25
      ToolTipText     =   "http://naramcheez.netfirms.com"
      Top             =   5880
      Width           =   2835
   End
   Begin VB.Label lblCredits 
      Caption         =   "2002 by Aldo Vargas"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   345
      Index           =   0
      Left            =   75
      TabIndex        =   24
      ToolTipText     =   "http://www.aldostools.com/"
      Top             =   5610
      Width           =   3450
   End
   Begin VB.Label lblTitle 
      Alignment       =   1  'Right Justify
      Caption         =   "Title"
      Height          =   255
      Left            =   150
      TabIndex        =   8
      Top             =   3090
      Width           =   1230
   End
   Begin VB.Label lblOutputFile 
      Caption         =   "Output File:"
      Height          =   225
      Left            =   120
      TabIndex        =   13
      Top             =   4425
      Width           =   2895
   End
   Begin VB.Label lblFilename 
      Caption         =   "Input File:"
      Height          =   240
      Left            =   135
      TabIndex        =   10
      Top             =   3525
      Width           =   2895
   End
   Begin VB.Label lblSubject 
      Alignment       =   1  'Right Justify
      Caption         =   "Subject:"
      Height          =   255
      Left            =   150
      TabIndex        =   6
      Top             =   2610
      Width           =   1230
   End
   Begin VB.Label lblKeyword 
      Alignment       =   1  'Right Justify
      Caption         =   "Keywords:"
      Height          =   255
      Left            =   150
      TabIndex        =   4
      Top             =   2145
      Width           =   1230
   End
   Begin VB.Label lblCreator 
      Alignment       =   1  'Right Justify
      Caption         =   "Creator:"
      Height          =   255
      Left            =   150
      TabIndex        =   2
      Top             =   1680
      Width           =   1230
   End
   Begin VB.Label lblAuthor 
      Alignment       =   1  'Right Justify
      Caption         =   "Author Name:"
      Height          =   255
      Left            =   150
      TabIndex        =   0
      Top             =   1230
      Width           =   1230
   End
End
Attribute VB_Name = "formConvertToPDF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
    
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules
Private Const OFN_EXPLORER = &H80000 ' new look commdlg
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000 ' force long names for 3.x modules
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0


Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Dim Position As Long
Dim pageNo As Long
Dim lineNo As Long
Dim pageHeight As Long
Dim pageWidth As Long
Dim location(1 To 5000) As Long
Dim pageObj(1 To 5000) As Long
Dim lines As Long
Dim obj As Long
Dim Tpages As Long
Dim encoding As Long
Dim resources As Long
Dim pages As Variant
Dim author As String
Dim creator As String
Dim keywords As String
Dim subject As String
Dim Title As String
Dim BaseFont As String
Dim pointSize As Currency
Dim vertSpace As Currency
Dim rotate As Integer
Dim info As Long
Dim root As Long
Dim npagex As Double
Dim npagey As Long
Dim filetxt As String
Dim filepdf As String
Dim linelen As Long
Dim cache As String
Dim cmdline As String

Const AppName = "Text-PDF v1.0"

Private Sub Form_Load()
  txtCreator.Text = AppName
  cmbFont.ListIndex = 1
  cmbFontSize.ListIndex = 1
  cmbRotation.ListIndex = 0
  cmbPageSize.ListIndex = 0

  cmdline = LCase(Command)
  If cmdline Like """*""" Then
    cmdline = Mid(cmdline, 2, Len(cmdline) - 2)
  End If
  
  If FileExists(cmdline) Then
    txtFilename.Text = cmdline
    txtOutputFile.Text = Left(cmdline, Len(cmdline) - 4) & ".pdf"
    btnConvert_Click
  End If
End Sub

Private Sub lblCredits_Click(Index As Integer)
  On Error Resume Next
  ShellExecute 0, vbNullString, lblCredits(Index).ToolTipText, vbNullString, vbNullString, 1
End Sub

Private Sub txtAuthor_GotFocus()
  txtAuthor.SelStart = 0
  txtAuthor.SelLength = Len(txtAuthor.Text)
End Sub

Private Sub txtCreator_GotFocus()
  txtCreator.SelStart = 0
  txtCreator.SelLength = Len(txtCreator.Text)
End Sub

Private Sub txtSubject_GotFocus()
  txtSubject.SelStart = 0
  txtSubject.SelLength = Len(txtSubject.Text)
End Sub

Private Sub txtTitle_GotFocus()
  txtTitle.SelStart = 0
  txtTitle.SelLength = Len(txtTitle.Text)
End Sub

Private Sub txtKeywords_GotFocus()
  txtKeywords.SelStart = 0
  txtKeywords.SelLength = Len(txtKeywords.Text)
End Sub

Private Sub txtFilename_GotFocus()
  txtFilename.SelStart = 0
  txtFilename.SelLength = Len(txtFilename.Text)
End Sub

Private Sub txtOutputFile_GotFocus()
  txtOutputFile.SelStart = 0
  txtOutputFile.SelLength = Len(txtOutputFile.Text)
End Sub

Private Sub btnClose_Click()