PureBoard

Code: Alles auswählen

; by Dige 10/2011
; http://www.purebasic.fr/english/viewtopic.php?f=12&t=47938
; Create 2D Barcodes (QRCode) based on qrencode-win32
; Requires: qrcodelib.lib, qrcodelib.dll
; http://code.google.com/p/qrencode-win32/downloads/list

Structure QRCode
  Version.l
  Width.l
  pSymbolData.l
EndStructure

Enumeration
  #QR_ECLEVEL_L = 0 ; lowest
  #QR_ECLEVEL_M
  #QR_ECLEVEL_Q
  #QR_ECLEVEL_H     ; highest
EndEnumeration

ImportC "..\Lib\qrcodelib.lib"
  QRcode_encodeString8bit(Text.p-ascii, Version.l, QRecLevel.l) As "_QRcode_encodeString8bit"
  QRcode_free(*Qrcode.QRCode) As "_QRcode_free"
EndImport

Procedure CreateQRCode (content.s, ImgID = #PB_Any, EC_Level = #QR_ECLEVEL_L, Size=4 )
  Protected *Qrcode.QRCode, QRImg
  
  *Qrcode = QRcode_encodeString8bit(content, 0, EC_Level)
  
  With *Qrcode
    If *Qrcode = 0 Or \Width = 0
      ProcedureReturn #Null
    Else
      *mem = \pSymbolData
      w    = \Width
    EndIf
  EndWith
  
  QRImg  = CreateImage(ImgID, w, w)
  
  If QRImg
    If ImgID = #PB_Any
      ImgID = QRImg
    EndIf
  EndIf
  
  If StartDrawing(ImageOutput(ImgID))
      ; White Background
      Box (0, 0, ImageWidth(ImgID), ImageHeight(ImgID), #White)  
      
      ; Draw Black Dots
      For y = 0 To w - 1
        For x = 0 To w - 1
          b = PeekB(*mem) & $FF
          If b & 1
            Plot( x, y, #Black)
          EndIf
          *mem + 1
        Next
      Next
      
    StopDrawing()
    
    w * Size
    ResizeImage( ImgID, w, w, #PB_Image_Raw)
  EndIf
  
  QRcode_free(*Qrcode)
  
  ProcedureReturn ImgID
EndProcedure

; Example, how to use it:
CreateImage(0, 200, 200)

OpenWindow(#Null, 0, 0, 450, 400, "2D Barcode Creator", #WS_OVERLAPPEDWINDOW|#PB_Window_ScreenCentered )
TextGadget(#PB_Any, 10, 4, 50, 16, "Text" )
StringGadget(0, 10, 20, 200, 20, "Feel the Pure Power!" )

TextGadget(#PB_Any, 10, 44, 50, 16, "EC_Level" )
TrackBarGadget(1, 10, 60, 100, 20, #QR_ECLEVEL_L, #QR_ECLEVEL_H, #PB_TrackBar_Ticks)

TextGadget(#PB_Any, 110, 44, 50, 16, "Size" )
TrackBarGadget(2, 110, 60, 100, 20, 1, 10, #PB_TrackBar_Ticks)

ImageGadget (3, 10, 90, 430, 550, ImageID(0), #PB_Image_Border)

Repeat
  
  Event = WaitWindowEvent()
  
  If Event = #PB_Event_Gadget
    Select EventGadget()
      Case 0, 1, 2
        ImgID = CreateQRCode(GetGadgetText(0), #Null, GetGadgetState(1), GetGadgetState(2))
        If IsImage(ImgID)
          SetGadgetState(3, ImageID(ImgID))
        EndIf
    EndSelect
  EndIf

Until Event = #PB_Event_CloseWindow

Code: Alles auswählen

ImportC "..\Lib\qrcodelib.lib"
  QRcode_encodeString8bit(Text.p-utf8, Version.l, QRecLevel.l) As "_QRcode_encodeString8bit"
  QRcode_free(*Qrcode.QRCode) As "_QRcode_free"
EndImport

Code: Alles auswählen

; by Dige 10/2011
; http://www.purebasic.fr/english/viewtopic.php?f=12&t=47938
; Create 2D Barcodes (QRCode) based on qrencode-win32
; Requires: qrcodelib.lib, qrcodelib.dll
; http://code.google.com/p/qrencode-win32/downloads/list
; Following added from Falko  11.02.2013
; DLL und lib  direkt hier:
; http://code.google.com/p/qrencode-win32/downloads/detail?name=qrcode-win32-3.1.1.zip&can=1&q=
; Save hinzugefügt alsauch nun zu EditorGadget geändert
; Compilerüberprüfung auf Unicde hinzugefügt sowie zu Text.p-utf8 im Import geändert

CompilerIf #PB_Compiler_Unicode = 0
    CompilerError "compile with UNICODE!"
CompilerEndIf

EnableExplicit

Define File.s
Define event.i
Define ImgID.i

Structure QRCode
  Version.l
  Width.l
  pSymbolData.l
EndStructure

Enumeration
  #QR_ECLEVEL_L = 0 ; lowest
  #QR_ECLEVEL_M
  #QR_ECLEVEL_Q
  #QR_ECLEVEL_H     ; highest
EndEnumeration


UseJPEGImageEncoder()


ImportC "qrcodelib.lib"
  QRcode_encodeString8bit(Text.p-utf8, Version.l, QRecLevel.i) As "_QRcode_encodeString8bit"
  QRcode_free(*Qrcode.QRCode) As "_QRcode_free"
EndImport

Procedure CreateQRCode (content.s, ImgID = #PB_Any, EC_Level = #QR_ECLEVEL_L, Size=4 )
  Protected *Qrcode.QRCode, QRImg, *mem, w, y, x, b
 
  *Qrcode = QRcode_encodeString8bit(content, 0, EC_Level)
 
  With *Qrcode
    If *Qrcode = 0 Or \Width = 0
      ProcedureReturn #Null
    Else
      *mem = \pSymbolData
      w    = \Width
    EndIf
  EndWith
 
  QRImg  = CreateImage(ImgID, w, w)
 
  If QRImg
    If ImgID = #PB_Any
      ImgID = QRImg
    EndIf
  EndIf
 
  If StartDrawing(ImageOutput(ImgID))
      ; White Background
      Box (0, 0, ImageWidth(ImgID), ImageHeight(ImgID), #White) 
     
      ; Draw Black Dots
      For y = 0 To w - 1
        For x = 0 To w - 1
          b = PeekB(*mem) & $FF
          If b & 1
            Plot( x, y, #Black)
          EndIf
          *mem + 1
        Next
      Next
     
    StopDrawing()
   
    w * Size
    ResizeImage( ImgID, w, w, #PB_Image_Raw)
  EndIf
 
  QRcode_free(*Qrcode)
 
  ProcedureReturn ImgID
EndProcedure

; Example, how to use it:
CreateImage(0, 200, 200)

OpenWindow(#Null, 0, 0, 850, 500, "2D Barcode Creator", #WS_OVERLAPPEDWINDOW|#PB_Window_ScreenCentered )
;TextGadget(#PB_Any, 10, 4, 50, 16, "Text" )
EditorGadget(0, 400, 50, 400, 350)

TextGadget(#PB_Any, 10, 44, 50, 16, "EC_Level" )
TrackBarGadget(1, 10, 60, 100, 20, #QR_ECLEVEL_L, #QR_ECLEVEL_H, #PB_TrackBar_Ticks)

TextGadget(#PB_Any, 110, 44, 50, 16, "Size" )
TrackBarGadget(2, 110, 60, 100, 20, 1, 10, #PB_TrackBar_Ticks)

ImageGadget (3, 10, 90, 430, 550, ImageID(0), #PB_Image_Border)

ButtonGadget(4,5,5,50,20,"Save")
AddGadgetItem(0, 0, "QR-Code hier einfügen")

Repeat
 
  Event = WaitWindowEvent()
 
  If Event = #PB_Event_Gadget
    Select EventGadget()
      Case 0, 1, 2
        ImgID = CreateQRCode(GetGadgetText(0), #Null, GetGadgetState(1), GetGadgetState(2))
        If IsImage(ImgID)
          SetGadgetState(3, ImageID(ImgID))
        EndIf
      Case 4
        File=SaveFileRequester("QR-Code als JPG speichern","QR-Image","jpg (*.jpg)",1)
        SaveImage(0,File+".jpg")
    EndSelect
  EndIf

Until Event = #PB_Event_CloseWindow