TheBackShed.com

Forum Index : Microcontroller and PC projects : QR Code

Author

Message

BishopXXL
Regular Member

Joined: 13/01/2019
Location: Germany
Posts: 41

Posted: 08:20am 19 May 2026

Copy link to clipboard

Print this post

Hello,
since I have already received so much information and code
from you all, I would like to start by thanking you here.
I was looking for a solution that would allow me to
tell a mobile phone what IP address belongs to the client
that logged in after activating a hotspot.
To do this, I switch on the camera and scan the QR code
displayed on the screen. Of course, a real AP would be even nicer. ;)

Anyway, here is the code—generated with Claude Opus 4.5.
I find it useful for my purposes.
I wanted to share it with you.

BishopXXL

' ============================================
' QR-Code Generator fuer MMBasic
' PicoMite RP2350 - Display 320x240
' Version 1 QR-Code (21x21 Module)
' Byte-Mode, Error Correction Level L
' ============================================
' Eingabe: IP$ = "192.168.0.122" (max 17 Zeichen)
' Ausgabe: QR-Code auf Display
' ============================================

Option Explicit
Option Default None

' ---- Konfiguration ----
Dim IP$ Length 32
IP$ = "192.168.110.122" ' <-- Hier IP-Adresse eingeben

' ---- Konstanten fuer QR Version 1, Level L ----
Const QR_SIZE = 21 ' 21x21 Module
Const DATA_CODEWORDS = 19 ' Daten-Codewords
Const EC_CODEWORDS = 7 ' Fehlerkorrektur-Codewords
Const TOTAL_CODEWORDS = 26

' ---- Display-Konfiguration ----
' ST7796S im RPORTRAIT Modus: 320x480 Pixel
Const DISPLAY_W = 320
Const DISPLAY_H = 480
Const MODULE_SIZE = 10 ' Pixel pro QR-Modul (10x10 = 210x210 gesamt)
Const OFFSET_X = 10 ' Linke obere Ecke X
Const OFFSET_Y = 10 ' Linke obere Ecke Y

' ---- Arrays ----
Dim Integer QR(QR_SIZE-1, QR_SIZE-1) ' QR Matrix (0=weiss, 1=schwarz)
Dim Integer Reserved(QR_SIZE-1, QR_SIZE-1) ' Reservierte Bereiche
Dim Integer DataBits(256) ' Daten-Bitstream
Dim Integer Codewords(TOTAL_CODEWORDS-1) ' Alle Codewords
Dim Integer GF_EXP(255) ' Galois Field Exp Table
Dim Integer GF_LOG(255) ' Galois Field Log Table
Dim Integer Generator(EC_CODEWORDS) ' Generator-Polynom

Dim Integer BitCount, ByteIndex, i, j, x, y
Dim Integer BestMask, BestPenalty, Penalty, Mask

' ============================================
' Hauptprogramm
' ============================================
Sub Main
Print "QR-Code Generator"
Print "IP: "; IP$
Print

' Galois Field initialisieren
InitGaloisField

' Generator-Polynom berechnen
CalcGenerator

' Daten codieren
EncodeData IP$

' Reed-Solomon Fehlerkorrektur
CalcErrorCorrection

' QR-Matrix aufbauen
InitQRMatrix

' Daten in Matrix einfuegen
PlaceData

' Beste Maske finden und anwenden
BestMask = FindBestMask()
ApplyMask BestMask

' Format-Information einfuegen
PlaceFormatInfo BestMask

' QR-Code anzeigen
DrawQRCode

Print "Fertig! Maske: "; BestMask
End Sub

' ============================================
' Galois Field GF(256) initialisieren
' Primitives Polynom: x^8 + x^4 + x^3 + x^2 + 1 = 0x11D
' ============================================
Sub InitGaloisField
Local Integer x, i
x = 1
For i = 0 To 254
GF_EXP(i) = x
GF_LOG(x) = i
x = x * 2
If x >= 256 Then x = x Xor &H11D
Next i
GF_LOG(0) = -1 ' Log(0) undefiniert
End Sub

' ============================================
' Galois Field Multiplikation
' ============================================
Function GF_Mul(a As Integer, b As Integer) As Integer
If a = 0 Or b = 0 Then
GF_Mul = 0
Else
GF_Mul = GF_EXP((GF_LOG(a) + GF_LOG(b)) Mod 255)
EndIf
End Function

' ============================================
' Generator-Polynom fuer 7 EC-Codewords berechnen
' g(x) = (x-a^0)(x-a^1)...(x-a^6)
' ============================================
Sub CalcGenerator
Local Integer i, j, temp

' Start mit g(x) = 1
For i = 0 To EC_CODEWORDS
Generator(i) = 0
Next i
Generator(0) = 1

' Multipliziere mit (x - a^i) fuer i = 0 bis 6
For i = 0 To EC_CODEWORDS - 1
' Multiplikation mit (x - a^i) = (x + a^i) in GF(256)
For j = EC_CODEWORDS To 1 Step -1
Generator(j) = Generator(j-1) Xor GF_Mul(Generator(j), GF_EXP(i))
Next j
Generator(0) = GF_Mul(Generator(0), GF_EXP(i))
Next i
End Sub

' ============================================
' Daten im Byte-Mode codieren
' ============================================
Sub EncodeData(text$)
Local Integer i, len, val, bit
Local Integer bitPos

len = Len(text$)
If len > 17 Then
Print "Fehler: Text zu lang (max 17 Zeichen)"
End
EndIf

bitPos = 0

' Mode Indicator: Byte Mode = 0100
AddBits 4, 4, bitPos

' Character Count (8 Bit fuer Version 1 Byte Mode)
AddBits len, 8, bitPos

' Daten-Bytes
For i = 1 To len
val = Asc(Mid$(text$, i, 1))
AddBits val, 8, bitPos
Next i

' Terminator (max 4 Bits)
For i = 1 To Min(4, DATA_CODEWORDS * 8 - bitPos)
AddBits 0, 1, bitPos
Next i

' Auf Byte-Grenze auffuellen
Do While (bitPos Mod 8) <> 0
AddBits 0, 1, bitPos
Loop

' Mit Pad-Bytes auffuellen (0xEC, 0x11 alternierend)
i = 0
Do While bitPos < DATA_CODEWORDS * 8
If (i Mod 2) = 0 Then
AddBits &HEC, 8, bitPos
Else
AddBits &H11, 8, bitPos
EndIf
i = i + 1
Loop

BitCount = bitPos

' Bits zu Codewords konvertieren
For i = 0 To DATA_CODEWORDS - 1
Codewords(i) = 0
For bit = 0 To 7
If DataBits(i * 8 + bit) Then
Codewords(i) = Codewords(i) Or (128 >> bit)
EndIf
Next bit
Next i
End Sub

' ============================================
' Bits zum Datenstrom hinzufuegen
' ============================================
Sub AddBits(value As Integer, numBits As Integer, ByRef bitPos As Integer)
Local Integer i, mask
For i = numBits - 1 To 0 Step -1
mask = 1 << i
If (value And mask) Then
DataBits(bitPos) = 1
Else
DataBits(bitPos) = 0
EndIf
bitPos = bitPos + 1
Next i
End Sub

' ============================================
' Reed-Solomon Fehlerkorrektur berechnen
' ============================================
Sub CalcErrorCorrection
Local Integer i, j, coef, remainder(EC_CODEWORDS-1)

' Initialisiere Rest mit 0
For i = 0 To EC_CODEWORDS - 1
remainder(i) = 0
Next i

' Polynom-Division
For i = 0 To DATA_CODEWORDS - 1
coef = Codewords(i) Xor remainder(0)
' Rest nach links schieben
For j = 0 To EC_CODEWORDS - 2
remainder(j) = remainder(j + 1)
Next j
remainder(EC_CODEWORDS - 1) = 0
' Generator * coef addieren
For j = 0 To EC_CODEWORDS - 1
remainder(j) = remainder(j) Xor GF_Mul(Generator(EC_CODEWORDS - 1 - j), coef)
Next j
Next i

' EC-Codewords anhaengen
For i = 0 To EC_CODEWORDS - 1
Codewords(DATA_CODEWORDS + i) = remainder(i)
Next i
End Sub

' ============================================
' QR-Matrix initialisieren mit Finder Patterns etc.
' ============================================
Sub InitQRMatrix
Local Integer i, j, x, y

' Alles auf 0 (weiss) setzen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
QR(x, y) = 0
Reserved(x, y) = 0
Next x
Next y

' Finder Patterns (3 Ecken)
DrawFinderPattern 0, 0
DrawFinderPattern QR_SIZE - 7, 0
DrawFinderPattern 0, QR_SIZE - 7

' Timing Patterns
For i = 8 To QR_SIZE - 9
QR(i, 6) = (i + 1) Mod 2
Reserved(i, 6) = 1
QR(6, i) = (i + 1) Mod 2
Reserved(6, i) = 1
Next i

' Dark Module (immer schwarz)
QR(8, QR_SIZE - 8) = 1
Reserved(8, QR_SIZE - 8) = 1

' Format-Information Bereiche reservieren
For i = 0 To 8
Reserved(i, 8) = 1
Reserved(8, i) = 1
Next i
For i = QR_SIZE - 8 To QR_SIZE - 1
Reserved(i, 8) = 1
Next i
For i = QR_SIZE - 7 To QR_SIZE - 1
Reserved(8, i) = 1
Next i
End Sub

' ============================================
' Finder Pattern zeichnen (7x7)
' ============================================
Sub DrawFinderPattern(px As Integer, py As Integer)
Local Integer x, y, dx, dy

For dy = 0 To 6
For dx = 0 To 6
x = px + dx
y = py + dy
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
' Aeusserer Rahmen oder Kern = schwarz
If dx = 0 Or dx = 6 Or dy = 0 Or dy = 6 Then
QR(x, y) = 1
ElseIf dx >= 2 And dx <= 4 And dy >= 2 And dy <= 4 Then
QR(x, y) = 1
Else
QR(x, y) = 0
EndIf
Reserved(x, y) = 1
EndIf
Next dx
Next dy

' Separator (weiss, 1 Pixel breit)
For i = -1 To 7
x = px + i
y = py - 1
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
y = py + 7
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
Next i
For i = 0 To 6
x = px - 1
y = py + i
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
x = px + 7
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
Next i
End Sub

' ============================================
' Daten in die Matrix platzieren
' ============================================
Sub PlaceData
Local Integer bitIndex, byteIndex, bit
Local Integer x, y, col, upward, row

bitIndex = 0
col = QR_SIZE - 1
upward = 1

Do While col >= 0
' Spalte 6 ueberspringen (Timing Pattern)
If col = 6 Then col = col - 1

For row = 0 To QR_SIZE - 1
If upward Then
y = QR_SIZE - 1 - row
Else
y = row
EndIf

' Zwei Spalten pro Durchgang
For x = col To col - 1 Step -1
If x >= 0 And Reserved(x, y) = 0 Then
If bitIndex < TOTAL_CODEWORDS * 8 Then
byteIndex = bitIndex \ 8
bit = 7 - (bitIndex Mod 8)
If (Codewords(byteIndex) And (1 << bit)) Then
QR(x, y) = 1
Else
QR(x, y) = 0
EndIf
bitIndex = bitIndex + 1
EndIf
EndIf
Next x
Next row

upward = 1 - upward
col = col - 2
Loop
End Sub

' ============================================
' Beste Maske finden
' ============================================
Function FindBestMask() As Integer
Local Integer mask, penalty, bestMask, bestPenalty
Local Integer tempQR(QR_SIZE-1, QR_SIZE-1)
Local Integer x, y

bestPenalty = 999999
bestMask = 0

' Original QR speichern
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
tempQR(x, y) = QR(x, y)
Next x
Next y

For mask = 0 To 7
' Original wiederherstellen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
QR(x, y) = tempQR(x, y)
Next x
Next y

ApplyMask mask
penalty = CalcPenalty()

If penalty < bestPenalty Then
bestPenalty = penalty
bestMask = mask
EndIf
Next mask

' Original wiederherstellen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
QR(x, y) = tempQR(x, y)
Next x
Next y

FindBestMask = bestMask
End Function

' ============================================
' Maske anwenden
' ============================================
Sub ApplyMask(mask As Integer)
Local Integer x, y, invert

For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
If Reserved(x, y) = 0 Then
Select Case mask
Case 0: invert = ((x + y) Mod 2 = 0)
Case 1: invert = (y Mod 2 = 0)
Case 2: invert = (x Mod 3 = 0)
Case 3: invert = ((x + y) Mod 3 = 0)
Case 4: invert = (((y \ 2) + (x \ 3)) Mod 2 = 0)
Case 5: invert = (((x * y) Mod 2) + ((x * y) Mod 3) = 0)
Case 6: invert = ((((x * y) Mod 2) + ((x * y) Mod 3)) Mod 2 = 0)
Case 7: invert = ((((x + y) Mod 2) + ((x * y) Mod 3)) Mod 2 = 0)
End Select
If invert Then QR(x, y) = 1 - QR(x, y)
EndIf
Next x
Next y
End Sub

' ============================================
' Penalty-Score berechnen (vereinfacht)
' ============================================
Function CalcPenalty() As Integer
Local Integer penalty, x, y, count, last

penalty = 0

' Regel 1: Zeilen mit 5+ gleichen Modulen
For y = 0 To QR_SIZE - 1
count = 1
last = QR(0, y)
For x = 1 To QR_SIZE - 1
If QR(x, y) = last Then
count = count + 1
Else
If count >= 5 Then penalty = penalty + 3 + (count - 5)
count = 1
last = QR(x, y)
EndIf
Next x
If count >= 5 Then penalty = penalty + 3 + (count - 5)
Next y

' Regel 1: Spalten mit 5+ gleichen Modulen
For x = 0 To QR_SIZE - 1
count = 1
last = QR(x, 0)
For y = 1 To QR_SIZE - 1
If QR(x, y) = last Then
count = count + 1
Else
If count >= 5 Then penalty = penalty + 3 + (count - 5)
count = 1
last = QR(x, y)
EndIf
Next y
If count >= 5 Then penalty = penalty + 3 + (count - 5)
Next x

CalcPenalty = penalty
End Function

' ============================================
' Format-Information platzieren
' Level L = 01, Mask Pattern = mask (3 Bit)
' ============================================
Sub PlaceFormatInfo(mask As Integer)
Local Integer formatBits, i, bit
Local Integer formatData, remainder
Local Integer positions(14, 1)

' Format: 01 (Level L) + mask (3 Bit) = 5 Bit
formatData = (&B01 << 3) Or mask

' BCH(15,5) Fehlerkorrektur
remainder = formatData << 10
For i = 14 To 10 Step -1
If remainder And (1 << i) Then
remainder = remainder Xor (&H537 << (i - 10))
EndIf
Next i
formatBits = ((formatData << 10) Or remainder) Xor &H5412

' Positionen fuer Format-Bits (horizontal um Finder oben-links)
' Bits 0-5: Position (8,0) bis (8,5)
' Bit 6: Position (8,7)
' Bit 7: Position (8,8)
' Bits 8-14: Position (7,8) bis (0,8) - ABER Bit 6 ueberspringen!

' Erste Kopie (um oberes linkes Finder Pattern)
For i = 0 To 5
bit = (formatBits >> i) And 1
QR(8, i) = bit
Next i
QR(8, 7) = (formatBits >> 6) And 1
QR(8, 8) = (formatBits >> 7) And 1
QR(7, 8) = (formatBits >> 8) And 1
For i = 9 To 14
bit = (formatBits >> i) And 1
QR(14 - i, 8) = bit
Next i

' Zweite Kopie (rechts und unten)
For i = 0 To 7
bit = (formatBits >> i) And 1
QR(QR_SIZE - 1 - i, 8) = bit
Next i
For i = 8 To 14
bit = (formatBits >> i) And 1
QR(8, QR_SIZE - 15 + i) = bit
Next i
End Sub

' ============================================
' QR-Code auf Display zeichnen
' ============================================
Sub DrawQRCode
Local Integer x, y, px, py, qw, qh, qx, qy

' Display loeschen
Cls RGB(White)

' Quiet Zone Berechnung
qx = OFFSET_X - MODULE_SIZE * 2
qy = OFFSET_Y - MODULE_SIZE * 2
qw = QR_SIZE * MODULE_SIZE + MODULE_SIZE * 4
qh = qw

' Weisser Rand (Quiet Zone)
Box qx, qy, qw, qh, 0, RGB(White), RGB(White)

' QR-Module zeichnen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
px = OFFSET_X + x * MODULE_SIZE
py = OFFSET_Y + y * MODULE_SIZE
If QR(x, y) = 1 Then
Box px, py, MODULE_SIZE, MODULE_SIZE, 0, RGB(Black), RGB(Black)
Else
Box px, py, MODULE_SIZE, MODULE_SIZE, 0, RGB(White), RGB(White)
EndIf
Next x
Next y
End Sub

' ============================================
' Programm starten
' ============================================
Main
End

dddns
Guru

Joined: 20/09/2024
Location: Germany
Posts: 832

Posted: 09:21am 19 May 2026

Copy link to clipboard

Print this post

Really nice, thanks!

Volhout
Guru

Joined: 05/03/2018
Location: Netherlands
Posts: 5880

Posted: 09:30am 19 May 2026

Copy link to clipboard

Print this post

Thank you,

Works fine on RP2040VGA.

Volhout

PicomiteVGA PETSCII ROBOTS

BishopXXL
Regular Member

Joined: 13/01/2019
Location: Germany
Posts: 41

Posted: 09:43am 19 May 2026

Copy link to clipboard

Print this post

Hallo,

In case anyone is still interested in an extension, I'm posting Version 2 (with 25x25 modules) so that "http://" fits before the IP address—something I really could have just built in right from the start! ;)

WebMite MMBasic RP2350A Edition V6.03.00RC9

' ============================================
' QR-Code Generator fuer MMBasic
' PicoMite RP2350 - Display 320x480
' Version 2 QR-Code (25x25 Module)
' Byte-Mode, Error Correction Level L
' ============================================
' Eingabe: IP$ = "http://192.168.0.122" (max 32 Zeichen)
' Ausgabe: QR-Code auf Display
' ============================================

Option Explicit
Option Default None

' ---- Konfiguration ----
Dim IP$ Length 64
'IP$ = "http://192.168.110.122" ' <-- Hier URL eingeben
IP$ = "http://" + MM.Info$(IP ADDRESS) ' <-- Hier URL eingeben

' ---- Konstanten fuer QR Version 2, Level L ----
Const QR_SIZE = 25 ' 25x25 Module
Const DATA_CODEWORDS = 34 ' Daten-Codewords
Const EC_CODEWORDS = 10 ' Fehlerkorrektur-Codewords
Const TOTAL_CODEWORDS = 44

' ---- Display-Konfiguration ----
' ST7796S im RPORTRAIT Modus: 320x480 Pixel
Const DISPLAY_W = 320
Const DISPLAY_H = 480
Const MODULE_SIZE = 8 ' Pixel pro QR-Modul (8x8 = 200x200 gesamt)
Const OFFSET_X = 10 ' Linke obere Ecke X
Const OFFSET_Y = 10 ' Linke obere Ecke Y

' ---- Arrays ----
Dim Integer QR(QR_SIZE-1, QR_SIZE-1) ' QR Matrix (0=weiss, 1=schwarz)
Dim Integer Reserved(QR_SIZE-1, QR_SIZE-1) ' Reservierte Bereiche
Dim Integer DataBits(300) ' Daten-Bitstream
Dim Integer Codewords(TOTAL_CODEWORDS-1) ' Alle Codewords
Dim Integer GF_EXP(255) ' Galois Field Exp Table
Dim Integer GF_LOG(255) ' Galois Field Log Table
Dim Integer Generator(EC_CODEWORDS) ' Generator-Polynom

Dim Integer BitCount, ByteIndex, i, j, x, y
Dim Integer BestMask, BestPenalty, Penalty, Mask

' ============================================
' Hauptprogramm
' ============================================
Sub Main
Print "QR-Code Generator"
Print "IP: "; IP$
Print

' Galois Field initialisieren
InitGaloisField

' Generator-Polynom berechnen
CalcGenerator

' Daten codieren
EncodeData IP$

' Reed-Solomon Fehlerkorrektur
CalcErrorCorrection

' QR-Matrix aufbauen
InitQRMatrix

' Daten in Matrix einfuegen
PlaceData

' Beste Maske finden und anwenden
BestMask = FindBestMask()
ApplyMask BestMask

' Format-Information einfuegen
PlaceFormatInfo BestMask

' QR-Code anzeigen
DrawQRCode

Print "Fertig! Maske: "; BestMask
End Sub

' ============================================
' Galois Field GF(256) initialisieren
' Primitives Polynom: x^8 + x^4 + x^3 + x^2 + 1 = 0x11D
' ============================================
Sub InitGaloisField
Local Integer x, i
x = 1
For i = 0 To 254
GF_EXP(i) = x
GF_LOG(x) = i
x = x * 2
If x >= 256 Then x = x Xor &H11D
Next i
GF_LOG(0) = -1 ' Log(0) undefiniert
End Sub

' ============================================
' Galois Field Multiplikation
' ============================================
Function GF_Mul(a As Integer, b As Integer) As Integer
If a = 0 Or b = 0 Then
GF_Mul = 0
Else
GF_Mul = GF_EXP((GF_LOG(a) + GF_LOG(b)) Mod 255)
EndIf
End Function

' ============================================
' Generator-Polynom fuer 7 EC-Codewords berechnen
' g(x) = (x-a^0)(x-a^1)...(x-a^6)
' ============================================
Sub CalcGenerator
Local Integer i, j, temp

' Start mit g(x) = 1
For i = 0 To EC_CODEWORDS
Generator(i) = 0
Next i
Generator(0) = 1

' Multipliziere mit (x - a^i) fuer i = 0 bis 6
For i = 0 To EC_CODEWORDS - 1
' Multiplikation mit (x - a^i) = (x + a^i) in GF(256)
For j = EC_CODEWORDS To 1 Step -1
Generator(j) = Generator(j-1) Xor GF_Mul(Generator(j), GF_EXP(i))
Next j
Generator(0) = GF_Mul(Generator(0), GF_EXP(i))
Next i
End Sub

' ============================================
' Daten im Byte-Mode codieren
' ============================================
Sub EncodeData(text$)
Local Integer i, len, val, bit
Local Integer bitPos

len = Len(text$)
If len > 32 Then
Print "Fehler: Text zu lang (max 32 Zeichen)"
End
EndIf

bitPos = 0

' Mode Indicator: Byte Mode = 0100
AddBits 4, 4, bitPos

' Character Count (8 Bit fuer Version 1 Byte Mode)
AddBits len, 8, bitPos

' Daten-Bytes
For i = 1 To len
val = Asc(Mid$(text$, i, 1))
AddBits val, 8, bitPos
Next i

' Terminator (max 4 Bits)
For i = 1 To Min(4, DATA_CODEWORDS * 8 - bitPos)
AddBits 0, 1, bitPos
Next i

' Auf Byte-Grenze auffuellen
Do While (bitPos Mod 8) <> 0
AddBits 0, 1, bitPos
Loop

' Mit Pad-Bytes auffuellen (0xEC, 0x11 alternierend)
i = 0
Do While bitPos < DATA_CODEWORDS * 8
If (i Mod 2) = 0 Then
AddBits &HEC, 8, bitPos
Else
AddBits &H11, 8, bitPos
EndIf
i = i + 1
Loop

BitCount = bitPos

' Bits zu Codewords konvertieren
For i = 0 To DATA_CODEWORDS - 1
Codewords(i) = 0
For bit = 0 To 7
If DataBits(i * 8 + bit) Then
Codewords(i) = Codewords(i) Or (128 >> bit)
EndIf
Next bit
Next i
End Sub

' ============================================
' Bits zum Datenstrom hinzufuegen
' ============================================
Sub AddBits(value As Integer, numBits As Integer, ByRef bitPos As Integer)
Local Integer i, mask
For i = numBits - 1 To 0 Step -1
mask = 1 << i
If (value And mask) Then
DataBits(bitPos) = 1
Else
DataBits(bitPos) = 0
EndIf
bitPos = bitPos + 1
Next i
End Sub

' ============================================
' Reed-Solomon Fehlerkorrektur berechnen
' ============================================
Sub CalcErrorCorrection
Local Integer i, j, coef, remainder(EC_CODEWORDS-1)

' Initialisiere Rest mit 0
For i = 0 To EC_CODEWORDS - 1
remainder(i) = 0
Next i

' Polynom-Division
For i = 0 To DATA_CODEWORDS - 1
coef = Codewords(i) Xor remainder(0)
' Rest nach links schieben
For j = 0 To EC_CODEWORDS - 2
remainder(j) = remainder(j + 1)
Next j
remainder(EC_CODEWORDS - 1) = 0
' Generator * coef addieren
For j = 0 To EC_CODEWORDS - 1
remainder(j) = remainder(j) Xor GF_Mul(Generator(EC_CODEWORDS - 1 - j), coef)
Next j
Next i

' EC-Codewords anhaengen
For i = 0 To EC_CODEWORDS - 1
Codewords(DATA_CODEWORDS + i) = remainder(i)
Next i
End Sub

' ============================================
' QR-Matrix initialisieren mit Finder Patterns etc.
' ============================================
Sub InitQRMatrix
Local Integer i, j, x, y

' Alles auf 0 (weiss) setzen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
QR(x, y) = 0
Reserved(x, y) = 0
Next x
Next y

' Finder Patterns (3 Ecken)
DrawFinderPattern 0, 0
DrawFinderPattern QR_SIZE - 7, 0
DrawFinderPattern 0, QR_SIZE - 7

' Alignment Pattern fuer Version 2 (Position 18,18)
DrawAlignmentPattern 18, 18

' Timing Patterns
For i = 8 To QR_SIZE - 9
QR(i, 6) = (i + 1) Mod 2
Reserved(i, 6) = 1
QR(6, i) = (i + 1) Mod 2
Reserved(6, i) = 1
Next i

' Dark Module (immer schwarz)
QR(8, QR_SIZE - 8) = 1
Reserved(8, QR_SIZE - 8) = 1

' Format-Information Bereiche reservieren
For i = 0 To 8
Reserved(i, 8) = 1
Reserved(8, i) = 1
Next i
For i = QR_SIZE - 8 To QR_SIZE - 1
Reserved(i, 8) = 1
Next i
For i = QR_SIZE - 7 To QR_SIZE - 1
Reserved(8, i) = 1
Next i
End Sub

' ============================================
' Finder Pattern zeichnen (7x7)
' ============================================
Sub DrawFinderPattern(px As Integer, py As Integer)
Local Integer x, y, dx, dy

For dy = 0 To 6
For dx = 0 To 6
x = px + dx
y = py + dy
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
' Aeusserer Rahmen oder Kern = schwarz
If dx = 0 Or dx = 6 Or dy = 0 Or dy = 6 Then
QR(x, y) = 1
ElseIf dx >= 2 And dx <= 4 And dy >= 2 And dy <= 4 Then
QR(x, y) = 1
Else
QR(x, y) = 0
EndIf
Reserved(x, y) = 1
EndIf
Next dx
Next dy

' Separator (weiss, 1 Pixel breit)
For i = -1 To 7
x = px + i
y = py - 1
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
y = py + 7
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
Next i
For i = 0 To 6
x = px - 1
y = py + i
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
x = px + 7
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
QR(x, y) = 0
Reserved(x, y) = 1
EndIf
Next i
End Sub

' ============================================
' Alignment Pattern zeichnen (5x5) - fuer Version 2+
' ============================================
Sub DrawAlignmentPattern(cx As Integer, cy As Integer)
Local Integer x, y, dx, dy

For dy = -2 To 2
For dx = -2 To 2
x = cx + dx
y = cy + dy
If x >= 0 And x < QR_SIZE And y >= 0 And y < QR_SIZE Then
' Aeusserer Rahmen oder Zentrum = schwarz
If dx = -2 Or dx = 2 Or dy = -2 Or dy = 2 Then
QR(x, y) = 1
ElseIf dx = 0 And dy = 0 Then
QR(x, y) = 1
Else
QR(x, y) = 0
EndIf
Reserved(x, y) = 1
EndIf
Next dx
Next dy
End Sub

' ============================================
' Daten in die Matrix platzieren
' ============================================
Sub PlaceData
Local Integer bitIndex, byteIndex, bit
Local Integer x, y, col, upward, row

bitIndex = 0
col = QR_SIZE - 1
upward = 1

Do While col >= 0
' Spalte 6 ueberspringen (Timing Pattern)
If col = 6 Then col = col - 1

For row = 0 To QR_SIZE - 1
If upward Then
y = QR_SIZE - 1 - row
Else
y = row
EndIf

' Zwei Spalten pro Durchgang
For x = col To col - 1 Step -1
If x >= 0 And Reserved(x, y) = 0 Then
If bitIndex < TOTAL_CODEWORDS * 8 Then
byteIndex = bitIndex \ 8
bit = 7 - (bitIndex Mod 8)
If (Codewords(byteIndex) And (1 << bit)) Then
QR(x, y) = 1
Else
QR(x, y) = 0
EndIf
bitIndex = bitIndex + 1
EndIf
EndIf
Next x
Next row

upward = 1 - upward
col = col - 2
Loop
End Sub

' ============================================
' Beste Maske finden
' ============================================
Function FindBestMask() As Integer
Local Integer mask, penalty, bestMask, bestPenalty
Local Integer tempQR(QR_SIZE-1, QR_SIZE-1)
Local Integer x, y

bestPenalty = 999999
bestMask = 0

' Original QR speichern
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
tempQR(x, y) = QR(x, y)
Next x
Next y

For mask = 0 To 7
' Original wiederherstellen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
QR(x, y) = tempQR(x, y)
Next x
Next y

ApplyMask mask
penalty = CalcPenalty()

If penalty < bestPenalty Then
bestPenalty = penalty
bestMask = mask
EndIf
Next mask

' Original wiederherstellen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
QR(x, y) = tempQR(x, y)
Next x
Next y

FindBestMask = bestMask
End Function

' ============================================
' Maske anwenden
' ============================================
Sub ApplyMask(mask As Integer)
Local Integer x, y, invert

For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
If Reserved(x, y) = 0 Then
Select Case mask
Case 0: invert = ((x + y) Mod 2 = 0)
Case 1: invert = (y Mod 2 = 0)
Case 2: invert = (x Mod 3 = 0)
Case 3: invert = ((x + y) Mod 3 = 0)
Case 4: invert = (((y \ 2) + (x \ 3)) Mod 2 = 0)
Case 5: invert = (((x * y) Mod 2) + ((x * y) Mod 3) = 0)
Case 6: invert = ((((x * y) Mod 2) + ((x * y) Mod 3)) Mod 2 = 0)
Case 7: invert = ((((x + y) Mod 2) + ((x * y) Mod 3)) Mod 2 = 0)
End Select
If invert Then QR(x, y) = 1 - QR(x, y)
EndIf
Next x
Next y
End Sub

' ============================================
' Penalty-Score berechnen (vereinfacht)
' ============================================
Function CalcPenalty() As Integer
Local Integer penalty, x, y, count, last

penalty = 0

' Regel 1: Zeilen mit 5+ gleichen Modulen
For y = 0 To QR_SIZE - 1
count = 1
last = QR(0, y)
For x = 1 To QR_SIZE - 1
If QR(x, y) = last Then
count = count + 1
Else
If count >= 5 Then penalty = penalty + 3 + (count - 5)
count = 1
last = QR(x, y)
EndIf
Next x
If count >= 5 Then penalty = penalty + 3 + (count - 5)
Next y

' Regel 1: Spalten mit 5+ gleichen Modulen
For x = 0 To QR_SIZE - 1
count = 1
last = QR(x, 0)
For y = 1 To QR_SIZE - 1
If QR(x, y) = last Then
count = count + 1
Else
If count >= 5 Then penalty = penalty + 3 + (count - 5)
count = 1
last = QR(x, y)
EndIf
Next y
If count >= 5 Then penalty = penalty + 3 + (count - 5)
Next x

CalcPenalty = penalty
End Function

' ============================================
' Format-Information platzieren
' Level L = 01, Mask Pattern = mask (3 Bit)
' ============================================
Sub PlaceFormatInfo(mask As Integer)
Local Integer formatBits, i, bit
Local Integer formatData, remainder
Local Integer positions(14, 1)

' Format: 01 (Level L) + mask (3 Bit) = 5 Bit
formatData = (&B01 << 3) Or mask

' BCH(15,5) Fehlerkorrektur
remainder = formatData << 10
For i = 14 To 10 Step -1
If remainder And (1 << i) Then
remainder = remainder Xor (&H537 << (i - 10))
EndIf
Next i
formatBits = ((formatData << 10) Or remainder) Xor &H5412

' Positionen fuer Format-Bits (horizontal um Finder oben-links)
' Bits 0-5: Position (8,0) bis (8,5)
' Bit 6: Position (8,7)
' Bit 7: Position (8,8)
' Bits 8-14: Position (7,8) bis (0,8) - ABER Bit 6 ueberspringen!

' Erste Kopie (um oberes linkes Finder Pattern)
For i = 0 To 5
bit = (formatBits >> i) And 1
QR(8, i) = bit
Next i
QR(8, 7) = (formatBits >> 6) And 1
QR(8, 8) = (formatBits >> 7) And 1
QR(7, 8) = (formatBits >> 8) And 1
For i = 9 To 14
bit = (formatBits >> i) And 1
QR(14 - i, 8) = bit
Next i

' Zweite Kopie (rechts und unten)
For i = 0 To 7
bit = (formatBits >> i) And 1
QR(QR_SIZE - 1 - i, 8) = bit
Next i
For i = 8 To 14
bit = (formatBits >> i) And 1
QR(8, QR_SIZE - 15 + i) = bit
Next i
End Sub

' ============================================
' QR-Code auf Display zeichnen
' ============================================
Sub DrawQRCode
Local Integer x, y, px, py, qw, qh, qx, qy

' Display loeschen
Cls RGB(White)

' Quiet Zone Berechnung
qx = OFFSET_X - MODULE_SIZE * 2
qy = OFFSET_Y - MODULE_SIZE * 2
qw = QR_SIZE * MODULE_SIZE + MODULE_SIZE * 4
qh = qw

' Weisser Rand (Quiet Zone)
Box qx, qy, qw, qh, 0, RGB(White), RGB(White)

' QR-Module zeichnen
For y = 0 To QR_SIZE - 1
For x = 0 To QR_SIZE - 1
px = OFFSET_X + x * MODULE_SIZE
py = OFFSET_Y + y * MODULE_SIZE
If QR(x, y) = 1 Then
Box px, py, MODULE_SIZE, MODULE_SIZE, 0, RGB(Black), RGB(Black)
Else
Box px, py, MODULE_SIZE, MODULE_SIZE, 0, RGB(White), RGB(White)
EndIf
Next x
Next y
End Sub

' ============================================
' Programm starten
' ============================================
Main
End

Print this page

To reply to this topic, you need to log in.