Der Mediaplex Sampler - Die 6 von Plex/6_v_plex.zip/6_v_plex/DISK4/BUSIN_10/BARS2.ZIP/BARS2.BAS

BASIC Source File | 1992-03-25 | 11KB | 736 lines

Sub setnewbar ()
PrintFlAG = "NO"
form1.picture1.Cls
form1.picture1.SCALEMODE = 3

form1.picture1.CURRENTX = 1                         'Set The Starting X Cord
form1.picture1.CURRENTY = 1                         'Set The Starting Y Cord

barcode$ = form1.TEXT1.text
bardescrip$ = form1.TEXT2.text
form1.label1.FONTNAME = FONTTOUSE$
form1.label2.FONTNAME = FONTTOUSE$
form1.label1.fontsize = Val(form1.combo3.text)
form1.label2.fontsize = Val(form1.combo3.text)

form1.label2.caption = barcode$               'Set Label2 = BarCode
form1.label1.caption = bardescrip$
If Len(barcode$) = 0 Then GoTo NOCODES1        'If No BarCode The End
SCREEN.MOUSEPOINTER = 11
'******************************************************
'                Call Header Subroutine
'
' This Will Place The Start Bits Of The BarCode On The
' Screen
'******************************************************
HEADER

'********************************************************
' The Next Part Of The Program Will Divide The Barcode
' Into Indiviual Digits and Select The Correct Subroutine
' Based On The BarCodes Digits
'********************************************************
For A = 1 To Len(barcode$) - 1                'Set A=Length Of Barcode
DIGIT$ = Mid$(barcode$, A, 1)                 'Get Each Digit Of Code

Select Case DIGIT$
    Case "0": Call ZERO
    Case "1": Call ONE
    Case "2": Call TWO
    Case "3": Call THREE
    Case "4": Call FOUR
    Case "5": Call FIVE
    Case "6": Call SIX
    Case "7": Call SEVEN
    Case "8": Call EIGHT
    Case "9": Call NINE
    Case "A": Call LETTER_A
    Case "B": Call LETTER_B
    Case "C": Call LETTER_C
    Case "D": Call LETTER_D
    Case "E": Call LETTER_E
    Case "F": Call LETTER_F
    Case "G": Call LETTER_G
    Case "H": Call LETTER_H
    Case "I": Call LETTER_I
    Case "J": Call LETTER_J
    Case "K": Call LETTER_K
    Case "L": Call LETTER_L
    Case "M": Call LETTER_M
    Case "N": Call LETTER_N
    Case "O": Call LETTER_O
    Case "P": Call LETTER_P
    Case "Q": Call LETTER_Q
    Case "R": Call LETTER_R
    Case "S": Call LETTER_S
    Case "T": Call LETTER_T
    Case "U": Call LETTER_U
    Case "V": Call LETTER_V
    Case "W": Call LETTER_W
    Case "X": Call LETTER_X
    Case "Y": Call LETTER_Y
    Case "Z": Call LETTER_Z
End Select
NS
Next A
DIGIT$ = Mid$(barcode$, Len(barcode$), 1)
Select Case DIGIT$
    Case "0": Call ZERO
    Case "1": Call ONE
    Case "2": Call TWO
    Case "3": Call THREE
    Case "4": Call FOUR
    Case "5": Call FIVE
    Case "6": Call SIX
    Case "7": Call SEVEN
    Case "8": Call EIGHT
    Case "9": Call NINE
    Case "A": Call LETTER_A
    Case "B": Call LETTER_B
    Case "C": Call LETTER_C
    Case "D": Call LETTER_D
    Case "E": Call LETTER_E
    Case "F": Call LETTER_F
    Case "G": Call LETTER_G
    Case "H": Call LETTER_H
    Case "I": Call LETTER_I
    Case "J": Call LETTER_J
    Case "K": Call LETTER_K
    Case "L": Call LETTER_L
    Case "M": Call LETTER_M
    Case "N": Call LETTER_N
    Case "O": Call LETTER_O
    Case "P": Call LETTER_P
    Case "Q": Call LETTER_Q
    Case "R": Call LETTER_R
    Case "S": Call LETTER_S
    Case "T": Call LETTER_T
    Case "U": Call LETTER_U
    Case "V": Call LETTER_V
    Case "W": Call LETTER_W
    Case "X": Call LETTER_X
    Case "Y": Call LETTER_Y
    Case "Z": Call LETTER_Z
End Select

FOOTER
NOCODES1:
form1.label1.Refresh
form1.label2.Refresh

SCREEN.MOUSEPOINTER = 0


End Sub

Sub HEADER ()
'***********************************************
' bar code start bit
'***********************************************
WB     'SINGLE LINE
NB     'DOUBLE SPACE
WB     'SINGLE LINE
NS     'SINGLE SPACE
WS     'DOUBLE LINE
NS     'SINGLE SPACE
WS     'DOUBLE LINE
NS     'SINGLE SPACE
WB     'SINGLE LINE
NS     'SINGLE SPACE
End Sub

Sub FOOTER ()
'*********************************************
'bar code stop bit
'**********************************************
NS
WB
NB
WB
NS
WS
NS
WS
NS
WB
NS
End Sub

Sub FIVE ()
WS
NS
WB
NB
WS
NS
WB
NS
WB

End Sub

Sub SIX ()
WB
NS
WS
NB
WS
NS
WB
NS
WB
End Sub

Sub SEVEN ()
WB
NS
WB
NB
WB
NS
WS
NS
WS
End Sub

Sub EIGHT ()
WS
NS
WB
NB
WB
NS
WS
NS
WB

End Sub

Sub NINE ()
WB
NS
WS
NB
WB
NS
WS
NS
WB
End Sub

Sub ZERO ()
WB
NS
WB
NB
WS
NS
WS
NS
WB
End Sub

Sub LETTER_A ()
WS
NS
WB
NS
WB
NB
WB
NS
WS
End Sub

Sub LETTER_B ()
WB
NS
WS
NS
WB
NB
WB
NS
WS
End Sub

Sub LETTER_C ()
WS
NS
WS
NS
WB
NB
WB
NS
WB
End Sub

Sub LETTER_D ()
WB
NS
WB
NS
WS
NB
WB
NS
WS
End Sub

Sub LETTER_E ()
WS
NS
WB
NS
WS
NB
WB
NS
WB

End Sub

Sub LETTER_F ()
WB
NS
WS
NS
WS
NB
WB
NS
WB

End Sub

Sub FOUR ()
WB
NS
WB
NS
NB
WS
NS
WB
NS
WS

End Sub

Sub WS ()
If cancelprint$ = "YES" Then GoTo ws_exit
If PrintFlAG$ = "YES" Then GoTo useprinter4
form1.picture1.Line (form1.picture1.CURRENTX, form1.picture1.CURRENTY)-(form1.picture1.CURRENTX + 3, form1.picture1.CURRENTY + 20), QBColor(0), BF
form1.picture1.CURRENTY = form1.picture1.CURRENTY - 20
GoTo ws_exit
useprinter4:
If form1.option4.value = -1 Then density = .0425
If form1.option5.value = -1 Then density = .04
If form1.option6.value = -1 Then density = .0375



PRINTER.FILLCOLOR = QBColor(0)
PRINTER.SCALEMODE = 5
PRINTER.Line (PRINTER.CURRENTX, PRINTER.CURRENTY)-(PRINTER.CURRENTX + density, PRINTER.CURRENTY + Val(BARHEIGHT$)), QBColor(0), BF
PRINTER.CURRENTY = PRINTER.CURRENTY - Val(BARHEIGHT$)
ws_exit:
End Sub

Sub ONE ()
'wb    'single line
'ns    'space
WS    'double line
NS    'space
WB    'single line
NB    'double space
WB    'single line
NS    'space
WB    'single line
NS    'space
WS    'double line
'ns    'space
'wb    'single line
End Sub

Sub TWO ()
'wb    'single line
'ns    'space
WB    'single line
NS    'space
WS    'double line
NB    'double space
WB    'single line
NS    'space
WB    'single line
NS    'space
WS    'double line
'ns    'space
'wb    'single line
End Sub

Sub THREE ()

WS
NS
WS
NB
WB
NS
WB
NS
WB

End Sub

Sub WB ()
If cancelprint$ = "YES" Then GoTo wb_exit
If PrintFlAG$ = "YES" Then GoTo useprinter3
form1.picture1.Line (form1.picture1.CURRENTX, form1.picture1.CURRENTY)-(form1.picture1.CURRENTX + 1, form1.picture1.CURRENTY + 20), QBColor(0), BF
form1.picture1.CURRENTY = form1.picture1.CURRENTY - 20
GoTo wb_exit



useprinter3:
If form1.option4.value = -1 Then density = .0175
If form1.option5.value = -1 Then density = .015
If form1.option6.value = -1 Then density = .0125


PRINTER.FILLCOLOR = QBColor(0)
PRINTER.SCALEMODE = 5
PRINTER.Line (PRINTER.CURRENTX, PRINTER.CURRENTY)-(PRINTER.CURRENTX + density, PRINTER.CURRENTY + Val(BARHEIGHT$)), QBColor(0), BF
PRINTER.CURRENTY = PRINTER.CURRENTY - Val(BARHEIGHT$)
wb_exit:
End Sub

Sub NB ()
If cancelprint$ = "YES" Then GoTo nb_exit
If PrintFlAG$ = "YES" Then GoTo Useprinter1
form1.picture1.FILLCOLOR = QBColor(4)
form1.picture1.Line (form1.picture1.CURRENTX, form1.picture1.CURRENTY)-(form1.picture1.CURRENTX + 3, form1.picture1.CURRENTY + 20), , BF
form1.picture1.CURRENTY = form1.picture1.CURRENTY - 20
form1.picture1.FILLCOLOR = QBColor(0)
GoTo nb_exit

Useprinter1:
If form1.option4.value = -1 Then density = .0425
If form1.option5.value = -1 Then density = .04
If form1.option6.value = -1 Then density = .0375




PRINTER.SCALEMODE = 5
PRINTER.FILLCOLOR = QBColor(15)
PRINTER.Line (PRINTER.CURRENTX, PRINTER.CURRENTY)-(PRINTER.CURRENTX + density, PRINTER.CURRENTY + Val(BARHEIGHT$)), QBColor(15), BF
PRINTER.CURRENTY = PRINTER.CURRENTY - Val(BARHEIGHT$)
PRINTER.FILLCOLOR = QBColor(0)
nb_exit:
End Sub

Sub setnewdescrip ()
End Sub

Sub SetNewDefaults ()
sname$ = "Bars Version 2.0"
kname$ = "BarHeight"
string1$ = ".25"
SUCCESS% = WRITEProfileString(sname$, kname$, string1$)
kname$ = "BarVertical"
string2$ = ".5"
SUCCESS% = WRITEProfileString(sname$, kname$, string2$)
kname$ = "BarHorizontal"
string3$ = "3.0125"
SUCCESS% = WRITEProfileString(sname$, kname$, string3$)
kname$ = "NumAcross"
string4$ = "1"
SUCCESS% = WRITEProfileString(sname$, kname$, string4$)
FONTDEFAULT$ = PRINTER.FONTNAME
kname$ = "Font"
string5$ = FONTDEFAULT$
SUCCESS% = WRITEProfileString(sname$, kname$, string5$)
kname$ = "LeftMargin"
string6$ = ".25"
SUCCESS% = WRITEProfileString(sname$, kname$, string6$)
kname$ = "TopMargin"
string7$ = ".25"
SUCCESS% = WRITEProfileString(sname$, kname$, string7$)
End Sub

Sub NS ()
If cancelprint$ = "YES" Then GoTo ns_exit
If PrintFlAG$ = "YES" Then GoTo useprinter2
form1.picture1.FILLCOLOR = QBColor(4)
form1.picture1.Line (form1.picture1.CURRENTX, form1.picture1.CURRENTY)-(form1.picture1.CURRENTX + 1, form1.picture1.CURRENTY + 20), , BF
form1.picture1.CURRENTY = form1.picture1.CURRENTY - 20
form1.picture1.FILLCOLOR = QBColor(0)
GoTo ns_exit


useprinter2:
If form1.option4.value = -1 Then density = .0175
If form1.option5.value = -1 Then density = .015
If form1.option6.value = -1 Then density = .0125







PRINTER.SCALEMODE = 5
PRINTER.FILLCOLOR = QBColor(15)
PRINTER.Line (PRINTER.CURRENTX, PRINTER.CURRENTY)-(PRINTER.CURRENTX + density, PRINTER.CURRENTY + Val(BARHEIGHT$)), QBColor(15), BF
PRINTER.CURRENTY = PRINTER.CURRENTY - Val(BARHEIGHT$)
PRINTER.FILLCOLOR = QBColor(0)
ns_exit:
End Sub

Sub LETTER_Z ()
WB
NB
WS
NS
WS
NS
WB
NS
WB
End Sub

Sub LETTER_K ()
WS
NS
WB
NS
WB
NS
WB
NB
WS
End Sub

Sub LETTER_L ()
WB
NS
WS
NS
WB
NS
WB
NB
WS
End Sub

Sub LETTER_M ()
WS
NS
WS
NS
WB
NS
WB
NB
WB
End Sub

Sub LETTER_N ()
WB
NS
WB
NS
WS
NS
WB
NB
WS
End Sub

Sub LETTER_O ()
WS
NS
WB
NS
WS
NS
WB
NB
WB
End Sub

Sub LETTER_P ()
WB
NS
WS
NS
WS
NS
WB
NB
WB
End Sub

Sub LETTER_Q ()
WB
NS
WB
NS
WB
NS
WS
NB
WS
End Sub

Sub LETTER_R ()
WS
NS
WB
NS
WB
NS
WS
NB
WB
End Sub

Sub LETTER_S ()
WB
NS
WS
NS
WB
NS
WS
NB
WB
End Sub

Sub LETTER_T ()
WB
NS
WB
NS
WS
NS
WS
NB
WB
End Sub

Sub LETTER_U ()
WS
NB
WB
NS
WB
NS
WB
NS
WS
End Sub

Sub LETTER_V ()
WB
NB
WS
NS
WB
NS
WB
NS
WS
End Sub

Sub LETTER_W ()
WS
NB
WS
NS
WB
NS
WB
NS
WB

End Sub

Sub LETTER_X ()
WB
NB
WB
NS
WS
NS
WB
NS
WS

End Sub

Sub LETTER_Y ()
WS
NB
WB
NS
WS
NS
WB
NS
WB

End Sub

Sub LETTER_G ()
WB
NS
WB
NS
WB
NB
WS
NS
WS
End Sub

Sub LETTER_H ()
WS
NS
WB
NS
WB
NB
WS
NS
WB
End Sub

Sub LETTER_I ()
WB
NS
WS
NS
WB
NB
WS
NS
WB
End Sub

Sub LETTER_J ()
WB
NS
WB
NS
WS
NB
WS
NS
WB
End Sub