Simple UPC-A BarcodeGadget()

[TI-994A]

At the request of Fangbeast, here's a simple, fully-contained barcode gadget. The implementation syntax is as follows:

Code: Select all

BarcodeGadget(gadgetNo, x, y, width, height, barcodeNumber$ [, colour [, displayLabelBool]])
gadgetNo = BarcodeGadget(#PB_Any, x, y, width, height, barcodeNumber$ [, colour [, displayLabelBool]])

Code: Select all

;==============================================================
;   BarcodeGadget() converts a given 6-11 digit number into
;   a valid UPC-A barcode including the computed check digit
;   and displays it in a size/color configurable image gadget.
;
;   credit to Num3 for the foundational UPC barcode algorithm.
;
;   Tested & working on Windows 8.1 & 10 and OSX Lion,
;   running PureBasic v5.60, v5.41, v5.40 respectively. 
;
;   by TI-994A - free to use, improve, share...
;
;   26th April 2017
;==============================================================

;self-contained BarcodeGadget() procedure
Procedure BarcodeGadget(gadgetNo.i, x.i, y.i, bcWidth.i, bcHeight.i, 
                        bcText.s, bcColor.i = 0, bcLabel = #True)
  
  Protected.i i, unit, width, height, modulo1, modulo2, chksum, gNo
  Protected.i color, bcImage, bcTextFont, bcTextWidth, bcTextHeight
  Protected.s barCode, modulo, digits, left_Digits, right_Digits
  
  Dim left_Binary.s(10)
  left_Binary(0) = "0001101"
  left_Binary(1) = "0011001"
  left_Binary(2) = "0010011"
  left_Binary(3) = "0111101"
  left_Binary(4) = "0100011"
  left_Binary(5) = "0110001"
  left_Binary(6) = "0101111"
  left_Binary(7) = "0111011"
  left_Binary(8) = "0110111"
  left_Binary(9) = "0001011"
  
  Dim right_Binary.s(10)
  right_Binary(0) = "1110010"
  right_Binary(1) = "1100110"
  right_Binary(2) = "1101100"
  right_Binary(3) = "1000010"
  right_Binary(4) = "1011100"
  right_Binary(5) = "1001110"
  right_Binary(6) = "1010000"
  right_Binary(7) = "1000100"
  right_Binary(8) = "1001000"
  right_Binary(9) = "1110100"
  
  digits = bcText
  digits = RSet(digits, 11, "0")
  left_Digits = Left(digits, 6)
  right_Digits = Right(digits, 5)
  modulo.s = left_Digits + right_Digits
  For i = 1 To Len(modulo) Step 2
    modulo1 + Val(Mid(modulo, i, 1))
  Next i
  For i = 2 To Len(modulo) Step 2
    modulo2 + Val(Mid(modulo, i, 1))
  Next i
  chksum = (modulo1 * 3) + modulo2
  If Mod(chksum, 10)
    chksum = 10 - (Mod(chksum, 10))
  Else
    chksum = 0
  EndIf  
  digits + Str(chksum)
  barCode = "101"
  For i = 1 To Len(left_Digits)
    barCode + left_Binary(Val(Mid(left_Digits, i, 1)))
  Next i
  barCode + "01010"
  For i = 1 To Len(right_Digits)
    barCode + right_Binary(Val(Mid(right_Digits, i, 1)))
  Next i
  barCode + right_Binary(chksum)
  barCode + "101"
  
  unit = 2
  width = Len(barCode) * unit 
  height = bcHeight
  bcImage = CreateImage(#PB_Any, width, height, 32)
  bcTextFont = LoadFont(#PB_Any, "Arial", 10)
  
  If StartDrawing(ImageOutput(bcImage))
      Box(0, 0, width, height, RGB(255, 255, 255))
      For i = 1 To Len(barCode)
        If Mid(barCode, i, 1) = "0"
          color = RGB(255, 255, 255)
        ElseIf Mid(barCode, i, 1) = "1"
          color = bcColor
        EndIf   
        Box(unit * (i - 1), 0, unit, height, color)
      Next
      If bcLabel
        bcText = ""
        For i = 1 To Len(digits)
          bcText + Mid(digits, i, 1) + " "
        Next i
        bcText = "  " + bcText + " "
        DrawingFont(FontID(bcTextFont))
        bcTextWidth = TextWidth(bcText)
        bcTextHeight = TextHeight(bcText)
        DrawText((width - bcTextWidth) / 2, height - bcTextHeight, 
                 bcText, bcColor, RGB(255, 255, 255))
      EndIf
    StopDrawing()
  EndIf
  
  ResizeImage(bcImage, bcWidth, bcHeight)
  gNo = ImageGadget(gadgetNo, x, y, bcWidth, bcHeight, ImageID(bcImage))
  If gadgetNo = #PB_Any
    gadgetNo = gNo
  EndIf  
  
  ProcedureReturn gadgetNo
EndProcedure


;implementation demo
wFlags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
win = OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, 400, 350, 
                 "Simple UPC-A Barcode Gadget", wFlags)

;default options - black barcode with barcode number overlaid
bcg = BarcodeGadget(#PB_Any, 150, 20, 100, 50, "12234567899")

;red barcode without barcode number overlaid
BarcodeGadget(0, 100, 120, 200, 60, "456789", #Red, #False)

;blue barcode with barcode number overlaid
BarcodeGadget(1, 50, 230, 300, 75, "987654321", #Blue)

While WaitWindowEvent() ! #PB_Event_CloseWindow : Wend

It takes in a 6-11 digit numerical string, and generates a UPC-A barcode which includes the 12th check-digit.

Any and all feedback welcome. Thank you.

[Fangbeast]

Holy bat-flaps! That's neat. I think even my tiny brain may be able to use it:):):) Thank you, will play with that today.

[Fangbeast]

This works fine with my hand scanner. Of course, the first item I scanned ended up 24 digit. A supermarket shopping docket.

Oh well, cannot have everything.

Code: Select all

Define EventID, MenuID, GadgetID, WindowID

Enumeration 1
  #Window_Barscanner
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #Gadget_Barscanner_cBarcode
  #Gadget_Barscanner_Scanbox
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Procedure.i Window_Barscanner()
  If OpenWindow(#Window_Barscanner, 226, 221, 320, 140, "Barcode scan test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
    ContainerGadget(#Gadget_Barscanner_cBarcode, 10, 15, 300, 110, #PB_Container_Flat|#PB_Container_BorderLess)
    StringGadget(#Gadget_Barscanner_Scanbox, 25, 25, 250, 25, "")
    HideWindow(#Window_Barscanner, 0)
    ProcedureReturn WindowID(#Window_Barscanner)
  EndIf
EndProcedure

Procedure BarcodeGadget(gadgetNo.i, x.i, y.i, bcWidth.i, bcHeight.i, bcText.s, bcColor.i = 0, bcLabel = #True)
  Protected.i i, unit, width, height, modulo1, modulo2, chksum, gNo
  Protected.i color, bcImage, bcTextFont, bcTextWidth, bcTextHeight
  Protected.s barCode, modulo, digits, left_Digits, right_Digits
 
  Dim left_Binary.s(10)
  
  left_Binary(0) = "0001101"
  left_Binary(1) = "0011001"
  left_Binary(2) = "0010011"
  left_Binary(3) = "0111101"
  left_Binary(4) = "0100011"
  left_Binary(5) = "0110001"
  left_Binary(6) = "0101111"
  left_Binary(7) = "0111011"
  left_Binary(8) = "0110111"
  left_Binary(9) = "0001011"
 
  Dim right_Binary.s(10)
  right_Binary(0) = "1110010"
  right_Binary(1) = "1100110"
  right_Binary(2) = "1101100"
  right_Binary(3) = "1000010"
  right_Binary(4) = "1011100"
  right_Binary(5) = "1001110"
  right_Binary(6) = "1010000"
  right_Binary(7) = "1000100"
  right_Binary(8) = "1001000"
  right_Binary(9) = "1110100"
 
  digits        = bcText
  digits        = RSet(digits, 11, "0")
  left_Digits   = Left(digits, 6)
  right_Digits  = Right(digits, 5)
  modulo.s      = left_Digits + right_Digits
  
  For i = 1 To Len(modulo) Step 2
    modulo1 + Val(Mid(modulo, i, 1))
  Next i
  
  For i = 2 To Len(modulo) Step 2
    modulo2 + Val(Mid(modulo, i, 1))
  Next i
  
  chksum = (modulo1 * 3) + modulo2
  
  If Mod(chksum, 10)
    chksum = 10 - (Mod(chksum, 10))
  Else
    chksum = 0
  EndIf 
  
  digits + Str(chksum)
  
  barCode = "101"
  
  For i = 1 To Len(left_Digits)
    barCode + left_Binary(Val(Mid(left_Digits, i, 1)))
  Next i
  
  barCode + "01010"
  
  For i = 1 To Len(right_Digits)
    barCode + right_Binary(Val(Mid(right_Digits, i, 1)))
  Next i
  
  barCode + right_Binary(chksum)
  barCode + "101"
 
  unit        = 2
  width       = Len(barCode) * unit
  height      = bcHeight
  bcImage     = CreateImage(#PB_Any, width, height, 32)
  bcTextFont  = LoadFont(#PB_Any, "Arial", 10)
 
  If StartDrawing(ImageOutput(bcImage))
      Box(0, 0, width, height, RGB(255, 255, 255))
      For i = 1 To Len(barCode)
        If Mid(barCode, i, 1) = "0"
          color = RGB(255, 255, 255)
        ElseIf Mid(barCode, i, 1) = "1"
          color = bcColor
        EndIf   
        Box(unit * (i - 1), 0, unit, height, color)
      Next
      If bcLabel
        bcText = ""
        For i = 1 To Len(digits)
          bcText + Mid(digits, i, 1) + " "
        Next i
        bcText = "  " + bcText + " "
        DrawingFont(FontID(bcTextFont))
        bcTextWidth = TextWidth(bcText)
        bcTextHeight = TextHeight(bcText)
        DrawText((width - bcTextWidth) / 2, height - bcTextHeight,
                 bcText, bcColor, RGB(255, 255, 255))
      EndIf
    StopDrawing()
  EndIf
 
  ResizeImage(bcImage, bcWidth, bcHeight)
  
  OpenGadgetList(#Gadget_Barscanner_cBarcode)
    gNo = ImageGadget(gadgetNo, x, y, bcWidth, bcHeight, ImageID(bcImage))
  CloseGadgetList()
    
  If gadgetNo = #PB_Any
    gadgetNo = gNo
  EndIf 
 
  ProcedureReturn gadgetNo
  
EndProcedure

If Window_Barscanner()
  
  SetActiveGadget(#Gadget_Barscanner_Scanbox)
  
  Define quitBarscanner = #False
  Repeat
    EventID  = WaitWindowEvent()
    MenuID   = EventMenu()
    GadgetID = EventGadget()
    WindowID = EventWindow()
    Select EventID
      Case #PB_Event_CloseWindow
        Select WindowID
          Case #Window_Barscanner           :  quitBarscanner  = #True
        EndSelect
      Case #PB_Event_Gadget
        Select GadgetID
          Case #Gadget_Barscanner_Scanbox
            Select EventType()
              Case #PB_EventType_Change     : BarcodeGadget(#PB_Any, 25, 70, 250, 25, GetGadgetText(#Gadget_Barscanner_Scanbox), #Black, #True)
                SetGadgetText(#Gadget_Barscanner_Scanbox, "")
            EndSelect
        EndSelect
    EndSelect
  Until quitBarscanner
  CloseWindow(#Window_Barscanner)
EndIf
End

[TI-994A]

...the first item I scanned ended up 24 digit.

Really cool realtime entry!

I've put together another barcode gadget based on Code-39 which accepts alphanumeric values up to 43 characters long. The only drawback is that the barcode images are proportionate to the length of the value, and compressing them too much would compromise scanner-readability.

> Simple Code-39 BarcodeGadget()



Hope it might be of some help with your supermarket barcodes.

[fd]

I have to do barcode in UCP-E format. Do you know the change i have to do from the UCP-A code. Thank you.