Keskustelu: Ohjelmointikysymykset: VB6 Tulostaminen monena kopiona

'Projektiin referenssi: Microsoft WMI Scripting V1.2 Library
'                      (C:\WNIDOWS\System32\wbem\wbemdisp.tlb)

'Form1
Private MyPrinterName As String
Private MyPrinterDeviceName As String
Private DefaultOrientation As Long
Private DefaultCopies As Long

Private Sub Form_Load()

    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & ".\root\cimv2")

    Set colInstalledPrinters = objWMIService.ExecQuery _
    ("Select * from Win32_Printer Where Default = True")
    For Each objPrinter In colInstalledPrinters
        With objPrinter
            MyPrinterName = .Name
        End With
    Next

    Set objPrinter = objWMIService.Get( _
    "Win32_Printer").SpawnInstance_
    Set colInstalledPrinters = objWMIService.ExecQuery _
    ("Select * from Win32_PrinterConfiguration", , 48)
    For Each objPrinter In colInstalledPrinters
        With objPrinter
            If .Name = MyPrinterName Then
                MyPrinterDeviceName = .DeviceName
            End If
        End With
    Next

    Combo1.Clear
    Combo1.AddItem "Pysty"
    Combo1.AddItem "Vaaka"

    Label1.Caption = CStr(SpinButton1.Value)

    DefaultOrientation = _
    GetPrinterOrientation(MyPrinterName)
    Combo1.ListIndex = DefaultOrientation - 1

    DefaultCopies = _
    GetPrinterCopies(MyPrinterName)
    SpinButton1.Value = DefaultCopies

    Combo1.Enabled = False
    SpinButton1.Enabled = False
    Command1.Enabled = False

End Sub

Private Sub Text1_Change()

    If Trim(Text1.Text) <> "" Then
        Command1.Enabled = True
        Combo1.Enabled = True
        SpinButton1.Enabled = True
    Else
        Command1.Enabled = False
        Combo1.Enabled = False
        SpinButton1.Enabled = False
    End If

End Sub

Private Sub SpinButton1_Change()

    Label1.Caption = CStr(SpinButton1.Value)

End Sub

Private Sub Command1_Click()

    SetPrinterCopies MyPrinterName, _
    SpinButton1.Value
    SetPrinterOrientation MyPrinterName, _
    Combo1.ListIndex + 1
    Dim strFolder As Variant

    strFolder = Environ("userprofile") & _
    "\Työpöytä\MyFolder"

    If Dir(strFolder, vbDirectory) = "" Then
        MkDir (strFolder)
    Else
        On Error Resume Next
        Kill (strFolder & "\*.*")
        If Err <> 0 Then
            Err.Clear
        End If
        On Error GoTo 0
    End If

    Open strFolder & "\temp.txt" For Output As #1
    Print #1, TextBox1.text: Close #1

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(strFolder)
    Set colFiles = objFolder.Items

    For Each objFile In colFiles
       objFile.InvokeVerbEx ("Print")
    Next

    Set colFiles = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing

End Sub

Private Sub Form_QueryUnload( _
Cancel As Integer, UnloadMode As Integer)

    SetPrinterOrientation _
    MyPrinterName, DefaultOrientation

    SetPrinterCopies MyPrinterName, DefaultCopies

End Sub/[koodivb]

[koodivb]'Module1
Option Explicit

Public Type PRINTER_DEFAULTS
   pDatatype As Long
   pDevmode As Long
   DesiredAccess As Long
End Type


Public Type PRINTER_INFO_2
   pServerName As Long
   pPrinterName As Long
   pShareName As Long
   pPortName As Long
   pDriverName As Long
   pComment As Long
   pLocation As Long
   pDevmode As Long
   pSepFile As Long
   pPrintProcessor As Long
   pDatatype As Long
   pParameters As Long
   pSecurityDescriptor As Long
   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 Type DEVMODE
   dmDeviceName As String * 32
   dmSpecVersion As Integer
   dmDriverVersion As Integer
   dmSize As Integer
   dmDriverExtra As Integer
   dmFields As Long
   dmOrientation As Integer
   dmPaperSize As Integer
   dmPaperLength As Integer
   dmPaperWidth As Integer
   dmScale As Integer
   dmCopies As Integer
   dmDefaultSource As Integer
   dmPrintQuality As Integer
   dmColor As Integer
   dmDuplex As Integer
   dmYResolution As Integer
   dmTTOption As Integer
   dmCollate As Integer
   dmFormName As String * 32
   dmUnusedPadding As Integer
   dmBitsPerPel As Integer
   dmPelsWidth As Long
   dmPelsHeight As Long
   dmDisplayFlags As Long
   dmDisplayFrequency As Long
   dmICMMethod As Long
   dmICMIntent As Long
   dmMediaType As Long
   dmDitherType As Long
   dmReserved1 As Long
   dmReserved2 As Long
End Type

Public Const DM_ORIENTATION = &H1
Public Const DM_COPIES = &H100&

Public Const DM_IN_BUFFER = 8
Public Const DM_OUT_BUFFER = 2

Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ALL_ACCESS = _
(STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

'[linkki "http://www.tek-tips.com/faqs.cfm?fid=3604"]lisää vakioita[/linkki]

Public Declare Function ClosePrinter Lib _
"winspool.drv" (ByVal hPrinter As Long) As Long

Public Declare Function DocumentProperties Lib _
"winspool.drv" Alias "DocumentPropertiesA" _
(ByVal hwnd As Long, ByVal hPrinter As Long, _
ByVal pDeviceName As String, ByVal pDevModeOutput As Long, _
ByVal pDevModeInput As Long, ByVal fMode As Long) As Long

Public Declare Function GetPrinter Lib "winspool.drv" _
Alias "GetPrinterA" (ByVal hPrinter As Long, _
ByVal Level As Long, pPrinter As Byte, ByVal cbBuf As Long, _
pcbNeeded As Long) As Long

Public Declare Function OpenPrinter Lib "winspool.drv" _
Alias "OpenPrinterA" (ByVal pPrinterName As String, _
phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long

Public Declare Function SetPrinter Lib "winspool.drv" _
Alias "SetPrinterA" (ByVal hPrinter As Long, _
ByVal Level As Long, pPrinter As Byte, _
ByVal Command As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (pDest As Any, _
pSource As Any, ByVal cbLength As Long)

Public OrgCopies As Integer
Public OrgOrientation As Long
Public OrgDuplex As Long

Public Function GetPrinterCopies( _
ByVal sPrinterName As String) As Long

   Dim hPrinter As Long
   Dim pd As PRINTER_DEFAULTS
   Dim pinfo As PRINTER_INFO_2
   Dim dm As DEVMODE

   Dim yDevModeData() As Byte
   Dim yPInfoMemory() As Byte
   Dim nBytesNeeded As Long
   Dim nRet As Long, nJunk As Long

   On Error GoTo cleanup

   pd.DesiredAccess = PRINTER_ALL_ACCESS
   nRet = OpenPrinter(sPrinterName, hPrinter, pd)
   If (nRet = 0) Or (hPrinter = 0) Then
      If Err.LastDllError = 5 Then
            MsgBox "Access denied"
      Else
            MsgBox "Cannot open the printer specified"
      End If
      Exit Function
   End If

   nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
   If (nRet < 0) Then
      MsgBox "Cannot get the size of the DEVMODE structure."
      GoTo cleanup
   End If

   ReDim yDevModeData(nRet + 100) As Byte
   nRet = DocumentProperties(0, hPrinter, sPrinterName, _
                VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
   If (nRet < 0) Then
      MsgBox "Cannot get the DEVMODE structure."
      GoTo cleanup
   End If

   Call CopyMemory(dm, yDevModeData(0), Len(dm))

   If Not CBool(dm.dmFields And DM_COPIES) Then
      MsgBox "amount of copies may not be modified to this printer"
      GoTo cleanup
   End If

   GetPrinterCopies = dm.dmCopies

cleanup:
   If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function

Public Function SetPrinterCopies(ByVal sPrinterName As String, _
ByVal nCopiesSetting As Long) As Boolean

   Dim hPrinter As Long
   Dim pd As PRINTER_DEFAULTS
   Dim pinfo As PRINTER_INFO_2
   Dim dm As DEVMODE

   Dim yDevModeData() As Byte
   Dim yPInfoMemory() As Byte
   Dim nBytesNeeded As Long
   Dim nRet As Long, nJunk As Long

   On Error GoTo cleanup

   If (nCopiesSetting < 1) Or (nCopiesSetting > 999) Then
      MsgBox "Error: amount of copies is incorrect."
      Exit Function
   End If

   pd.DesiredAccess = PRINTER_ALL_ACCESS
   nRet = OpenPrinter(sPrinterName, hPrinter, pd)
   If (nRet = 0) Or (hPrinter = 0) Then
      If Err.LastDllError = 5 Then
            MsgBox "Access denied!"
      Else
            MsgBox "Cannot open the printer specified"

      End If
      Exit Function
   End If

   nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
   If (nRet < 0) Then
      MsgBox "Cannot get the size of the DEVMODE structure."
      GoTo cleanup
   End If

   ReDim yDevModeData(nRet + 100) As Byte
   nRet = DocumentProperties(0, hPrinter, sPrinterName, _
                VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
   If (nRet < 0) Then
      MsgBox "Cannot get the DEVMODE structure."
      GoTo cleanup
   End If

   Call CopyMemory(dm, yDevModeData(0), Len(dm))

   If Not CBool(dm.dmFields And DM_COPIES) Then
    MsgBox "amount of copies may not be modified for this printer"
      GoTo cleanup
   End If

   dm.dmCopies = nCopiesSetting
   Call CopyMemory(yDevModeData(0), dm, Len(dm))

   nRet = DocumentProperties(0, hPrinter, sPrinterName, _
    VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
    DM_IN_BUFFER Or DM_OUT_BUFFER)

   If (nRet < 0) Then
    MsgBox "Unable to set copies setting to this printer."
    GoTo cleanup
   End If

   Call GetPrinter(hPrinter, 2, 0, 0, nBytesNeeded)
   If (nBytesNeeded = 0) Then GoTo cleanup

   ReDim yPInfoMemory(nBytesNeeded + 100) As Byte

   nRet = GetPrinter(hPrinter, 2, _
   yPInfoMemory(0), nBytesNeeded, nJunk)

   If (nRet = 0) Then
      MsgBox "Unable to get shared printer settings."
      GoTo cleanup
   End If

   Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))
   pinfo.pDevmode = VarPtr(yDevModeData(0))
   pinfo.pSecurityDescriptor = 0
   Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

   nRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)
   If (nRet = 0) Then
      MsgBox "Unable to set shared printer settings."
   End If

   SetPrinterCopies = CBool(nRet)

cleanup:
   If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function


Public Function GetPrinterOrientation( _
ByVal sPrinterName As String) As Long

   Dim hPrinter As Long
   Dim pd As PRINTER_DEFAULTS
   Dim pinfo As PRINTER_INFO_2
   Dim dm As DEVMODE

   Dim yDevModeData() As Byte
   Dim yPInfoMemory() As Byte
   Dim nBytesNeeded As Long
   Dim nRet As Long, nJunk As Long

   On Error GoTo cleanup

   pd.DesiredAccess = PRINTER_ALL_ACCESS
   nRet = OpenPrinter(sPrinterName, hPrinter, pd)
   If (nRet = 0) Or (hPrinter = 0) Then
      If Err.LastDllError = 5 Then
            MsgBox "Access denied"
      Else
            MsgBox "Cannot open the printer specified"
      End If
      Exit Function
   End If

   nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
   If (nRet < 0) Then
      MsgBox "Cannot get the size of the DEVMODE structure."
      GoTo cleanup
   End If

   ReDim yDevModeData(nRet + 100) As Byte
   nRet = DocumentProperties(0, hPrinter, sPrinterName, _
                VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
   If (nRet < 0) Then
      MsgBox "Cannot get the DEVMODE structure."
      GoTo cleanup
   End If

   Call CopyMemory(dm, yDevModeData(0), Len(dm))

   If Not CBool(dm.dmFields And DM_ORIENTATION) Then
      MsgBox "orientation may not be modified to this printer"
      GoTo cleanup
   End If

   GetPrinterOrientation = dm.dmOrientation

cleanup:
   If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function

Public Function SetPrinterOrientation(ByVal sPrinterName As String, _
ByVal nOrientationSetting As Long) As Boolean

   Dim hPrinter As Long
   Dim pd As PRINTER_DEFAULTS
   Dim pinfo As PRINTER_INFO_2
   Dim dm As DEVMODE

   Dim yDevModeData() As Byte
   Dim yPInfoMemory() As Byte
   Dim nBytesNeeded As Long
   Dim nRet As Long, nJunk As Long

   On Error GoTo cleanup

   If (nOrientationSetting < 1) Or (nOrientationSetting > 2) Then
      MsgBox "Error: orientation is incorrect."
      Exit Function
   End If

   pd.DesiredAccess = PRINTER_ALL_ACCESS
   nRet = OpenPrinter(sPrinterName, hPrinter, pd)
   If (nRet = 0) Or (hPrinter = 0) Then
      If Err.LastDllError = 5 Then
            MsgBox "Access denied!"
      Else
            MsgBox "Cannot open the printer specified "
      End If
      Exit Function
   End If

   nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
   If (nRet < 0) Then
      MsgBox "Cannot get the size of the DEVMODE structure."
      GoTo cleanup
   End If

   ReDim yDevModeData(nRet + 100) As Byte
   nRet = DocumentProperties(0, hPrinter, sPrinterName, _
                VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
   If (nRet < 0) Then
      MsgBox "Cannot get the DEVMODE structure."
      GoTo cleanup
   End If

   Call CopyMemory(dm, yDevModeData(0), Len(dm))

   If Not CBool(dm.dmFields And DM_ORIENTATION) Then
      MsgBox "orientation may not be modified to this printer"
      GoTo cleanup
   End If

   dm.dmOrientation = nOrientationSetting
   Call CopyMemory(yDevModeData(0), dm, Len(dm))

   nRet = DocumentProperties(0, hPrinter, sPrinterName, _
    VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
    DM_IN_BUFFER Or DM_OUT_BUFFER)

   If (nRet < 0) Then
    MsgBox "Unable to set orientation setting to this printer."
    GoTo cleanup
   End If

   Call GetPrinter(hPrinter, 2, 0, 0, nBytesNeeded)
   If (nBytesNeeded = 0) Then GoTo cleanup

   ReDim yPInfoMemory(nBytesNeeded + 100) As Byte

   nRet = GetPrinter(hPrinter, 2, _
   yPInfoMemory(0), nBytesNeeded, nJunk)
   If (nRet = 0) Then
      MsgBox "Unable to get shared printer settings."
      GoTo cleanup
   End If

   Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))
   pinfo.pDevmode = VarPtr(yDevModeData(0))
   pinfo.pSecurityDescriptor = 0
   Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

   nRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)
   If (nRet = 0) Then
      MsgBox "Unable to set shared printer settings."
   End If

   SetPrinterOrientation = CBool(nRet)

cleanup:
   If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function