Programalama > VISUAL BASIC

Hazırladığınız programda hem nokta vuruşlu hem de lazer veya mürekkep püskürtmeli kaliteli yazıcıyı birlikte kullanmanız gerekiyorsa hangi formda hangi yazıcının varsayılan olarak kullanılmasını kod ile düzenleyebilirsiniz. Bunun için veritabanınıza yazıcı ile ilgili alanlar açıp bunların değerlerini formunuza getirip aşağıdaki kodları kullanarak bu işlemi yapabilirsiniz. Böylelikle bilgisayardan çok fazla anlamayan kullanıcıya, varsayılan yazıcıyı formlara göre değiştirme işleminde büyük bir kolaylık sağlarsınız. Kullanıcı yerine bu işlemi programcı olarak siz yapabilirsiniz. Form üzerine 1 adet Text Box, 1 Adet List Box ve 1 Adet Command Button koyun, Formun kod sayfasına aşağıdaki kodları yapıştırın. Text Box içerisine yazdığınız yazıcı adı bu form ile kullanacağınız yazıcı olmalıdır.
Option Explicit

Private Function PtrCtoVbString(Add As Long) As String
Dim sTemp As String * 512, x As Long

x = lstrcpy(sTemp, Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
    PtrCtoVbString = ""
Else
    PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If
End Function

Private Sub SetDefaultPrinter(ByVal PrinterName As String, _
ByVal DriverName As String, ByVal PrinterPort As String)

Dim DeviceLine As String
Dim r As Long
Dim l As Long
DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
'''' Tanımlayacağınız yazıcı bilgilerini WINDOWS içerisindeki 
'''' WIN.INI Dosyasındaki DEVICE parametresine yazdırın.
r = WriteProfileString("windows", "Device", DeviceLine)
'''' WIN.INI Dosyasının açılan uygulamalara yüklenmesini sağlar
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
End Sub

Private Sub Win95SetDefaultPrinter()
Dim Handle As Long          
Dim PrinterName As String
Dim pd As PRINTER_DEFAULTS
Dim x As Long
Dim need As Long            
Dim pi5 As PRINTER_INFO_5   
Dim LastError As Long

'''' Seçilecek yazıcının tanımlanması
PrinterName = Text1.Text
If PrinterName = "" Then
    Exit Sub
End If
'''' PRINTER_VARSAYILAN değerlerinin ayarlanması
pd.pDatatype = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess
'''' Yazıcı tutmaç bilgisini alın
x = OpenPrinter(PrinterName, Handle, pd)
If x = False Then
    '''' Tutmaç bilgisinde hata varsa sistemden çıkın.
    Exit Sub
End If

'''' Make an initial call to GetPrinter, requesting Level 5
'''' (PRINTER_INFO_5) information, to determine how many bytes you need
x = GetPrinter(Handle, 5, ByVal 0&, 0, need)
'''' don''''t want to check Err.LastDllError here - it''''s supposed to fail
'''' with a 122 - ERROR_INSUFFICIENT_BUFFER
'''' redim t as large as you need
ReDim t((need \ 4)) As Long

'''' and call GetPrinter for keepers this time
x = GetPrinter(Handle, 5, t(0), need, need)
'''' failed the GetPrinter
If x = False Then
    ''''error handler code goes here
    Exit Sub
End If

'''' set the members of the pi5 structure for use with SetPrinter.
'''' PtrCtoVbString copies the memory pointed at by the two string
'''' pointers contained in the t() array into a Visual Basic string.
'''' The other three elements are just DWORDS (long integers) and
'''' don''''t require any conversion
pi5.pPrinterName = PtrCtoVbString(t(0))
pi5.pPortName = PtrCtoVbString(t(1))
pi5.Attributes = t(2)
pi5.DeviceNotSelectedTimeout = t(3)
pi5.TransmissionRetryTimeout = t(4)

'''' this is the critical flag that makes it the default printer
pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT

'''' call SetPrinter to set it
x = SetPrinter(Handle, 5, pi5, 0)

If x = False Then   '''' SetPrinter failed
    MsgBox "SetPrinter Failed. Error code: " & Err.LastDllError
    Exit Sub
Else
    If Printer.DeviceName <> Text1.Text Then
    '''' Make sure Printer object is set to the new printer
        SelectPrinter (Text1.Text)
    End If
End If

'''' and close the handle
ClosePrinter (Handle)
End Sub

Private Sub GetDriverAndPort(ByVal Buffer As String, DriverName As String, PrinterPort As String)
Dim iDriver As Integer
Dim iPort As Integer
DriverName = ""
PrinterPort = ""

'''' The driver name is first in the string terminated by a comma
iDriver = InStr(Buffer, ",")
If iDriver > 0 Then

    '''' Strip out the driver name
    DriverName = Left(Buffer, iDriver - 1)
 
    '''' The port name is the second entry after the driver name separated by commas.
    iPort = InStr(iDriver + 1, Buffer, ",")

    If iPort > 0 Then
    '''' Strip out the port name
        PrinterPort = Mid(Buffer, iDriver + 1, _
        iPort - iDriver - 1)
    End If
End If
End Sub

Private Sub ParseList(lstCtl As Control, ByVal Buffer As String)
Dim i As Integer
Dim s As String
Do
i = InStr(Buffer, Chr(0))
If i > 0 Then
    s = Left(Buffer, i - 1)
    If Len(Trim(s)) Then lstCtl.AddItem s
        Buffer = Mid(Buffer, i + 1)
    Else
        If Len(Trim(Buffer)) Then lstCtl.AddItem Buffer
            Buffer = ""
        End If

Loop While i > 0
End Sub
 
Private Sub WinNTSetDefaultPrinter()
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
Dim PrinterName As String
Dim r As Long

Buffer = Space(1024)
PrinterName = Text1.Text
r = GetProfileString("PrinterPorts", PrinterName, "", Buffer, Len(Buffer))
'''' Parse the driver name and port name out of the buffer
GetDriverAndPort Buffer, DriverName, PrinterPort

If DriverName <> "" And PrinterPort <> "" Then
    SetDefaultPrinter Text1.Text, DriverName, PrinterPort
    If Printer.DeviceName <> Text1.Text Then
    '''' Make sure Printer object is set to the new printer
        SelectPrinter (Text1.Text)
    End If
End If
End Sub
 
Private Sub Command1_Click()
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer

osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)

If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
    Call Win95SetDefaultPrinter
Else
'''' This assumes that future versions of Windows use the NT method
    Call WinNTSetDefaultPrinter
End If
End Sub

Private Sub Form_Load()
Dim r As Long
Dim Buffer As String

'''' Get the list of available printers from WIN.INI
Buffer = Space(8192)
r = GetProfileString("PrinterPorts", vbNullString, "", Buffer, Len(Buffer))

'''' Display the list of printer in the ListBox List1
ParseList List1, Buffer
End Sub


	Form1 içerisinde kullanılan API ve Functionları ise ekleyeceğiniz 1 modül içerisinde tanımlamanız gerekir. Bunun için aşağıdaki kodları 1 modül içerisine yapıştırın.

Option Explicit
Public Const HWND_BROADCAST = &HFFFF
Public Const WM_WININICHANGE = &H1A

'''' constants for DEVMODE structure
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32

'''' constants for DesiredAccess member of PRINTER_DEFAULTS
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

'''' constant that goes into PRINTER_INFO_5 Attributes member to set it as default
Public Const PRINTER_ATTRIBUTE_DEFAULT = 4

'''' Constant for OSVERSIONINFO.dwPlatformId
Public Const VER_PLATFORM_WIN32_WINDOWS = 1

Public Type OSVERSIONINFO
     dwOSVersionInfoSize As Long
     dwMajorVersion As Long
     dwMinorVersion As Long
     dwBuildNumber As Long
     dwPlatformId As Long
     szCSDVersion As String * 128
End Type

Public Type DEVMODE
      dmDeviceName As String * CCHDEVICENAME
      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 * CCHFORMNAME
      dmLogPixels As Integer
      dmBitsPerPel As Long
      dmPelsWidth As Long
      dmPelsHeight As Long
      dmDisplayFlags As Long
      dmDisplayFrequency As Long
      dmICMMethod As Long        '''' // Windows 95 only
      dmICMIntent As Long        '''' // Windows 95 only
      dmMediaType As Long        '''' // Windows 95 only
      dmDitherType As Long       '''' // Windows 95 only
      dmReserved1 As Long        '''' // Windows 95 only
      dmReserved2 As Long        '''' // Windows 95 only
End Type

Public Type PRINTER_INFO_5
      pPrinterName As String
      pPortName As String
      Attributes As Long
      DeviceNotSelectedTimeout As Long
      TransmissionRetryTimeout As Long
End Type

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

Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" _
(ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As String) As Long

Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer

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 Any, ByVal Command As Long) As Long

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

Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByVal lpString2 As Any) As Long

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

Public Sub SelectPrinter(NewPrinter As String)
Dim Prt As Printer
For Each Prt In Printers
    If Prt.DeviceName = NewPrinter Then
        Set Printer = Prt
        Exit For
    End If
Next
End Sub


Yorumlar                 Yorum Yaz
balbasy (0) Sakıncalı Yorum 13 December 23:17
Hey gidi günler bu kodu yazdığımda takvim 2005'i gösteriyordu. Balbasy-Balıkesir
Ozan-Ilgun (3) Sakıncalı Yorum 03 April 22:34
Hiç gerek yok okadar koda . tek bir satırla halledilebilir Application.Dialogs(xlDialogPrint).Show
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.