PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Code 128 - Barcode generator

https://www.purebasic.fr/german/viewtopic.php?t=23994

Seite 1 von 2

Code 128 - Barcode generator

Verfasst: 06.03.2011 18:41
von 125
Moin,
ich hab heute nach längerer Zeit mal wieder was mit PB gemacht und dachte das wäre vielleicht auch für andere brauchbar :)
Hier mein Code128 Generator:

Code: Alles auswählen

;------------------------
; Barcode Generator
; v0.1 by 125
; Public Domain
;------------------------

UsePNGImageEncoder()

#BWidth = 1
#BLength = 60
#BDepth = 32

Global Dim CTable.s(106)
CTable(0)="212222"
CTable(1)="222122"
CTable(2)="222221"
CTable(3)="121223"
CTable(4)="121322"
CTable(5)="131222"
CTable(6)="122213"
CTable(7)="122312"
CTable(8)="132212"
CTable(9)="221213"
CTable(10)="221312"
CTable(11)="231212"
CTable(12)="112232"
CTable(13)="122132"
CTable(14)="122231"
CTable(15)="113222"
CTable(16)="123122"
CTable(17)="123221"
CTable(18)="223211"
CTable(19)="221132"
CTable(20)="221231"
CTable(21)="213212"
CTable(22)="223112"
CTable(23)="312131"
CTable(24)="311222"
CTable(25)="321122"
CTable(26)="321221"
CTable(27)="312212"
CTable(28)="322112"
CTable(29)="322211"
CTable(30)="212123"
CTable(31)="212321"
CTable(32)="232121"
CTable(33)="111323"
CTable(34)="131123"
CTable(35)="131321"
CTable(36)="112313"
CTable(37)="132113"
CTable(38)="132311"
CTable(39)="211313"
CTable(40)="231113"
CTable(41)="231311"
CTable(42)="112133"
CTable(43)="112331"
CTable(44)="132131"
CTable(45)="113123"
CTable(46)="113321"
CTable(47)="133121"
CTable(48)="313121"
CTable(49)="211331"
CTable(50)="231131"
CTable(51)="213113"
CTable(52)="213311"
CTable(53)="213131"
CTable(54)="311123"
CTable(55)="311321"
CTable(56)="331121"
CTable(57)="312113"
CTable(58)="312311"
CTable(59)="332111"
CTable(60)="314111"
CTable(61)="221411"
CTable(62)="431111"
CTable(63)="111224"
CTable(64)="111422"
CTable(65)="121124"
CTable(66)="121421"
CTable(67)="141122"
CTable(68)="141221"
CTable(69)="112214"
CTable(70)="112412"
CTable(71)="122114"
CTable(72)="122411"
CTable(73)="142112"
CTable(74)="142211"
CTable(75)="241211"
CTable(76)="221114"
CTable(77)="413111"
CTable(78)="241112"
CTable(79)="134111"
CTable(80)="111242"
CTable(81)="121142"
CTable(82)="121241"
CTable(83)="114212"
CTable(84)="124112"
CTable(85)="124211"
CTable(86)="411212"
CTable(87)="421112"
CTable(88)="421211"
CTable(89)="212141"
CTable(90)="214121"
CTable(91)="412121"
CTable(92)="111143"
CTable(93)="111341"
CTable(94)="131141"
CTable(95)="114113"
CTable(96)="114311"
CTable(97)="411113"
CTable(98)="411311"
CTable(99)="113141"
CTable(100)="114131"
CTable(101)="311141"
CTable(102)="411131"
CTable(103)="211412"
CTable(104)="211214"
CTable(105)="211232"
CTable(106)="2331112"

Procedure GenerateCodeMage(ToCode.s,BWidth,BLength,BDepth)
  BImage = 1
  x = 0
  y = 0
  CreateImage(BImage, (Len(ToCode) + 2) * 15 * BWidth, BLength,BDepth)
   StartDrawing(ImageOutput(BIMage))
     Box(x,y,ImageWidth(BIMage),ImageHeight(BIMage),$FFFFFF)
     char = 104
     For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
     Next    
     check = 104
     For a = 0 To Len(ToCode) - 1
       char =  Asc(PeekS(@ToCode+a,1))-32
       check = check + (char * (a+1))
       If char >= 0 And char <= 106
         For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
         Next
       EndIf
     Next
     char = check%103
     For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
     Next 
     char = 106
     For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
     Next
   StopDrawing()    
   GrabImage(BImage, BImage, 0, 0, x, BLength)
   BImage2 = CreateImage(#PB_Any,ImageWidth(BImage)+100,ImageHeight(BImage),BDepth)
   StartDrawing(ImageOutput(BImage2))
    Box(0,0,ImageWidth(BImage2),ImageHeight(BImage2),$FFFFFF)
    DrawImage(ImageID(BImage),50,0)
   StopDrawing()
   ProcedureReturn BImage2
EndProcedure


Input.s = InputRequester("Barcode Generator","Bitte Message zum Codieren eingeben!","")

Image = GenerateCodeMage(Input,#BWidth,#BLength,#BDepth)

SaveImage(Image,SaveFileRequester("Wo?","","*.png|*.png",0), #PB_ImagePlugin_PNG)
MfG
125

Re: Code 128 - Barcode generator

Verfasst: 06.03.2011 23:29
von zigapeda
Hey Alex,

genau das richtige timing, den code koennen wir gerade bei unserem projekt brauchen
sehr nice.

mfg daniel

Re: Code 128 - Barcode generator

Verfasst: 07.03.2011 00:40
von hjbremer
Kann man bestimmt mal gebrauchen :allright:

aber warum Imagetiefe 32 ? mal so gefragt

Re: Code 128 - Barcode generator

Verfasst: 07.03.2011 08:34
von DarkDragon
Ui, gleich 2 von denen die hier nach langer Zeit mal wieder was schreiben: 125 und zigapeda. :shock: :allright:

Ich hab jetzt keine lust das von Hand zu dekodieren was ich da eingegeben hab, aber wenn 's stimmt, dann ist 's ja toll ;-) . Dann können wir ja jetzt unseren eigenen PureBasic Supermarkt aufbauen und schonmal Etiketten drucken. :lol:

Re: Code 128 - Barcode generator

Verfasst: 15.06.2011 11:25
von haggi
Hi,

genau das was ich brauche, kann man den barkode auch vedrtikal ausgeben? was müsste hierbei verändert werden? vielen dank bereits im voraus, und für dieses coole projekt!

gruß haggi

Re: Code 128 - Barcode generator

Verfasst: 15.06.2011 13:35
von cxAlex
haggi hat geschrieben:Hi,

genau das was ich brauche, kann man den barkode auch vedrtikal ausgeben? was müsste hierbei verändert werden? vielen dank bereits im voraus, und für dieses coole projekt!

gruß haggi
Ich würde dafür nicht den Algo verändern sondern einfach eine Bild-Rotations Routine hinten dran schalten, solltes du im Forum zuhauf finden :)


//Edit: Hab schnell was gebastelt, nicht der schnellste Algo aber reicht für die kleinen Barcodes:

Code: Alles auswählen

;------------------------
; Barcode Generator
; v0.1 by 125
; Public Domain
;------------------------

UsePNGImageEncoder()

#BWidth = 1
#BLength = 60
#BDepth = 32

Global Dim CTable.s(106)
CTable(0)="212222"
CTable(1)="222122"
CTable(2)="222221"
CTable(3)="121223"
CTable(4)="121322"
CTable(5)="131222"
CTable(6)="122213"
CTable(7)="122312"
CTable(8)="132212"
CTable(9)="221213"
CTable(10)="221312"
CTable(11)="231212"
CTable(12)="112232"
CTable(13)="122132"
CTable(14)="122231"
CTable(15)="113222"
CTable(16)="123122"
CTable(17)="123221"
CTable(18)="223211"
CTable(19)="221132"
CTable(20)="221231"
CTable(21)="213212"
CTable(22)="223112"
CTable(23)="312131"
CTable(24)="311222"
CTable(25)="321122"
CTable(26)="321221"
CTable(27)="312212"
CTable(28)="322112"
CTable(29)="322211"
CTable(30)="212123"
CTable(31)="212321"
CTable(32)="232121"
CTable(33)="111323"
CTable(34)="131123"
CTable(35)="131321"
CTable(36)="112313"
CTable(37)="132113"
CTable(38)="132311"
CTable(39)="211313"
CTable(40)="231113"
CTable(41)="231311"
CTable(42)="112133"
CTable(43)="112331"
CTable(44)="132131"
CTable(45)="113123"
CTable(46)="113321"
CTable(47)="133121"
CTable(48)="313121"
CTable(49)="211331"
CTable(50)="231131"
CTable(51)="213113"
CTable(52)="213311"
CTable(53)="213131"
CTable(54)="311123"
CTable(55)="311321"
CTable(56)="331121"
CTable(57)="312113"
CTable(58)="312311"
CTable(59)="332111"
CTable(60)="314111"
CTable(61)="221411"
CTable(62)="431111"
CTable(63)="111224"
CTable(64)="111422"
CTable(65)="121124"
CTable(66)="121421"
CTable(67)="141122"
CTable(68)="141221"
CTable(69)="112214"
CTable(70)="112412"
CTable(71)="122114"
CTable(72)="122411"
CTable(73)="142112"
CTable(74)="142211"
CTable(75)="241211"
CTable(76)="221114"
CTable(77)="413111"
CTable(78)="241112"
CTable(79)="134111"
CTable(80)="111242"
CTable(81)="121142"
CTable(82)="121241"
CTable(83)="114212"
CTable(84)="124112"
CTable(85)="124211"
CTable(86)="411212"
CTable(87)="421112"
CTable(88)="421211"
CTable(89)="212141"
CTable(90)="214121"
CTable(91)="412121"
CTable(92)="111143"
CTable(93)="111341"
CTable(94)="131141"
CTable(95)="114113"
CTable(96)="114311"
CTable(97)="411113"
CTable(98)="411311"
CTable(99)="113141"
CTable(100)="114131"
CTable(101)="311141"
CTable(102)="411131"
CTable(103)="211412"
CTable(104)="211214"
CTable(105)="211232"
CTable(106)="2331112"

Procedure GenerateCodeMage(ToCode.s,BWidth,BLength,BDepth)
  BImage = 1
  x = 0
  y = 0
  CreateImage(BImage, (Len(ToCode) + 2) * 15 * BWidth, BLength,BDepth)
   StartDrawing(ImageOutput(BIMage))
     Box(x,y,ImageWidth(BIMage),ImageHeight(BIMage),$FFFFFF)
     char = 104
     For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
     Next    
     check = 104
     For a = 0 To Len(ToCode) - 1
       char =  Asc(PeekS(@ToCode+a,1))-32
       check = check + (char * (a+1))
       If char >= 0 And char <= 106
         For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
         Next
       EndIf
     Next
     char = check%103
     For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
     Next 
     char = 106
     For b = 0 To Len(CTable(char)) - 1
           If b%2 = 0
             Wd = Val(PeekS(@CTable(char)+b,1))
             Box(x,y,BWidth * Wd, BLength,$000000)
             x = x + BWidth * Wd
           Else
             x = x + BWidth * Val(PeekS(@CTable(char)+b,1))
           EndIf
     Next
   StopDrawing()    
   GrabImage(BImage, BImage, 0, 0, x, BLength)
   BImage2 = CreateImage(#PB_Any,ImageWidth(BImage)+100,ImageHeight(BImage),BDepth)
   StartDrawing(ImageOutput(BImage2))
    Box(0,0,ImageWidth(BImage2),ImageHeight(BImage2),$FFFFFF)
    DrawImage(ImageID(BImage),50,0)
   StopDrawing()
   ProcedureReturn BImage2
EndProcedure

Procedure RotateImagePiHalfRad(Image)
  Protected ImgH = ImageHeight(Image)
  Protected ImgW = ImageWidth(Image)
  Protected RImage = CreateImage(#PB_Any, ImgH, ImgW)
  Protected Dim PixelBuffer(ImgH, ImgW)
  Protected x, y
  
  StartDrawing(ImageOutput(Image))
  For y = 1 To ImgH
    For x = 1 To ImgW
      PixelBuffer(y,x) = Point(x-1,y-1)
    Next
  Next
  StopDrawing()
  
  StartDrawing(ImageOutput(RImage))
  For y = 1 To ImgW
    For x = 1 To ImgH
      Plot(x-1,y-1,PixelBuffer(x,y))
    Next
  Next
  StopDrawing()
  
  ProcedureReturn RImage
EndProcedure

Input.s = InputRequester("Barcode Generator","Bitte Message zum Codieren eingeben!","")

Image = GenerateCodeMage(Input,#BWidth,#BLength,#BDepth)
ImageRot = RotateImagePiHalfRad(Image)
FreeImage(Image)

SaveImage(ImageRot,SaveFileRequester("Wo?","","*.png|*.png",0), #PB_ImagePlugin_PNG)
Gruß, Alex

Re: Code 128 - Barcode generator

Verfasst: 09.12.2016 23:57
von udg
Gibt es zufällig die Möglichkeit statt einem png ein CAD fähiges Dxf zu speichern?
Jemand eine Idee?

Danke

Re: Code 128 - Barcode generator

Verfasst: 10.12.2016 00:31
von man-in-black
Hi,

statt ob, solltest du dich als Programmierer lieber fragen, wie schnell bekomme ich es hin? ;)

Hier hast du den Aufbau des dxf Formates. Ist sicherlich etwas fummelig, sich da einzulesen,
aber am Ende kannst dir selbst nen Konverter schreiben.
http://www.autodesk.com/techpubs/autoca ... /index.htm

MFG
MIB

Re: Code 128 - Barcode generator

Verfasst: 10.12.2016 02:50
von udg
Danke dir. Ich war mit dem Telefon unterwegs und hab noch nicht groß nachgedacht wie ich es anstellen kann. Aber eine Frage zu einem Tipp sei erlaubt ;)
Danke dir

Re: Code 128 - Barcode generator

Verfasst: 13.12.2016 16:02
von DarkSoul
Funktioniert nicht.

Ich habe "Test 12345678" in den InputRequester() eingegeben.

Bekommen habe ich einen dicken schwarzen Block... /:->

Getestet unter PB 5.50 x86 unter Win8.1
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de