CODIGO OBJETO PARTE 1-
Esta es la primera parte del objeto
' A very simple printer object used to send data directly
' to the printer.
'
' Date Notes
' 1-12-97Written by
[email protected]
Private Const JOB_POSITION_UNSPECIFIED = 0
Private Const MAX_PRIORITY = 99
Private Const MIN_PRIORITY = 1
Private Const DEF_PRIORITY = 1
Private Const JOB_CONTROL_PAUSE = 1
Private Const JOB_CONTROL_RESUME = 2
Private Const JOB_CONTROL_CANCEL = 3
Private Const JOB_CONTROL_RESTART = 4
Private Const JOB_CONTROL_DELETE = 5
'Crear impresora
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
Public Enum PrinterErrors
vbPE_CantOpenPrinter = 2000 ' Can't Open the printer device.
vbPE_CantStartJob ' Can't Start the print job.
vbPE_CantStartPage' Can't start printing a page.
vbPE_UnSentBytes' Some bytes were not successfully sent to the printer.
vbPE_KillDocFailed' Could not cancel the print job.
vbPE_CantChangeName ' Can't change document name.
vbPE_FailedWrite' Failed write to printer.
vbPE_ReadFileError' Could not read from file.
vbPE_CantEndPage' Call to end page failed.
vbPE_CantEndDoc ' Call to close doc failed.
vbPE_CantChangeDevice ' Can't change device while printing.
vbPE_CantCreateDC ' Can't create a device context.
End Enum
Private lPrinter As Long ' Printer handle
Private lBytesWritten As Long' Number of bytes written
Private lBytesSent As Long ' Number of bytes that should have been written.
Private lJob As Long ' Print job handle
Private sDocName As String ' Name of the document
Private sDeviceName As String' Device name.
Private bJobStarted As Boolean ' Have we started a print job.
Private ErrorImpesion As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_INFO_2) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As Any) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function SetJob Lib "winspool.drv" Alias "SetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, pJob As Any, ByVal Command As Long) As Long
Private Declare Function GetJob Lib "winspool.drv" Alias "GetJobA" (ByVal hPrinter As Long, ByVal JobId As Long, ByVal Level As Long, pJob As Any, ByVal cdBuf As Long, pcbNeeded As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long
Private Declare Function AddPrinter Lib "winspool.drv" Alias "AddPrinterA" (ByVal pName As String, ByVal Level As Long, pPrinter As PRINTER_INFO_2) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As String) As Long
'Creado por marco
Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Private Type DOC_INFO_1
pDocName As String
pOutputFile As String
pDatatype As String
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type JOB_INFO_1
JobId As Long
pPrinterName As String
pMachineName As String
pUserName As String
pDocument As String
pDatatype As String
pStatus As String
Status As Long
Priority As Long
Position As Long
TotalPages As Long
PagesPrinted As Long
Submitted As SYSTEMTIME
End Type
Private Type PRINTER_INFO_2
pServerName As Long 'String
pPrinterName As Long 'String
pShareName As Long 'String
pPortName As String
pDriverName As Long 'String
pComment As Long 'String
pLocation As Long 'String
pDevMode As Long ' DEVMODE
pSepFile As Long 'String
pPrintProcessor As Long 'String
pDatatype As Long 'String
pParameters As Long 'String
pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type
Public Sub NewPage()
If Not bJobStarted Then
NewDoc
Else
'end last page
If EndPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantEndPage, "RAWPrinter", "Can't end page."
Exit Sub
End If
If StartPagePrinter(lPrinter) <= 0 Then
Call EndDocPrinter(lPrinter)
Call ClosePrinter(lPrinter)
bJobStarted = False
Err.Raise vbPE_CantStartPage, "RAWPrinter", "Can't start page."
Exit Sub
End If
End If
End Sub
Sub NewDoc(Optional DocName As String = "", Optional FileName As String = vbNullString)
Dim di As DOC_INFO_1
Dim InfImprsora As PRINTER_INFO_2
Dim Errores
ErrorImpesion = False
Reintentar1:
If bJobStarted Then
EndDoc
End If
If OpenPrinter(sDeviceName, lPrinter, InfImprsora) <= 0 Then
'Err.Raise vbPE_CantOpenPrinter, "RAWPrinter", "Can't Open Printer Device"
'Exit Sub
Call ClosePrinter(lPrinter)
With FormOtraImpresora
.Mensaje ("Impresora no disponible seleccione otra impresora")
.Show 1
sDeviceName = .Impresora
End With
If Len(DeviceName) = 0 Then
ErrorImpesion = True
Exit Sub
End If
GoTo Reintentar1
End If
If DocName <> "" Then
sDocName = DocName
End If
di.pDocName = sDocName & vbNullChar
If FileName = vbNullString Then
di.pOutputFile = FileName
Else
di.pOutputFile = FileName & vbNullChar
End If
di.pDatatype = "RAW" & vbNullChar
lJob = StartDocPrinter(lPrinter, 1, di)
If lJob <= 0 Then
Call ClosePrinter(lPrinter)
With FormOtraImpresora
.Mensaje ("La impresora[" & sDeviceName & "] No esta Disponible, Verificar Conectividad o Seleccione otra impresora")
.Show 1
sDeviceName = .Impresora
End With
If Len(DeviceName) = 0 Then
ErrorImpesion = True
Exit Sub
End If
GoTo Reintentar1
End If