~~ VERİ TİPLERİ VE DEFAULT PRINTER YAPILANDIRMA ~~

64 bit Office kurulu sistemde API deklarasyonu belasına alternatif olarak yapılandırmanın Registry' dan binary (ikili) veri okuyup değiştirme üzerinedir.


VB' de aşağıdaki tabloda görünen veri tipleri bulunur ve tanımlandıklarında "Storage size" kadar bellekte yer kaplarlar.



VERİ TİPLERİ:

Byte          : En küçük veri tipidir. 0-255 arası değer alabilir. Bir byte = 8 bit olduğundan 255 değeri 2^8-1' den gelmektedir.
Booelan    : Görüntüsü True ve False olsa da, 2 byte yer kapladığından alabileceği sayı değeri integer ile aynıdır. 2 byte = 16 bit olduğuna göre, numerik değer verildiğinde -2^16 ile 2^16-1 kadar sayı da tutabilir.
Integer     : Bu da 2 byte yer kaplar. Kısa tamsayılar içindir. Alabileceği sayı değeri Boolean ile aynıdır. Yani; -2^16 ile 2^16-1 kadar sayı da tutabilir.
Long         : 4 byte yer kaplar. Uzun tamsayılar içindir. 4 byte = 32 bit olduğundan alabileceği sayı değeri -2^32  ile 2^32-1 aralığındadır.
LongLong : 8 byte yer kaplar. Çok büyük tamsayılar içindir. 8 byte = 64 bit olduğundan alabileceği sayı değeri -2^64  ile 2^64-1 aralığındadır. Bu tip, 64 bit sistemlerde genelde API handle ve pointer için gelmiş yeni nesil Long tipidir.
LongPtr    : Hem 32, hem de 64 bit uyumluluğu olan tipdir. 32 bitte 4 byte, 64 bitte 8 byte yer kaplar. Bu da yeni nesil Long tipidir.
Single      : Tek duyarlı ondalık sayı tipidir. 4 byte yer kaplar. Kısa ondalık sayıları tutar.
Double     : Çift duyarlı ondalık sayı tipidir. 8 byte yer kaplar. Büyük ondalık sayıları tutar. Currency de aynıdır.
String       : Metin tutar. 2 byte yer kaplar.


BYTE ARRAY VE TİPE DÖNÜŞÜM FONKSİYONLARI:

Veri tipleri bellekte byte olarak dururlar. Byte, adından da anlaşıldığı tek byte dır. Yani tek elemanlı bir array.

Array = {10} gibi.

String tipi 2 byte dır. Yani iki elemanlı bir array. Örneğin "ABC" metni için 2 byte X 3 karakter = 6 elemanlı array için array dizisi aşağıdaki gibi olacaktır.

Array = {65, 0, 66, 0, 67, 0}

Her karakteri ikinci byte ı "0" olacak diye bir kural yoktur. Türkçe harfler ve özel karakterlerin ikinci bytle ları "0" dan farklı bir sayı olabilir. Unutmayın ki, konu byte array olduğundan bu sayılar hep 0-255 arası olacaktır. Örneğin "Ş" harfi için byte array aşağıdaki gibi olacaktır.

Array = {30, 1}

Metinlerde byte dizisi orantılıdır. Ancak sayılarda durum farklıdır. Her sayı tipi kapladığı byte kadar yer kaplar. Örneğin bir Integer tipine 10 da atansa, 10000 de atansa kapladığı bellek 2 byte dır. Yani byte dizisi hep iki elemanlıdır. Bu iki eleman 0-255 arası değerler alarak bellektten Integer bir sayı olarak bize görünürler.

Birkaç Integer örneği:

1453  için => Array = {173, 5}

478    için => Array = {222, 1}

12750 için => Array {206, 49}



Şimdi bu sayıları Long tipinde çevirelim:

1453  için => Array = {173, 5, 0, 0}

478    için => Array = {222, 1, 0, 0}

12750 için => Array {206, 49, 0, 0}

78980 için => Array {132, 52, 1, 0}



Dönüşüm fonksiyonlarını ister kullanıcı fonksiyonuyla, isterse CopyMemory API ile yapabiliriz. Aşağıdaki kodları boş modulde "test" isimli prosedurleri çalıştırarak sonuçları görebilirsiniz.

#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, _
        ByRef Source As Any, _
        ByVal Length As Long)
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, _
        ByRef Source As Any, _
        ByVal Length As Long)
#End If


Private Function ByteToInt(Bytes() As Byte, ByVal StartWithIndex As Integer) As Integer
    ' CopyMemory (Hedef, Kaynak dizinin başlangıç indexi, Kaç karakter(byte) kopyalanacak)
    CopyMemory ByteToInt, Bytes(StartWithIndex), 2 ' Long tipi 4, Integer 2 byte dır
End Function

Private Function ByteToInt2(Bytes() As Byte) As Integer
' Bytes, 2 elemanlı olacak. Base 0 veya 1 önemli değil
    Dim s As Integer
    
    arr = Array(0, 8) ' 8 bit ve katları
    
    For i = LBound(Bytes) To UBound(Bytes)
        ByteToInt2 = ByteToInt2 + Bytes(i) * 2 ^ arr(s)
        s = s + 1
    Next
End Function

Private Function ByteToLong(Bytes() As Byte, ByVal StartWithIndex As Integer) As Long
    CopyMemory ByteToLong, Bytes(StartWithIndex), 4 ' Long tipi 4, Integer 2 byte dır
End Function

Private Function ByteToLong2(Bytes() As Byte) As Long
' Bytes, 4 elemanlı olacak. Base 0 veya 1 önemli değil
    Dim s As Integer
    
    arr = Array(0, 8, 16, 24) ' 8 bit ve katları
    
    For i = LBound(Bytes) To UBound(Bytes)
        ByteToLong2 = ByteToLong2 + Bytes(i) * 2 ^ arr(s)
        s = s + 1
    Next
End Function

Private Sub IntToByte(Bytes() As Byte, ByVal StartWithIndex As Integer, ByVal NewValue As Integer)
    CopyMemory Bytes(StartWithIndex), NewValue, 2 ' Long tipi 4, Integer 2 byte dır
End Sub

Private Sub LongToByte(Bytes() As Byte, ByVal StartWithIndex As Integer, ByVal NewValue As Long)
    CopyMemory Bytes(StartWithIndex), NewValue, 4 ' Long tipi 4, Integer 2 byte dır
End Sub

Private Function StringToByte(ByVal txt As String) As Byte()
    StringToByte = txt
End Function

Private Function ByteToString(Bytes() As Byte) As String
    ByteToString = Bytes
End Function

Sub test1()
' Byte dan String e
    Dim b(1 To 2) As Byte, txt As String
    
    b(1) = 65
    b(2) = 0
    
    Debug.Print ByteToString(b)
End Sub

Sub test2()
' String den Byte dizisine
    For Each m In StringToByte("Merhaba")
        Debug.Print m
    Next
End Sub

Sub test3()
' Byte dan Long a
    Dim b(1) As Byte

    b(0) = 173: b(1) = 5
    
    Debug.Print ByteToLong2(b)
End Sub

Sub test4()
' Integer dan Byte dizisine
    Dim b(1 To 2) As Byte ' Integer olacağı için 2 elemanlı olacak
    
    Call IntToByte(b, 1, 1453)
    
    For Each m In b
        Debug.Print m
    Next
End Sub

Sub test5()
' Long dan Byte dizisine
    Dim b(1 To 4) As Byte ' Long olacağı için 4 elemanlı olacak
    
    Call LongToByte(b, 1, -104564)
    
    For Each m In b
        Debug.Print m
    Next
End Sub

BASİT BİR PRINTER SINIFI HAZIRLAMA:

Bu bilgilerle bir yazıcının Registry daki Binary tipinde verileri okuyup değiştirebiliriz. Yalnız bu ayar, rastgele yazılmış bir veri değildir. DEVMODE (DeviceMode) isminde bir structure (Type) ile tutulur. DEVMODE uzunluğu 212 byte dır. Toplam uzunluk 9000 küsür byte dır. Windows NT ile beraber ilk 212 byte Windows a, kalanı yazıcı sürücüsüne aittir.

Private Type DEVMODE
    dmDeviceName        As String * 32 ' 1  to 64 byte
    dmSpecVersion       As Integer     ' 65 to 66 byte
    dmDriverVersion     As Integer     ' 67 to 68 byte
    dmSize              As Integer     ' 69 to 70 byte
    dmDriverExtra       As Integer     ' 71 to 72 byte
    dmFields            As Long        ' 73 to 76 byte --> Long 4 byte dır hatırlayın
    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


Ve, Printer Sınıfı : 

Option Explicit

Public Enum zgOrientation
    zgPORTRAIT = 1
    zgLANDSCAPE = 2
End Enum

Public Enum zgPaperSize
    zgLETTER_8_5x11 = 1
    zgLETTER_SMALL_8_x11 = 2
    zgA3_297x420 = 8
    zgA4_210x297 = 9
    zgA4_SMALL_210x297 = 10
    zgA5_148x210 = 11
    zgB4_250x354 = 12
    zgB5_182x257 = 13
    zgUSER_DEFINED = 256 ' Kullanıcı tanımlı
    ' Liste çok uzun...
End Enum

Public Enum zgPrintQuality
    zgDRAFT = 1
    zgLOW = 2
    zgMEDIUM = 3
    zgHIGH = 4
    ' veya çözünürlük değeri : 600 -> dpi gibi
End Enum

Public Enum zgColor
    zgCOLORS = 1
    zgMONOCHROME = 2
End Enum

Public Enum zgDuplex
    zgSIMPLEX = 1
    zgHORIZANTAL = 2
    zgVERTICAL = 3
End Enum

Public Enum zgCollate
    zgFALSE = 0
    zgTRUE = 1
End Enum

Private mPort          As String
Private mDeviceName    As String
Private mOrientation   As zgOrientation
Private mPaperSize     As zgPaperSize
Private mCopies        As Integer
Private mPrintQuality  As zgPrintQuality
Private mColor         As zgColor
Private mDuplex        As zgDuplex
Private mCollate       As zgCollate
Private mFormName      As String ' Kullanıcı tanımlı kağıt

#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, _
        ByRef Source As Any, _
        ByVal Length As Long)
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, _
        ByRef Source As Any, _
        ByVal Length As Long)
#End If

Public Property Get Port() As String
    Port = mPort
End Property

Public Property Get DeviceName() As String
    DeviceName = mDeviceName
End Property

Public Property Get Orientation() As zgOrientation
    Orientation = mOrientation
End Property

Public Property Let Orientation(ByVal vNewValue As zgOrientation)
    Dim byt() As Byte
    
    byt = GetRegistryBinary(mDeviceName)
    
    IntToByte byt, 77, vNewValue
    
    SetRegistryBinaryData byt
    
    mOrientation = vNewValue
End Property

Public Property Get PaperSize() As zgPaperSize
    PaperSize = mPaperSize
End Property

Public Property Let PaperSize(ByVal vNewValue As zgPaperSize)
    Dim byt() As Byte
    
    byt = GetRegistryBinary(mDeviceName)
    
    IntToByte byt, 79, vNewValue
    
    SetRegistryBinaryData byt

    mPaperSize = vNewValue
End Property

Public Property Get Copies() As Integer
    Copies = mCopies
End Property

Public Property Let Copies(ByVal vNewValue As Integer)
    Dim byt() As Byte
    
    byt = GetRegistryBinary(mDeviceName)
    
    IntToByte byt, 87, vNewValue
    
    SetRegistryBinaryData byt

    mCopies = vNewValue
End Property

Public Property Get PrintQuality() As zgPrintQuality
    PrintQuality = mPrintQuality
End Property

Public Property Let PrintQuality(ByVal vNewValue As zgPrintQuality)
    Dim byt() As Byte
    
    byt = GetRegistryBinary(mDeviceName)
    
    IntToByte byt, 91, vNewValue
    
    SetRegistryBinaryData byt

    mPrintQuality = vNewValue
End Property

Public Property Get Color() As zgColor
    Color = mColor
End Property

Public Property Let Color(ByVal vNewValue As zgColor)
    Dim byt() As Byte
    
    byt = GetRegistryBinary(mDeviceName)
    
    IntToByte byt, 93, vNewValue
    
    SetRegistryBinaryData byt

    mColor = vNewValue
End Property

Public Property Get Duplex() As zgDuplex
    Duplex = mDuplex
End Property

Public Property Let Duplex(ByVal vNewValue As zgDuplex)
    Dim byt() As Byte
    
    byt = GetRegistryBinary(mDeviceName)
    
    IntToByte byt, 95, vNewValue
    
    SetRegistryBinaryData byt

    mDuplex = vNewValue
End Property

Public Property Get Collate() As zgCollate  ' Harmanla
    Collate = mCollate
End Property

Public Property Let Collate(ByVal vNewValue As zgCollate)
    Dim byt() As Byte
    
    byt = GetRegistryBinary(mDeviceName)
    
    IntToByte byt, 101, vNewValue
    
    SetRegistryBinaryData byt

    mCollate = vNewValue
End Property

Public Property Get FormName() As String
    FormName = mFormName
End Property

Private Sub Class_Initialize()
    Dim Wsh As New WshShell, byt() As Byte, arr
    
    arr = Split(Wsh.RegRead("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device"), ",")
    
    mDeviceName = arr(0)
    mPort = arr(2)
    
    byt = GetRegistryBinary(arr(0))
    
    'mDeviceName = ByteToString(byt, 1, 64) ' <-- Yukarıda tanımladık
    mOrientation = ByteToInt(byt, 77)
    mPaperSize = ByteToInt(byt, 79)
    mCopies = ByteToInt(byt, 87)
    mPrintQuality = ByteToInt(byt, 91)
    mColor = ByteToInt(byt, 93)
    mDuplex = ByteToInt(byt, 95)
    mCollate = ByteToInt(byt, 101)
    mFormName = ByteToString(byt, 103, 167)
End Sub

Private Function GetRegistryBinary(ByVal PrinterName As String) As Byte()
    Dim Wsh As New WshShell, deg, byt() As Byte, i As Integer
    
    deg = Wsh.RegRead("HKCU\Printers\DevModePerUser\" & PrinterName)
    
    For i = 0 To UBound(deg)
        ReDim Preserve byt(1 To i + 1) As Byte
        byt(i + 1) = deg(i)
    Next
    
    GetRegistryBinary = byt
End Function

Private Sub SetRegistryBinaryData(Bytes() As Byte)
'HKEY_CLASSES_ROOT   (2147483648 (0x80000000))
'HKEY_CURRENT_USER   (2147483649 (0x80000001))
'HKEY_LOCAL_MACHINE  (2147483650 (0x80000002))
'HKEY_USERS          (2147483651 (0x80000003))
'HKEY_CURRENT_CONFIG (2147483653 (0x80000005))
Dim objReg As Object

Const HKCU = &H80000001

Set objReg = GetObject("Winmgmts:root\default:StdRegProv")

objReg.SetBinaryValue HKCU, "Printers\DevModePerUser", mDeviceName, Bytes

End Sub

Private Function ByteToInt(Bytes() As Byte, ByVal StartWithIndex As Integer) As Integer
    ' CopyMemory (Hedef, Kaynak dizinin başlangıç indexi, Kaç karakter(byte) kopyalanacak)
    CopyMemory ByteToInt, Bytes(StartWithIndex), 2 ' Long tipi 4, Integer 2 byte dır
End Function

Private Function ByteToLong(Bytes() As Byte, ByVal StartWithIndex As Integer) As Long
    CopyMemory ByteToLong, Bytes(StartWithIndex), 4 ' Long tipi 4, Integer 2 byte dır
End Function

Private Sub IntToByte(Bytes() As Byte, ByVal StartWithIndex As Integer, ByVal NewValue As Integer)
    CopyMemory Bytes(StartWithIndex), NewValue, 2 ' Long tipi 4, Integer 2 byte dır
End Sub

Private Sub LongToByte(Bytes() As Byte, ByVal StartWithIndex As Integer, ByVal NewValue As Long)
    CopyMemory Bytes(StartWithIndex), NewValue, 4 ' Long tipi 4, Integer 2 byte dır
End Sub

Private Function ByteToString(Bytes() As Byte, ByVal LowIndex As Integer, ByVal HighIndex As Integer) As String
    Dim tmpArr() As Byte, s As Long, i As Integer
    
    For i = LowIndex To HighIndex
        s = s + 1
        ReDim Preserve tmpArr(1 To s) As Byte
        tmpArr(s) = Bytes(i)
    Next
    ByteToString = tmpArr
    ByteToString = Replace(ByteToString, Chr(0), "")
    Erase tmpArr
End Function



EKLENTİYİ DLL GİBİ KULLANMA:

- Yukarıdaki ekletiyi (.xla) indirdikten sonra boş bir Excel başlatın.
- VBAProject Referansı olarak bir dll gibi bu eklentiyi (.xla) referans olarak ekleyin.
- Referans olarak ekledikten sonra aşağıdaki prosedurleri test edebilirsiniz. 




Sub test1()
    Dim p As Printer
    
    Set p = New_Printer
    
    Debug.Print "Yazıcı Adı :"; p.DeviceName
    Debug.Print "Yazdırma Kalitesi :"; p.PrintQuality
    Debug.Print "Sayfa Yönü (Dikey/Yatay) :"; p.Orientation
End Sub

Sub test2()
    Dim p As Printer
    
    Set p = New_Printer

    p.Copies = 2                ' İki kopya ayarla
    p.Orientation = zgLANDSCAPE ' Yatay sayfa yapısı
    p.PaperSize = zgA5_148x210  ' A5 kağıdı olarak ayarla
    p.PrintQuality = zgDRAFT    ' Düşük kalite (Hızlı yazdırma)
End Sub



--------------------------------
Faydalı olması dileğimle…
Kolay gelsin.

< Z e k i G Ü R S O Y >

 

Başa Dön