[Code] Barcode 128A [ALL OS]

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Mijikai
Beiträge: 754
Registriert: 25.09.2016 01:42

[Code] Barcode 128A [ALL OS]

Beitrag von Mijikai »

Funktion - Barcode 128A

Viel Spaß :)
Mode B & C fehlen noch!

Code:

Code: Alles auswählen

;#####################################################
;FUNCTION BARCODE128
;IDE:       PureBasic 5.62 (x64)
;Author:    Mijikai
;Version:   dev
;Note:      Only mode A is working for now!
;OS:        Should work on Windows, Linux and Mac!
;#####################################################

Procedure.i Barcode128A(Text.s,File.s,Height = 32)
  Protected *char.Ascii
  Protected *entry.Ascii
  Protected length.i
  Protected index.i
  Protected check.i
  Protected chars.i
  Protected tile.i
  Protected img.i
  Protected strip.i
  Protected offset.i
  Protected result.i
  If Text And File
    result = 1
    chars = Len(Text) + 3
    img = CreateImage(#PB_Any,(chars * 11) + 2,1,24,$FFFFFF)
    If IsImage(img)
      tile = CatchImage(#PB_Any,?barcode128_tile)
      If IsImage(tile)
        If StartDrawing(ImageOutput(img))  
          strip = GrabImage(tile,#PB_Any,0,103,11,1)
          If IsImage(strip)
            DrawImage(ImageID(strip),0,0,11,1)  
            FreeImage(strip)
            *char = @Text 
            Repeat
              length + 1
              offset + 11
              For index = 0 To 105
                *entry = ?Barcode128 + index
                If *entry\a = *char\a
                  check + (index * length)         
                  strip = GrabImage(tile,#PB_Any,0,index,11,1)
                  If IsImage(strip)
                    DrawImage(ImageID(strip),offset,0,11,1)
                    FreeImage(strip)
                  Else
                    result = 0
                    Break 2
                  EndIf
                  Break
                EndIf
              Next
              *char + 2
            Until *char\a = #Null
            If result
              strip = GrabImage(tile,#PB_Any,0,Mod(check,103),11,1)
              If IsImage(strip)
                DrawImage(ImageID(strip),offset + 11,0,11,1)
                FreeImage(strip)
                offset + 22
                Plot(offset,0,$0)
                Plot(offset + 1,0,$0)
                Plot(offset + 5,0,$0)
                Plot(offset + 6,0,$0)
                Plot(offset + 7,0,$0)
                Plot(offset + 9,0,$0)
                Plot(offset + 11,0,$0)
                Plot(offset + 12,0,$0)
                StopDrawing()
                If ResizeImage(img,#PB_Ignore,Height)
                  result = SaveImage(img,File)
                Else
                  result = 0
                EndIf
              Else
                result = 0
              EndIf
            EndIf
          Else
            result = 0
          EndIf
        EndIf
        FreeImage(tile)
      EndIf
      FreeImage(img)
    EndIf
  EndIf
  ProcedureReturn result
  barcode128:
  !db 0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2A,0x2B,0x2C,0x2D,0x2E,0x2F
  !db 0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3A,0x3B,0x3C,0x3D,0x3E,0x3F
  !db 0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4A,0x4B,0x4C,0x4D,0x4E,0x4F
  !db 0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5A,0x5B,0x5C,0x5D,0x5E,0x5F
  !db 0x27,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A,0x6B,0x6C,0x6D,0x6E,0x6F
  !db 0x70,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7A,0x7B,0x7C,0x7D,0x7E,0x7F,0x80
  !db 0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x8A,0x00,0x00,0x00,0x00,0x00,0x00
  barcode128_tile:
  !db 0x42,0x4D,0xE6,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x3E,0x00,0x00,0x00,0x28,0x00
  !db 0x00,0x00,0x0C,0x00,0x00,0x00,0x6A,0x00,0x00,0x00,0x01,0x00,0x01,0x00,0x00,0x00
  !db 0x00,0x00,0xA8,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0x00
  !db 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xFF,0xFF,0xFF,0x00,0x2C,0x70
  !db 0x00,0x00,0x2D,0xF0,0x00,0x00,0x2F,0x70,0x00,0x00,0x0A,0x30,0x00,0x00,0x14,0x30
  !db 0x00,0x00,0x42,0x30,0x00,0x00,0x44,0x30,0x00,0x00,0x0B,0xB0,0x00,0x00,0x0A,0xF0
  !db 0x00,0x00,0x43,0xB0,0x00,0x00,0x42,0xF0,0x00,0x00,0x74,0x30,0x00,0x00,0x5C,0x30
  !db 0x00,0x00,0x50,0xF0,0x00,0x00,0x09,0x30,0x00,0x00,0x21,0x30,0x00,0x00,0x24,0x30
  !db 0x00,0x00,0x0D,0xB0,0x00,0x00,0x0D,0x70,0x00,0x00,0x0B,0x70,0x00,0x00,0x61,0xB0
  !db 0x00,0x00,0x61,0x70,0x00,0x00,0x43,0x70,0x00,0x00,0x6C,0x30,0x00,0x00,0x68,0x70
  !db 0x00,0x00,0x58,0x70,0x00,0x00,0x70,0xB0,0x00,0x00,0x3D,0x70,0x00,0x00,0x08,0xB0
  !db 0x00,0x00,0x35,0xF0,0x00,0x00,0x3D,0xB0,0x00,0x00,0x79,0xB0,0x00,0x00,0x79,0x70
  !db 0x00,0x00,0x67,0xB0,0x00,0x00,0x65,0xF0,0x00,0x00,0x4F,0x70,0x00,0x00,0x4D,0xF0
  !db 0x00,0x00,0x7B,0x30,0x00,0x00,0x7A,0x70,0x00,0x00,0x6F,0x30,0x00,0x00,0x69,0xF0
  !db 0x00,0x00,0x5E,0x70,0x00,0x00,0x59,0xF0,0x00,0x00,0x0E,0xB0,0x00,0x00,0x37,0xB0
  !db 0x00,0x00,0x10,0xB0,0x00,0x00,0x1C,0xB0,0x00,0x00,0x13,0xB0,0x00,0x00,0x12,0xF0
  !db 0x00,0x00,0x1D,0x30,0x00,0x00,0x17,0x30,0x00,0x00,0x14,0xF0,0x00,0x00,0x22,0x30
  !db 0x00,0x00,0x23,0xB0,0x00,0x00,0x22,0xF0,0x00,0x00,0x3A,0x30,0x00,0x00,0x2E,0x30
  !db 0x00,0x00,0x11,0x30,0x00,0x00,0x71,0x30,0x00,0x00,0x47,0x30,0x00,0x00,0x44,0xF0
  !db 0x00,0x00,0x72,0x30,0x00,0x00,0x4E,0x30,0x00,0x00,0x48,0xF0,0x00,0x00,0x3B,0xB0
  !db 0x00,0x00,0x3A,0xF0,0x00,0x00,0x2E,0xF0,0x00,0x00,0x73,0xB0,0x00,0x00,0x72,0xF0
  !db 0x00,0x00,0x4E,0xF0,0x00,0x00,0x77,0x30,0x00,0x00,0x74,0xF0,0x00,0x00,0x5C,0xF0
  !db 0x00,0x00,0x39,0x30,0x00,0x00,0x27,0x30,0x00,0x00,0x24,0xF0,0x00,0x00,0x19,0xB0
  !db 0x00,0x00,0x19,0x70,0x00,0x00,0x13,0x70,0x00,0x00,0x1B,0x30,0x00,0x00,0x1A,0x70
  !db 0x00,0x00,0x16,0x70,0x00,0x00,0x12,0x30,0x00,0x00,0x31,0x70,0x00,0x00,0x23,0x70
  !db 0x00,0x00,0x36,0x30,0x00,0x00,0x34,0x70,0x00,0x00,0x31,0xB0,0x00,0x00,0x63,0x30
  !db 0x00,0x00,0x62,0x70,0x00,0x00,0x46,0x70,0x00,0x00,0x66,0x30,0x00,0x00,0x64,0x70
  !db 0x00,0x00,0x4C,0x70,0x00,0x00,0x3B,0x70,0x00,0x00,0x37,0x70,0x00,0x00,0x36,0xF0
  !db 0x00,0x00,0x73,0x70,0x00,0x00,0x67,0x70,0x00,0x00,0x66,0xF0,0x00,0x00,0x76,0x70
  !db 0x00,0x00,0x6E,0x70,0x00,0x00,0x6C,0xF0,0x00,0x00,0x33,0x30,0x00,0x00,0x32,0x70
  !db 0x00,0x00,0x26,0x70,0x00,0x00
EndProcedure

Debug Barcode128A("HELLO WORLD","testbc128a.bmp")
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: [Code] Barcode 128A [ALL OS]

Beitrag von RSBasic »

Funktioniert :allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Antworten