Member Avatar for _1_14

I make windows form application c# vs 2015 to generate 2d matrix barcodes for pharmaceutical company
manufacture medicine .
my problem when i make order to generate 2d matrix barcode for 200000 barcode and save barcodes in hard disk
take 20 minutes
How to minimize 20 minutes to 8 minutes when generate and saving 200000 barcode ?
my code under button as following

I attached serial and libarary for datamatrix encoding with message

 Class1 CLS = new Class1();
    DataTable dt = CLS.ShowalldataSerial(textBox4.Text);

     string baseText = "UserID" + dt.Rows[0][0] + "FirmName" + dt.Rows[0][1] + "OrderNo" + dt.Rows[0][2] + "BtachNo" + dt.Rows[0][3] + "Quantity" + dt.Rows[0][4] + "ProductName" + dt.Rows[0][5] + "SerialNo";
        Color foregroundColor = Color.FromName(comboBox1.SelectedItem.ToString());

        int serialsToGenerate = Convert.ToInt32(textBox1.Text);
        Parallel.For(0, serialsToGenerate, index=>
        {
            string Serial = SRL.Rnd().ToString();
            string txt = baseText + Serial;

            // WARNING HERE
            DM_Encoder dm = new DM_Encoder();
            dm.DM(txt, foregroundColor, Color.White).Save(root + "\\" + Serial + ".emf", System.Drawing.Imaging.ImageFormat.Emf);
        });
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))
Imports System.Security.Cryptography
Imports System.Text
Public Class SerialCreator
    Function CreateSerial(ByVal CertCode As String)
        Dim _vSrl, ProdCertCode, FirmCertCode, CntryCertCode, BaseChk As String
        Dim Tmp As Integer
        'Divide Cert Code
        CntryCertCode = CertCode.Substring(0, 8)
        FirmCertCode = CertCode.Substring(8, 5)
        ProdCertCode = CertCode.Substring(13, 7)

        'Create Base Check Number
        BaseChk = ChkDigt(CntryCertCode)

        'First part of Serial Number
        _vSrl = Math.Abs(CInt(BaseChk) + CInt(FirmCertCode) - 99999)
        _vSrl = AddZeros(_vSrl)
        'Second part of Serial Number
        Tmp = Math.Abs((CInt(BaseChk) + CInt(ProdCertCode) - 9999999) / 100)
        'Tmp = AddZeros(Tmp)
        _vSrl = _vSrl + AddZeros(Tmp)


        'Third part of Serial Number -- Create Random Number
        _vSrl = "SD" + _vSrl + Rnd()

        Return _vSrl
    End Function


    Function ChkDigt(ByVal Digits As String)
        Dim _vChkNo As String
        Dim _vSum, _vDigit, _vChkSum, i, ii, x As Integer

        'Reset Variables
        _vSum = 0
        _vDigit = 0
        _vChkSum = 0

        For i = 0 To 4
            ' Calculate the Chkdigit here.
            For ii = 1 To Digits.Length
                _vDigit = CInt(Digits.Substring(Digits.Length - ii, 1))
                If ii Mod 2 = 0 Then
                    'Odd
                    _vSum = _vSum + (_vDigit * (3 + x))
                Else
                    'Even
                    _vSum = _vSum + (_vDigit * 1) + x
                End If
                x = Digits.Substring(0, 1)
            Next
            _vChkSum = (10 - (_vSum Mod 10)) Mod 10
            _vChkNo = _vChkNo + _vChkSum.ToString

            'Shift Digits by 1 to left
            Digits = Digits.Substring(1, Digits.Length - 1) + Digits.Substring(0, 1)
        Next


        Return _vChkNo

    End Function

    Function Rnd()
        Dim chars(9) As Char
        Dim a As String
        a = "1234567890"
        chars = a.ToCharArray()
        Dim size As Integer = 9
        Dim data(8) As Byte
        Dim i As Integer
        Dim Randm As String
        For i = 0 To 1
            Dim crypto As New RNGCryptoServiceProvider
            crypto.GetNonZeroBytes(data)
            Dim result As New StringBuilder(size)
            For Each b As Byte In data
                result.Append(chars(b Mod (chars.Length - 1)))
            Next b
            Randm = Randm + ChkSum((result.ToString))
        Next


        Return Randm


    End Function

    Function AddZeros(ByVal Srl As String)
        If Srl.Length = 1 Then
            Srl = "0000" + Srl
        ElseIf Srl.Length = 2 Then
            Srl = "000" + Srl
        ElseIf Srl.Length = 3 Then
            Srl = "00" + Srl
        ElseIf Srl.Length = 4 Then
            Srl = "0" + Srl
        End If
        Return Srl
    End Function


    Function ChkSum(ByVal Digits As String) As String
        Dim ii, _vDigit, _vSum, _vChkSum As Integer

        For ii = 1 To Digits.Length
            _vDigit = CInt(Digits.Substring(Digits.Length - ii, 1))
            If ii Mod 2 = 0 Then
                'Odd
                _vSum = _vSum + (_vDigit * 3)
            Else
                'Even
                _vSum = _vSum + (_vDigit * 1)
            End If
        Next
        _vChkSum = (10 - (_vSum Mod 10)) Mod 10

        Return Digits + CStr(_vChkSum)

    End Function


    Function Verify(ByVal Serial As String) As Boolean
        Dim CntryAbb, FirmID, ProductID, Ser As String
        Dim bol As Boolean
        Dim i, ii, iii, _vCheckSum, _vEven, _vOdd As Integer

        CntryAbb = Serial.Substring(0, 2)
        FirmID = Serial.Substring(2, 5)
        ProductID = Serial.Substring(7, 5)
        Ser = Serial.Substring(12, 20)

        For ii = 0 To 1
            _vCheckSum = 0
            _vEven = 0
            _vOdd = 0
            For i = 9 To 3 Step -2
                _vEven = _vEven + CInt(Val(Ser.Chars((i + iii) - 2))) * 3
                _vOdd = _vOdd + CInt(Val(Ser.Chars((i + iii) - 1)))
            Next
            _vOdd = _vOdd + CInt(Val(Ser.Chars((i + iii) - 1)))
            _vCheckSum = _vOdd + _vEven

            If CInt(Val(Ser.Chars((10 + iii) - 1))) = (10 - (_vCheckSum Mod 10)) Mod 10 Then
                bol = True
            Else
                bol = False
                Exit Function
            End If
            iii = 10
        Next

        Return bol
    End Function

End Class
Edited by happygeek because: moved
  • 4 Contributors
  • 3 Replies
  • 737 Views
  • 16 Hours Discussion Span
  • Latest Post Latest Post by tinstaafl

Recommended Answers

All 3 Replies

Member Avatar for xrjf

Watch out for strings outside the warning label. Replace strings by System.Text.StringBuilder.

Member Avatar for tinstaafl

I think youre first step should be to investigate other similar librairies. Just a quick glance at that one makes me question whether it's the most efficient.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.