Imports System.Drawing Public Class DM_Encoder Dim _vFin_Bin, _aFin_Bin(,) As String Dim Wid, _vCW, _vCW_Limit, _vData_Region, _vInterLeving_Blocks, _vData_Region_Side, _aEncoded_Asc(), _vRows, _vCols, _aRep(), _vRow, _vCol, _vChr, _vErrCor, _aMatrix(), _aFactors(), _aErrCor(), _aLog(256), _aALog(256), _aEncoded_Asc_Interleaved(), _aErrCor_Interleaved() As Integer Dim Sqr As Rectangle Dim Code_Pic As New Bitmap(500, 500) Dim X_Dim As Integer = 2 Private Sub Ascii_Mode(ByVal Txt As String) Dim i, a, ex As Integer Dim l As Integer = Txt.Length - 1 'Convert to encoded Ascii While i <= l 'increase _aEncoded_Asc() size by 1 ReDim Preserve _aEncoded_Asc(i) ' Char Mode If Asc(Txt.Chars(a)) < 128 Then ' Dispose Extended Ascii Char Mode (if it is fired) ex = 0 'Check if it is Ascii char or Ascii Digit (Digit Mode) If Asc(Txt.Chars(a)) <= 57 And Asc(Txt.Chars(a)) >= 48 Then 'Check if the digit is the last index of text If Not Txt.Length - 1 = a Then 'Check if the next index is a digit If Asc(Txt.Chars(a + 1)) <= 57 And Asc(Txt.Chars(a + 1)) >= 48 Then 'Data Matrix ECC 200 Algorism for pair of digits (Digit Mode) _aEncoded_Asc(i) = CInt(Txt.Substring(a, 2)) + 130 'Decrease target index by 1 because we have a pair of digits l = l - 1 'Increase text index by 1 to pass pair of digits a = a + 1 Else 'Data Matrix ECC 200 Algorism Chars (Char Mode) _aEncoded_Asc(i) = Asc(Txt.Chars(a)) + 1 End If Else 'Data Matrix ECC 200 Algorism Chars (Char Mode) _aEncoded_Asc(i) = Asc(Txt.Chars(a)) + 1 End If Else 'Data Matrix ECC 200 Algorism Chars (Char Mode) _aEncoded_Asc(i) = Asc(Txt.Chars(a)) + 1 End If 'Extended Ascii Char Mode ElseIf Asc(Txt.Chars(a)) >= 128 Then 'Data Matrix ECC 200 Algorism Chars (Extended Ascii Char Mode) _aEncoded_Asc(i) = 235 ReDim Preserve _aEncoded_Asc(i + 1) _aEncoded_Asc(i + 1) = Asc(Txt.Chars(a)) - 127 'rearrange indexes l = l + 1 i = i + 1 End If a = a + 1 i = i + 1 End While 'Number of Code Words _vCW = _aEncoded_Asc.Length End Sub Private Function DecToBin(ByVal DecimalNum As Long) As String Dim tmp As String Dim n As Long Dim i As Integer n = DecimalNum tmp = Trim(Str(n Mod 2)) n = n \ 2 Do While n <> 0 tmp = Trim(Str(n Mod 2)) + tmp n = n \ 2 Loop If tmp.Length < 8 Then For i = 1 To 8 - tmp.Length tmp = "0" + tmp Next End If DecToBin = tmp End Function Private Sub DM_Capacity() Select Case _vCW Case Is <= 3 _vRows = 8 _vCols = 8 _vErrCor = 5 _vCW_Limit = 3 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 5 _vRows = 10 _vCols = 10 _vErrCor = 7 _vCW_Limit = 5 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 8 _vRows = 12 _vCols = 12 _vErrCor = 10 _vCW_Limit = 8 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 12 _vRows = 14 _vCols = 14 _vErrCor = 12 _vCW_Limit = 12 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 18 _vRows = 16 _vCols = 16 _vErrCor = 14 _vCW_Limit = 18 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 22 _vRows = 18 _vCols = 18 _vErrCor = 18 _vCW_Limit = 22 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 30 _vRows = 20 _vCols = 20 _vErrCor = 20 _vCW_Limit = 30 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 36 _vRows = 22 _vCols = 22 _vErrCor = 24 _vCW_Limit = 36 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 44 _vRows = 24 _vCols = 24 _vErrCor = 28 _vCW_Limit = 44 _vData_Region = 1 _vInterLeving_Blocks = 1 Case Is <= 62 _vRows = 28 _vCols = 28 _vErrCor = 36 _vCW_Limit = 62 _vData_Region = 4 _vInterLeving_Blocks = 1 Case Is <= 86 _vRows = 32 _vCols = 32 _vErrCor = 42 _vCW_Limit = 86 _vData_Region = 4 _vInterLeving_Blocks = 1 Case Is <= 114 _vRows = 36 _vCols = 36 _vErrCor = 48 _vCW_Limit = 114 _vData_Region = 4 _vInterLeving_Blocks = 1 Case Is <= 144 _vRows = 40 _vCols = 40 _vErrCor = 56 _vCW_Limit = 144 _vData_Region = 4 _vInterLeving_Blocks = 1 Case Is <= 174 _vRows = 44 _vCols = 44 _vErrCor = 68 _vCW_Limit = 174 _vData_Region = 4 _vInterLeving_Blocks = 1 Case Is <= 204 _vRows = 48 _vCols = 48 _vErrCor = 84 _vCW_Limit = 204 _vData_Region = 4 _vInterLeving_Blocks = 2 Case Is <= 280 _vRows = 56 _vCols = 56 _vErrCor = 112 _vCW_Limit = 280 _vData_Region = 16 _vInterLeving_Blocks = 2 Case Is <= 368 _vRows = 64 _vCols = 64 _vErrCor = 144 _vCW_Limit = 368 _vData_Region = 16 _vInterLeving_Blocks = 4 Case Is <= 456 _vRows = 72 _vCols = 72 _vErrCor = 192 _vCW_Limit = 456 _vData_Region = 16 _vInterLeving_Blocks = 4 Case Is <= 576 _vRows = 80 _vCols = 80 _vErrCor = 224 _vCW_Limit = 576 _vData_Region = 16 _vInterLeving_Blocks = 4 Case Is <= 696 _vRows = 88 _vCols = 88 _vErrCor = 272 _vCW_Limit = 696 _vData_Region = 16 _vInterLeving_Blocks = 4 Case Is <= 816 _vRows = 96 _vCols = 96 _vErrCor = 336 _vCW_Limit = 816 _vData_Region = 16 _vInterLeving_Blocks = 6 Case Is <= 1050 _vRows = 108 _vCols = 108 _vErrCor = 408 _vCW_Limit = 1050 _vData_Region = 36 _vInterLeving_Blocks = 6 Case Is <= 1304 _vRows = 120 _vCols = 120 _vErrCor = 496 _vCW_Limit = 1304 _vData_Region = 36 _vInterLeving_Blocks = 8 Case Is <= 1558 _vRows = 132 _vCols = 132 _vErrCor = 620 _vCW_Limit = 1558 _vData_Region = 36 _vInterLeving_Blocks = 10 End Select End Sub Private Sub Clip_Area() 'Set Clip_Area Size Sqr.Height = (_vRows * X_Dim) + (4 * X_Dim) + (((_vData_Region ^ 0.5) - 1) * 2 * X_Dim) Sqr.Width = (_vCols * X_Dim) + (4 * X_Dim) + (((_vData_Region ^ 0.5) - 1) * 2 * X_Dim) End Sub Private Overloads Function Draw(ByVal Clr As Color, ByVal Background As Color) Clip_Area() Dim Btmap As New Bitmap(Sqr.Width, Sqr.Height) Dim gr As Graphics = Graphics.FromImage(Btmap) If _vCW > 0 Then gr.Clear(background) 'e.Graphics.FillRectangle(Brushes.White, Sqr) gr.FillRectangle(Brushes.White, 0, 0, Sqr.Width, Sqr.Height) Dim Code_Brush As New SolidBrush(Color.Coral) Dim i, a, b, c, d, f, g, h, j As Integer d = ((CInt(_vData_Region ^ 0.5)) - 1) * 2 'draw perimeter and quite zone Code_Brush.Color = Clr 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim, Sqr.Y + X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) gr.FillRectangle(Code_Brush, X_Dim, X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim, Sqr.Y + (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) gr.FillRectangle(Code_Brush, X_Dim, (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) For i = 1 To (_vCols / 2) + d / 2 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + (3 * X_Dim) + a, Sqr.Y + X_Dim, X_Dim, X_Dim) gr.FillRectangle(Code_Brush, (3 * X_Dim) + a, X_Dim, X_Dim, X_Dim) 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim, Sqr.Y + (2 * X_Dim) + a, X_Dim, X_Dim) gr.FillRectangle(Code_Brush, (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim, (2 * X_Dim) + a, X_Dim, X_Dim) a = a + X_Dim * 2 Next 'draw inside perimeter If _vData_Region_Side > 0 Then Dim ii As Integer Code_Brush.Color = Clr For ii = 1 To d / 2 a = 0 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), Sqr.Y + X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) gr.FillRectangle(Code_Brush, X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim, Sqr.Y + (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim) - (((_vData_Region_Side + 2) * X_Dim) * ii), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) gr.FillRectangle(Code_Brush, X_Dim, (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim) - (((_vData_Region_Side + 2) * X_Dim) * ii), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) For i = 1 To (_vCols / 2) + d / 2 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + (3 * X_Dim) + a, Sqr.Y + X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), X_Dim, X_Dim) gr.FillRectangle(Code_Brush, (3 * X_Dim) + a, X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), X_Dim, X_Dim) 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim - (((_vData_Region_Side + 2) * X_Dim) * ii), Sqr.Y + (2 * X_Dim) + a, X_Dim, X_Dim) gr.FillRectangle(Code_Brush, (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim - (((_vData_Region_Side + 2) * X_Dim) * ii), (2 * X_Dim) + a, X_Dim, X_Dim) a = a + X_Dim * 2 Next Next End If 'Reset Variables a = 0 c = _vCols h = 0 f = _vData_Region_Side j = _vCols * _vData_Region_Side 'Begin Drawing Data Region For i = 0 To _aMatrix.Length - 1 'Define color If _aMatrix(i) = 0 Then Code_Brush.Color = Background ElseIf _aMatrix(i) = 1 Then Code_Brush.Color = Clr End If 'start new row If i = c Then a = 0 b = b + X_Dim c = c + _vCols g = 0 End If If i = f And _vData_Region > 1 Then g = g + 2 * X_Dim If i = c - _vCols Then g = 0 End If f = f + _vData_Region_Side End If If i = j And _vData_Region > 1 Then h = h + 2 * X_Dim j = j + (_vRows * _vData_Region_Side) End If ' Draw a point according to coressponding binary 'e.Graphics.FillRectangle(Code_Brush, Sqr.X + (2 * X_Dim) + a + g, Sqr.Y + (2 * X_Dim) + b + h, X_Dim, X_Dim) gr.FillRectangle(Code_Brush, (2 * X_Dim) + a + g, (2 * X_Dim) + b + h, X_Dim, X_Dim) a = a + X_Dim Next Else Return 0 Exit Function End If 'Ctrl.CreateGraphics.DrawImage(Btmap, x, y) Return Btmap End Function Private Sub Replacement(ByVal row As Integer, ByVal col As Integer, ByVal chr As Integer, ByVal bit As Integer) '"Replacement" places "chr+bit" with appropriate wrapping within _aRep[] If (row < 0) Then row += _vRows col += 4 - ((_vRows + 4) Mod 8) End If If (col < 0) Then col += _vCols row += 4 - ((_vCols + 4) Mod 8) End If _aRep(row * _vCols + col) = 10 * chr + bit 'Assigin Martix for Code Words _aMatrix(row * _vCols + col) = _aFin_Bin(chr - 1, bit - 1) End Sub Private Sub utah(ByVal row As Integer, ByVal col As Integer, ByVal chr As Integer) '"utah" places the 8 bits of a utah-shaped symbol character in ECC200 Replacement(row - 2, col - 2, chr, 1) Replacement(row - 2, col - 1, chr, 2) Replacement(row - 1, col - 2, chr, 3) Replacement(row - 1, col - 1, chr, 4) Replacement(row - 1, col, chr, 5) Replacement(row, col - 2, chr, 6) Replacement(row, col - 1, chr, 7) Replacement(row, col, chr, 8) End Sub ' "cornerN" places 8 bits of the four special corner cases in ECC200 Private Sub corner1(ByVal chr As Integer) Replacement(_vRows - 1, 0, chr, 1) Replacement(_vRows - 1, 1, chr, 2) Replacement(_vRows - 1, 2, chr, 3) Replacement(0, _vCols - 2, chr, 4) Replacement(0, _vCols - 1, chr, 5) Replacement(1, _vCols - 1, chr, 6) Replacement(2, _vCols - 1, chr, 7) Replacement(3, _vCols - 1, chr, 8) End Sub Private Sub corner2(ByVal chr As Integer) Replacement(_vRows - 3, 0, chr, 1) Replacement(_vRows - 2, 0, chr, 2) Replacement(_vRows - 1, 0, chr, 3) Replacement(0, _vCols - 4, chr, 4) Replacement(0, _vCols - 3, chr, 5) Replacement(0, _vCols - 2, chr, 6) Replacement(0, _vCols - 1, chr, 7) Replacement(1, _vCols - 1, chr, 8) End Sub Private Sub corner3(ByVal chr As Integer) Replacement(_vRows - 3, 0, chr, 1) Replacement(_vRows - 2, 0, chr, 2) Replacement(_vRows - 1, 0, chr, 3) Replacement(0, _vCols - 2, chr, 4) Replacement(0, _vCols - 1, chr, 5) Replacement(1, _vCols - 1, chr, 6) Replacement(2, _vCols - 1, chr, 7) Replacement(3, _vCols - 1, chr, 8) End Sub Private Sub corner4(ByVal chr As Integer) Replacement(_vRows - 1, 0, chr, 1) Replacement(_vRows - 1, _vCols - 1, chr, 2) Replacement(0, _vCols - 3, chr, 3) Replacement(0, _vCols - 2, chr, 4) Replacement(0, _vCols - 1, chr, 5) Replacement(1, _vCols - 3, chr, 6) Replacement(1, _vCols - 2, chr, 7) Replacement(1, _vCols - 1, chr, 8) End Sub '"ecc200" fills an Rows x Cols array with appropriate values for ECC200 Private Sub ecc200() 'Determine size due to number of code words 'Starting in the correct location for character #1, bit 8,... _vChr = 1 _vRow = 4 _vCol = 0 ReDim _aRep((_vRows * _vCols) - 1) ReDim _aMatrix((_vRows * _vCols) - 1) 'repeatedly first check for one of the special corner cases,until the entire array is scanned */ Do While ((_vRow < _vRows) Or (_vCol < _vCols)) If ((_vRow = _vRows) And (_vCol = 0)) Then corner1(_vChr) _vChr += 1 End If If (_vRow = _vRows - 2) And (_vCol = 0) And (_vCols Mod 4) Then corner2(_vChr) _vChr += 1 _vRow -= 2 _vCol += 2 End If If (_vRow = _vRows - 2) And (_vCol = 0) And (_vCols Mod 8 = 4) Then corner3(_vChr) _vChr += 1 End If If (_vRow = _vRows + 4) And (_vCol = 2) And Not (_vCols Mod 8) Then corner4(_vChr) _vChr += 1 End If ' sweep upward diagonally, inserting successive characters,... Do While ((_vRow >= 0) And (_vCol < _vCols)) If _vRows = 14 And _vRow = 16 And _vCol = 4 And _vChr = 20 Then _vRow -= 4 _vCol += 4 End If If _vRows = 14 And _vRow = 0 And _vCol = 12 Then Exit Do End If If _vRows = 22 And _vRow = 0 And _vCol = 20 And _vChr = 33 Then _vRow += 3 _vCol += 1 End If If _vRows = 22 And _vRow = 24 And _vCol = 4 And _vChr = 43 Then _vRow -= 4 _vCol += 4 End If If _vRows = 22 And _vRow = 24 And _vCol = 12 And _vChr = 56 Then _vRow -= 4 _vCol += 4 End If If (_vRow < _vRows) And (_vCol >= 0) Then utah(_vRow, _vCol, _vChr) _vChr = _vChr + 1 End If If _vCol >= _vCols - 2 Then Exit Do End If _vRow -= 2 _vCol += 2 Loop _vRow += 3 _vCol += 1 '& then sweep downward diagonally, inserting successive characters,... */ Do While ((_vRow < _vRows) And (_vCol >= 0)) And _vChr <= (_vRows * _vCols) \ 8 If _vRows = 22 And _vRow = 6 And _vCol = 22 And _vChr = 34 Then _vRow -= 1 _vCol -= 3 End If If (_vRow >= 0) And (_vCol < _vCols) Then utah(_vRow, _vCol, _vChr) _vChr = _vChr + 1 End If If _vRow >= _vRows - 2 Then Exit Do End If _vRow += 2 _vCol -= 2 Loop _vRow += 3 _vCol += 1 If _vChr > (_vRows * _vCols) \ 8 Then Exit Do End If Loop 'Lastly, if the lower righthand corner is untouched, fill in fixed pattern If _aRep(_vRows * _vCols - 1) = 0 Then _aRep(_vRows * _vCols - 1) = 1 _aRep(_vRows * _vCols - _vCols - 2) = 1 _aMatrix(_vRows * _vCols - 1) = 1 _aMatrix(_vRows * _vCols - _vCols - 2) = 1 End If End Sub Function DM(ByVal Txt As String, ByVal Clr As Color, ByVal Background As Color) As Bitmap Ascii_Mode(Txt) DM_Capacity() If _vCW_Limit = 0 Then MsgBox("DataMatrix couldn't encode more than 1558 charachters") Return New Bitmap(0, 0) Exit Function End If data_Region() Padding() Interleaving() If _vInterLeving_Blocks > 1 Then Binary(_aEncoded_Asc, _aErrCor_Interleaved) Else ReedSolomon(_aEncoded_Asc) Binary(_aEncoded_Asc, _aErrCor) End If ecc200() Return Draw(Clr, Background) End Function Private Function prod(ByVal x As Integer, ByVal y As Integer) Return _aALog((_aLog(x) + _aLog(y)) Mod 255) End Function ' "ReedSolomon Generates Check codewords Private Sub ReedSolomon(ByVal _aDataCW_Asc() As Integer) Dim i, j, t As Integer ReDim _aFactors(_vErrCor / _vInterLeving_Blocks) ReDim _aErrCor((_vErrCor / _vInterLeving_Blocks) - 1) 'allocate, then generate the log & antilog arrays _aLog(0) = -255 _aALog(0) = 1 For i = 1 To 256 _aALog(i) = _aALog(i - 1) * 2 If _aALog(i) >= 256 Then _aALog(i) = _aALog(i) Xor 301 _aLog(_aALog(i)) = i Next 'allocate, then generate the generator polynomial coefficients (Factors): For i = 1 To _aFactors.Length - 1 _aFactors(i) = 0 Next _aFactors(0) = 1 For i = 1 To _aFactors.Length - 1 _aFactors(i) = _aFactors(i - 1) For j = i - 1 To 1 Step -1 _aFactors(j) = _aFactors(j - 1) Xor prod(_aFactors(j), _aALog(i)) Next _aFactors(0) = prod(_aFactors(0), _aALog(i)) Next 'clear, then generate "nc" checkwords in the array wd[] : 'Clear _aErrCor() Array For i = 0 To _aErrCor.Length - 1 _aErrCor(i) = 0 Next 'generate checkwords For i = 0 To (_vCW_Limit / _vInterLeving_Blocks) - 1 t = (_aDataCW_Asc(i) Xor _aErrCor((_vErrCor / _vInterLeving_Blocks) - 1)) For j = (_vErrCor / _vInterLeving_Blocks) - 1 To 0 Step -1 If t = 0 Then _aErrCor(j) = 0 Else _aErrCor(j) = prod(t, _aFactors(j)) End If If j > 0 Then _aErrCor(j) = _aErrCor(j - 1) Xor _aErrCor(j) Next Next End Sub Private Sub Binary(ByVal Data_CW() As Integer, ByVal Check_CW() As Integer) Dim i, ii, x As Integer Dim tmp As String 'Convert to binary ReDim _aFin_Bin(Data_CW.Length + Check_CW.Length - 1, 7) For i = 0 To Data_CW.Length - 1 tmp = DecToBin(Data_CW(i)) For ii = 0 To 7 _aFin_Bin(i, ii) = tmp.Chars(ii) Next Next For x = Check_CW.Length - 1 To 0 Step -1 tmp = DecToBin(Check_CW(x)) For ii = 0 To 7 _aFin_Bin(i, ii) = tmp.Chars(ii) Next i = i + 1 Next End Sub Private Sub Padding() Dim i, t As Integer If _vCW < _vCW_Limit Then For i = 1 To _vCW_Limit - _vCW ReDim Preserve _aEncoded_Asc(_aEncoded_Asc.Length) If i = 1 Then _aEncoded_Asc(_aEncoded_Asc.Length - 1) = 129 ElseIf i > 1 Then t = 129 + ((149 * (i + _vCW)) Mod 253) + 1 If t <= 254 Then _aEncoded_Asc(_aEncoded_Asc.Length - 1) = t Else _aEncoded_Asc(_aEncoded_Asc.Length - 1) = t - 254 End If End If Next ElseIf _vCW = _vCW_Limit Then Exit Sub End If End Sub Private Sub data_Region() _vData_Region_Side = 0 If _vData_Region > 1 Then _vData_Region_Side = _vRows / (_vData_Region ^ 0.5) Else _vData_Region_Side = 0 End If Wid = (2 * X_Dim) + (2 * X_Dim * (_vData_Region ^ 0.5)) + _vRows * X_Dim End Sub Private Sub Interleaving() If _vInterLeving_Blocks > 1 Then Dim i, ii, iii As Integer ReDim _aErrCor_Interleaved(_vErrCor - 1) For i = 0 To _vInterLeving_Blocks - 1 If _vInterLeving_Blocks = 10 Then If i > 7 Then ReDim _aEncoded_Asc_Interleaved(154) Else ReDim _aEncoded_Asc_Interleaved(155) End If Else ReDim _aEncoded_Asc_Interleaved((_aEncoded_Asc.Length / _vInterLeving_Blocks) - 1) End If iii = i For ii = 0 To _aEncoded_Asc_Interleaved.Length - 1 _aEncoded_Asc_Interleaved(ii) = _aEncoded_Asc(iii) iii = iii + _vInterLeving_Blocks Next ReedSolomon(_aEncoded_Asc_Interleaved) iii = i Array.Reverse(_aErrCor) If _vInterLeving_Blocks <> 10 Then For ii = 0 To (_aErrCor.Length) - 1 If iii < _aErrCor_Interleaved.Length Then _aErrCor_Interleaved(iii) = _aErrCor(ii) End If iii = iii + _vInterLeving_Blocks Next Else For ii = 0 To (_aErrCor.Length) - 1 If iii + 2 < _aErrCor_Interleaved.Length Then _aErrCor_Interleaved(iii + 2) = _aErrCor(ii) End If iii = iii + _vInterLeving_Blocks Next If i = 8 Then iii = 0 For ii = 0 To (_aErrCor.Length) - 1 If iii < _aErrCor_Interleaved.Length Then _aErrCor_Interleaved(iii) = _aErrCor(ii) End If iii = iii + _vInterLeving_Blocks Next End If If i = 9 Then iii = 1 For ii = 0 To (_aErrCor.Length) - 1 If iii < _aErrCor_Interleaved.Length Then _aErrCor_Interleaved(iii) = _aErrCor(ii) End If iii = iii + _vInterLeving_Blocks Next End If End If Next Array.Reverse(_aErrCor_Interleaved) Else Exit Sub End If End Sub 'Private Overloads Function Draw(ByVal x As Integer, ByVal y As Integer, ByVal Ctrl As Control, ByVal Clr As Color, ByVal e As System.Windows.Forms.PaintEventArgs) ' Clip_Area() ' Dim Btmap As New Bitmap(Sqr.Width, Sqr.Height) ' Dim gr As Graphics = Graphics.FromImage(Btmap) ' If _vCW > 0 Then ' 'gr.Clear(Color.White) ' e.Graphics.FillRectangle(Brushes.White, Sqr) ' 'gr.FillRectangle(Brushes.White, 0, 0, Sqr.Width, Sqr.Height) ' Dim Code_Brush As New SolidBrush(Color.Coral) ' Dim i, a, b, c, d, f, g, h, j As Integer ' d = ((CInt(_vData_Region ^ 0.5)) - 1) * 2 ' 'draw perimeter and quite zone ' Code_Brush.Color = Clr ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim, Sqr.Y + X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) ' 'gr.FillRectangle(Code_Brush, X_Dim, X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim, Sqr.Y + (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) ' 'gr.FillRectangle(Code_Brush, X_Dim, (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) ' For i = 1 To (_vCols / 2) + d / 2 ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + (3 * X_Dim) + a, Sqr.Y + X_Dim, X_Dim, X_Dim) ' 'gr.FillRectangle(Code_Brush, (3 * X_Dim) + a, X_Dim, X_Dim, X_Dim) ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim, Sqr.Y + (2 * X_Dim) + a, X_Dim, X_Dim) ' 'gr.FillRectangle(Code_Brush, (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim, (2 * X_Dim) + a, X_Dim, X_Dim) ' a = a + X_Dim * 2 ' Next ' 'draw inside perimeter ' If _vData_Region_Side > 0 Then ' Dim ii As Integer ' Code_Brush.Color = Clr ' For ii = 1 To d / 2 ' a = 0 ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), Sqr.Y + X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) ' 'gr.FillRectangle(Code_Brush, X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), X_Dim, X_Dim, (X_Dim * _vRows) + X_Dim + (d * X_Dim)) ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + X_Dim, Sqr.Y + (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim) - (((_vData_Region_Side + 2) * X_Dim) * ii), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) ' 'gr.FillRectangle(Code_Brush, X_Dim, (d * X_Dim) + (X_Dim * _vRows) + (2 * X_Dim) - (((_vData_Region_Side + 2) * X_Dim) * ii), (X_Dim * _vCols) + 2 * (X_Dim) + (d * X_Dim), X_Dim) ' For i = 1 To (_vCols / 2) + d / 2 ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + (3 * X_Dim) + a, Sqr.Y + X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), X_Dim, X_Dim) ' 'gr.FillRectangle(Code_Brush, (3 * X_Dim) + a, X_Dim + (((_vData_Region_Side + 2) * X_Dim) * ii), X_Dim, X_Dim) ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim - (((_vData_Region_Side + 2) * X_Dim) * ii), Sqr.Y + (2 * X_Dim) + a, X_Dim, X_Dim) ' 'gr.FillRectangle(Code_Brush, (d * X_Dim) + _vCols * X_Dim + 2 * X_Dim - (((_vData_Region_Side + 2) * X_Dim) * ii), (2 * X_Dim) + a, X_Dim, X_Dim) ' a = a + X_Dim * 2 ' Next ' Next ' End If ' 'Reset Variables ' a = 0 ' c = _vCols ' h = 0 ' f = _vData_Region_Side ' j = _vCols * _vData_Region_Side ' 'Begin Drawing Data Region ' For i = 0 To _aMatrix.Length - 1 ' 'Define color ' If _aMatrix(i) = 0 Then ' Code_Brush.Color = Color.White ' ElseIf _aMatrix(i) = 1 Then ' Code_Brush.Color = Clr ' End If ' 'start new row ' If i = c Then ' a = 0 ' b = b + X_Dim ' c = c + _vCols ' g = 0 ' End If ' If i = f And _vData_Region > 1 Then ' g = g + 2 * X_Dim ' If i = c - _vCols Then ' g = 0 ' End If ' f = f + _vData_Region_Side ' End If ' If i = j And _vData_Region > 1 Then ' h = h + 2 * X_Dim ' j = j + (_vRows * _vData_Region_Side) ' End If ' ' Draw a point according to coressponding binary ' e.Graphics.FillRectangle(Code_Brush, Sqr.X + (2 * X_Dim) + a + g, Sqr.Y + (2 * X_Dim) + b + h, X_Dim, X_Dim) ' 'gr.FillRectangle(Code_Brush, (2 * X_Dim) + a + g, (2 * X_Dim) + b + h, X_Dim, X_Dim) ' a = a + X_Dim ' Next ' Else ' Return 0 ' Exit Function ' End If ' Ctrl.CreateGraphics.DrawImage(Btmap, x, y) ' Return 0 'End Function End Class