Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
20/05/2014 21:58
Konu Sahibi
mehmetdemiral
Yorumlar
30
Okunma
9009
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
cozum

cozum

Aktif Üye
100434
 19
 14
 68
 16/11/2018
0
 Bilecik
 
 Ofis 2010 32 Bit
 12/07/2019,14:36
(06/07/2019 16:08)mehmetdemiral Adlı Kullanıcıdan Alıntı: Teşekkürler.
Code39 VBA



Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Function Barcode_39(Ctrl As Control, rpt As Report)
    On Error GoTo ErrorTrap_BarCode39

    Dim Nbar As Single, Wbar As Single, Qbar As Single, Nextbar As Single
    Dim CountX As Single, CountY As Single, CountR As Single
    Dim Parts As Single, Pix As Single, Color As Long, BarCodePlus As Variant
    Dim Stripes As String, BarType As String, BarCode As String
    Dim Mx As Single, my As Single, Sx As Single, Sy As Single
    Const White = 16777215: Const Black = 0
    Const Nratio = 20, Wratio = 55, Qratio = 35

    'Get control size and location properties.
    Sx = Ctrl.Left: Sy = Ctrl.Top: Mx = Ctrl.Width: my = Ctrl.Height

    'Set handle on control.
    BarCode = Ctrl

    'Calculate actual and relative pixels values.
    Parts = (Len(BarCode) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))
    Pix = (Mx / Parts):
    Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)

    'Initialize bar index and color.
    Nextbar = Sx
    Color = White

    'Pad each end of string with start/stop characters.
    BarCodePlus = "*" & UCase(BarCode) & "*"

    'Walk through each character of the barcode contents.
    For CountX = 1 To Len(BarCodePlus)
        'Get Barcode 1/0 string for indexed character.
        Stripes = MD_BC39(Mid$(BarCodePlus, CountX, 1))
        For CountY = 1 To 9
            'For each 1/0, draw a wide/narrow bar.
            BarType = Mid$(Stripes, CountY, 1)

            'Toggle the color (black/white).
            If Color = White Then Color = Black Else Color = White
            Select Case BarType
                Case "1"
                    'Draw a wide bar.
                    rpt.Line (Nextbar, Sy)-Step(Wbar, my), Color, BF
                    Nextbar = Nextbar + Wbar
                Case "0"
                    'Draw a narrow bar.
                    rpt.Line (Nextbar, Sy)-Step(Nbar, my), Color, BF
                    Nextbar = Nextbar + Nbar
            End Select
        Next CountY

        'Toggle the color (black/white).
        If Color = White Then Color = Black Else Color = White

        'Draw intermediate "quiet" bar.
        rpt.Line (Nextbar, Sy)-Step(Qbar, my), Color, BF
        Nextbar = Nextbar + Qbar
    Next CountX

Exit_BarCode39:
    Exit Function

ErrorTrap_BarCode39:
    Resume Exit_BarCode39
End Function

Function MD_BC39(CharCode As String) As String
    On Error GoTo ErrorTrap_BC39

    ReDim BC39(90)

    BC39(32) = "011000100" ' space
    BC39(36) = "010101000" ' $
    BC39(37) = "000101010" ' %
    BC39(42) = "010010100" ' * Start/Stop
    BC39(43) = "010001010" ' +
    BC39(45) = "010000101" ' |
    BC39(46) = "110000100" ' .
    BC39(47) = "010100010" ' /
    BC39(48) = "000110100" ' 0
    BC39(49) = "100100001" ' 1
    BC39(50) = "001100001" ' 2
    BC39(51) = "101100000" ' 3
    BC39(52) = "000110001" ' 4
    BC39(53) = "100110000" ' 5
    BC39(54) = "001110000" ' 6
    BC39(55) = "000100101" ' 7
    BC39(56) = "100100100" ' 8
    BC39(57) = "001100100" ' 9
    BC39(65) = "100001001" ' A
    BC39(66) = "001001001" ' B
    BC39(67) = "101001000" ' C
    BC39(68) = "000011001" ' D
    BC39(69) = "100011000" ' E
    BC39(70) = "001011000" ' F
    BC39(71) = "000001101" ' G
    BC39(72) = "100001100" ' H
    BC39(73) = "001001100" ' I
    BC39(74) = "000011100" ' J
    BC39(75) = "100000011" ' K
    BC39(76) = "001000011" ' L
    BC39(77) = "101000010" ' M
    BC39(78) = "000010011" ' N
    BC39(79) = "100010010" ' O
    BC39(80) = "001010010" ' P
    BC39(81) = "000000111" ' Q
    BC39(82) = "100000110" ' R
    BC39(83) = "001000110" ' S
    BC39(84) = "000010110" ' T
    BC39(85) = "110000001" ' U
    BC39(86) = "011000001" ' V
    BC39(87) = "111000000" ' W
    BC39(88) = "010010001" ' X
    BC39(89) = "110010000" ' Y
    BC39(90) = "011010000" ' Z

    MD_BC39 = BC39(Asc(CharCode))

Exit_BC39:
    Exit Function

ErrorTrap_BC39:
    MD_BC39 = ""

    Resume Exit_BC39
End Function




'Kullanımı
'Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
'Dim Result As Boolean
''Result = SetBarData(BarCode, Me) Barcode_128
'Result = Barcode_39(Me.BarCode, Me)
''Result = Barcode_39(Me.Code, Me)
'End Sub





Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  Aynı listeyi yetkiye göre filtreleme mehmetdemiral 6 2.025 27/05/2015, 08:27
Son Yorum: ozanakkaya
Star Bir tablodan diğer tabloya aynı ID li olanları aktarmak alpeki99 9 5.662 02/02/2013, 22:22
Son Yorum: hgsoftware
  İşlemci + Harddisk + MAC adres + Bios seri No aynı anda mehmetdemiral 9 4.317 25/03/2012, 11:12
Son Yorum: assenucler
Exclamation Ağ üzerinde aynı programı kullananlara zamanlı mesaj bırakma Yandemir 19 7.928 04/05/2011, 17:39
Son Yorum: macaliskan
  Rakamları Aynı Zamanda Yazıya Çevirme Uygulaması HandSword 5 3.465 20/01/2011, 10:59
Son Yorum: paskara

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.