منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

[attachment=11592][attachment=11591][attachment=11591]افضل ما توصلت له لنظام الباركود

ولكن كود الطباعة منقوص ال PictureBox يظهر بداخله رقم الباركود و الرمز و اصم الصنف و السعر .
ولكن عند الطباعة يطبع الرمز و الرقم فقط ولا يطبع اسم المنتج و سعر المنتج
نرجوا الافادة فى تعديل امر الطباعة حتى يطبع اسم المنتج و السعر مع الباركود

و يوجد بالمرفقات نموذج للتعديل عليه

مشكور وبارك الله فيك خوي

السلام عليكم اخوانى هل من احد يقوم بالتطوير على الملف

وعليكم السلام و رحمة الله
تم تكبير الصورة من 60 الى 80 لاستيعاب النصوص
تم التعديل على الدالة الرئيسية للرسم في Module1 لرسم اسم الصنف و السعر
تم تعديل بعض الكود في النموذج الرئيسي

كود Module1

PHP كود :

Module Module1
    'دوال رسم الباركود

    Function Code128(ByVal TheText As String, ByVal CodeLetter As String, Optional Price As String = Nothing, Optional ByVal Kind As String = Nothing) As Image
        ' TheText متغير خاص بالنص المراد تشفيره
        ' CodeLetter متغير خاص بالفئة المراد استخدامها

        Dim Binaryz As String = "" 'متغير سيحمل النص بعد تحويله إلى باينرى
        Dim I As Integer
        Dim NumCode As Integer 'متغير سيحمل  قيمة حساب النص التكميلى
        If CodeLetter = "A" Or CodeLetter = "a" Then
            NumCode = 103
            Binaryz = "00101111011"
        End If
        If CodeLetter = "B" Or CodeLetter = "b" Then
            NumCode = 104
            Binaryz = "00101101111"
        End If
        If CodeLetter = "C" Or CodeLetter = "c" Then
            NumCode = 105
            Binaryz = "00101100011"
        End If
        ' الكود التالى سيقوم باسناد قيمة الحرف بالباينرى حسب الجدول الخاص بالكود 128
        For I = 1 To Len(TheText)
            NumCode = NumCode + ((Asc(Mid(TheText, I, 1)) - 32) * I)
            Select Case Asc(Mid(TheText, I, 1))
                Case 32
                    Binaryz = Binaryz & "00100110011"
                Case 33
                    Binaryz = Binaryz & "00110010011"
                Case 34
                    Binaryz = Binaryz & "00110011001"
                Case 35
                    Binaryz = Binaryz & "01101100111"
                Case 36
                    Binaryz = Binaryz & "01101110011"
                Case 37
                    Binaryz = Binaryz & "01110110011"
                Case 38
                    Binaryz = Binaryz & "01100110111"
                Case 39
                    Binaryz = Binaryz & "01100111011"
                Case 40
                    Binaryz = Binaryz & "01110011011"
                Case 41
                    Binaryz = Binaryz & "00110110111"
                Case 42
                    Binaryz = Binaryz & "00110111011"
                Case 43
                    Binaryz = Binaryz & "00111011011"
                Case 44
                    Binaryz = Binaryz & "01001100011"
                Case 45
                    Binaryz = Binaryz & "01100100011"
                Case 46
                    Binaryz = Binaryz & "01100110001"
                Case 47
                    Binaryz = Binaryz & "01000110011"
                Case 48
                    Binaryz = Binaryz & "01100010011"
                Case 49
                    Binaryz = Binaryz & "01100011001"
                Case 50
                    Binaryz = Binaryz & "00110001101"
                Case 51
                    Binaryz = Binaryz & "00110100011"
                Case 52
                    Binaryz = Binaryz & "00110110001"
                Case 53
                    Binaryz = Binaryz & "00100011011"
                Case 54
                    Binaryz = Binaryz & "00110001011"
                Case 55
                    Binaryz = Binaryz & "00010010001"
                Case 56
                    Binaryz = Binaryz & "00010110011"
                Case 57
                    Binaryz = Binaryz & "00011010011"
                Case 58
                    Binaryz = Binaryz & "00011011001"
                Case 59
                    Binaryz = Binaryz & "00010011011"
                Case 60
                    Binaryz = Binaryz & "00011001011"
                Case 61
                    Binaryz = Binaryz & "00011001101"
                Case 62
                    Binaryz = Binaryz & "00100100111"
                Case 63
                    Binaryz = Binaryz & "00100111001"
                Case 64
                    Binaryz = Binaryz & "00111001001"
                Case 65
                    Binaryz = Binaryz & "01011100111"
                Case 66
                    Binaryz = Binaryz & "01110100111"
                Case 67
                    Binaryz = Binaryz & "01110111001"
                Case 68
                    Binaryz = Binaryz & "01001110111"
                Case 69
                    Binaryz = Binaryz & "01110010111"
                Case 70
                    Binaryz = Binaryz & "01110011101"
                Case 71
                    Binaryz = Binaryz & "00101110111"
                Case 72
                    Binaryz = Binaryz & "00111010111"
                Case 73
                    Binaryz = Binaryz & "00111011101"
                Case 74
                    Binaryz = Binaryz & "01001000111"
                Case 75
                    Binaryz = Binaryz & "01001110001"
                Case 76
                    Binaryz = Binaryz & "01110010001"
                Case 77
                    Binaryz = Binaryz & "01000100111"
                Case 78
                    Binaryz = Binaryz & "01000111001"
                Case 79
                    Binaryz = Binaryz & "01110001001"
                Case 80
                    Binaryz = Binaryz & "00010001001"
                Case 81
                    Binaryz = Binaryz & "00101110001"
                Case 82
                    Binaryz = Binaryz & "00111010001"
                Case 83
                    Binaryz = Binaryz & "00100010111"
                Case 84
                    Binaryz = Binaryz & "00100011101"
                Case 85
                    Binaryz = Binaryz & "00100010001"
                Case 86
                    Binaryz = Binaryz & "00010100111"
                Case 87
                    Binaryz = Binaryz & "00010111001"
                Case 88
                    Binaryz = Binaryz & "00011101001"
                Case 89
                    Binaryz = Binaryz & "00010010111"
                Case 90
                    Binaryz = Binaryz & "00010011101"
                Case 91
                    Binaryz = Binaryz & "00011100101"
                Case 92
                    Binaryz = Binaryz & "00010000101"
                Case 93
                    Binaryz = Binaryz & "00110111101"
                Case 94
                    Binaryz = Binaryz & "00001110101"
                Case 95
                    Binaryz = Binaryz & "01011001111"
                Case 96
                    Binaryz = Binaryz & "01011110011"
                Case 97
                    Binaryz = Binaryz & "01101001111"
                Case 98
                    Binaryz = Binaryz & "01101111001"
                Case 99
                    Binaryz = Binaryz & "01111010011"
                Case 100
                    Binaryz = Binaryz & "01111011001"
                Case 101
                    Binaryz = Binaryz & "01001101111"
                Case 102
                    Binaryz = Binaryz & "01001111011"
                Case 103
                    Binaryz = Binaryz & "01100101111"
                Case 104
                    Binaryz = Binaryz & "01100111101"
                Case 105
                    Binaryz = Binaryz & "01111001011"
                Case 106
                    Binaryz = Binaryz & "01111001101"
                Case 107
                    Binaryz = Binaryz & "00111101101"
                Case 108
                    Binaryz = Binaryz & "00110101111"
                Case 109
                    Binaryz = Binaryz & "00001000101"
                Case 110
                    Binaryz = Binaryz & "00111101011"
                Case 111
                    Binaryz = Binaryz & "01110000101"
                Case 112
                    Binaryz = Binaryz & "01011000011"
                Case 113
                    Binaryz = Binaryz & "01101000011"
                Case 114
                    Binaryz = Binaryz & "01101100001"
                Case 115
                    Binaryz = Binaryz & "01000011011"
                Case 116
                    Binaryz = Binaryz & "01100001011"
                Case 117
                    Binaryz = Binaryz & "01100001101"
                Case 118
                    Binaryz = Binaryz & "00001011011"
                Case 119
                    Binaryz = Binaryz & "00001101011"
                Case 120
                    Binaryz = Binaryz & "00001101101"
                Case 121
                    Binaryz = Binaryz & "00100100001"
                Case 122
                    Binaryz = Binaryz & "00100001001"
                Case 123
                    Binaryz = Binaryz & "00001001001"
                Case 124
                    Binaryz = Binaryz & "01010000111"
                Case 125
                    Binaryz = Binaryz & "01011100001"
                Case 126
                    Binaryz = Binaryz & "01110100001"
                Case 127
                    Binaryz = Binaryz & "01000010111"
                Case 128
                    Binaryz = Binaryz & "01000011101"
                Case 129
                    Binaryz = Binaryz & "00001010111"
                Case 130
                    Binaryz = Binaryz & "00001011101"
                Case 131
                    Binaryz = Binaryz & "01000100001"
                Case 132
                    Binaryz = Binaryz & "01000010001"
                Case 133
                    Binaryz = Binaryz & "00010100001"
                Case 134
                    Binaryz = Binaryz & "00001010001"
                Case 135
                    Binaryz = Binaryz & "00101111011"
                Case 136
                    Binaryz = Binaryz & "00101101111"
                Case 137
                    Binaryz = Binaryz & "00101100011"
                Case 138
                    Binaryz = Binaryz & "0011100010100"
            End Select
        Next
        NumCode = NumCode Mod 103
        ' الكود التالى لمعرفة الحرف المراد اضافتة لاستكمال النص
        Select Case NumCode
            Case 0
                Binaryz = Binaryz & "00100110011"
            Case 1
                Binaryz = Binaryz & "00110010011"
            Case 2
                Binaryz = Binaryz & "00110011001"
            Case 3
                Binaryz = Binaryz & "01101100111"
            Case 4
                Binaryz = Binaryz & "01101110011"
            Case 5
                Binaryz = Binaryz & "01110110011"
            Case 6
                Binaryz = Binaryz & "01100110111"
            Case 7
                Binaryz = Binaryz & "01100111011"
            Case 8
                Binaryz = Binaryz & "01110011011"
            Case 9
                Binaryz = Binaryz & "00110110111"
            Case 10
                Binaryz = Binaryz & "00110111011"
            Case 11
                Binaryz = Binaryz & "00111011011"
            Case 12
                Binaryz = Binaryz & "01001100011"
            Case 13
                Binaryz = Binaryz & "01100100011"
            Case 14
                Binaryz = Binaryz & "01100110001"
            Case 15
                Binaryz = Binaryz & "01000110011"
            Case 16
                Binaryz = Binaryz & "01100010011"
            Case 17
                Binaryz = Binaryz & "01100011001"
            Case 18
                Binaryz = Binaryz & "00110001101"
            Case 19
                Binaryz = Binaryz & "00110100011"
            Case 20
                Binaryz = Binaryz & "00110110001"
            Case 21
                Binaryz = Binaryz & "00100011011"
            Case 22
                Binaryz = Binaryz & "00110001011"
            Case 23
                Binaryz = Binaryz & "00010010001"
            Case 24
                Binaryz = Binaryz & "00010110011"
            Case 25
                Binaryz = Binaryz & "00011010011"
            Case 26
                Binaryz = Binaryz & "00011011001"
            Case 27
                Binaryz = Binaryz & "00010011011"
            Case 28
                Binaryz = Binaryz & "00011001011"
            Case 29
                Binaryz = Binaryz & "00011001101"
            Case 30
                Binaryz = Binaryz & "00100100111"
            Case 31
                Binaryz = Binaryz & "00100111001"
            Case 32
                Binaryz = Binaryz & "00111001001"
            Case 33
                Binaryz = Binaryz & "01011100111"
            Case 34
                Binaryz = Binaryz & "01110100111"
            Case 35
                Binaryz = Binaryz & "01110111001"
            Case 36
                Binaryz = Binaryz & "01001110111"
            Case 37
                Binaryz = Binaryz & "01110010111"
            Case 38
                Binaryz = Binaryz & "01110011101"
            Case 39
                Binaryz = Binaryz & "00101110111"
            Case 40
                Binaryz = Binaryz & "00111010111"
            Case 41
                Binaryz = Binaryz & "00111011101"
            Case 42
                Binaryz = Binaryz & "01001000111"
            Case 43
                Binaryz = Binaryz & "01001110001"
            Case 44
                Binaryz = Binaryz & "01110010001"
            Case 45
                Binaryz = Binaryz & "01000100111"
            Case 46
                Binaryz = Binaryz & "01000111001"
            Case 47
                Binaryz = Binaryz & "01110001001"
            Case 48
                Binaryz = Binaryz & "00010001001"
            Case 49
                Binaryz = Binaryz & "00101110001"
            Case 50
                Binaryz = Binaryz & "00111010001"
            Case 51
                Binaryz = Binaryz & "00100010111"
            Case 52
                Binaryz = Binaryz & "00100011101"
            Case 53
                Binaryz = Binaryz & "00100010001"
            Case 54
                Binaryz = Binaryz & "00010100111"
            Case 55
                Binaryz = Binaryz & "00010111001"
            Case 56
                Binaryz = Binaryz & "00011101001"
            Case 57
                Binaryz = Binaryz & "00010010111"
            Case 58
                Binaryz = Binaryz & "00010011101"
            Case 59
                Binaryz = Binaryz & "00011100101"
            Case 60
                Binaryz = Binaryz & "00010000101"
            Case 61
                Binaryz = Binaryz & "00110111101"
            Case 62
                Binaryz = Binaryz & "00001110101"
            Case 63
                Binaryz = Binaryz & "01011001111"
            Case 64
                Binaryz = Binaryz & "01011110011"
            Case 65
                Binaryz = Binaryz & "01101001111"
            Case 66
                Binaryz = Binaryz & "01101111001"
            Case 67
                Binaryz = Binaryz & "01111010011"
            Case 68
                Binaryz = Binaryz & "01111011001"
            Case 69
                Binaryz = Binaryz & "01001101111"
            Case 70
                Binaryz = Binaryz & "01001111011"
            Case 71
                Binaryz = Binaryz & "01100101111"
            Case 72
                Binaryz = Binaryz & "01100111101"
            Case 73
                Binaryz = Binaryz & "01111001011"
            Case 74
                Binaryz = Binaryz & "01111001101"
            Case 75
                Binaryz = Binaryz & "00111101101"
            Case 76
                Binaryz = Binaryz & "00110101111"
            Case 77
                Binaryz = Binaryz & "00001000101"
            Case 78
                Binaryz = Binaryz & "00111101011"
            Case 79
                Binaryz = Binaryz & "01110000101"
            Case 80
                Binaryz = Binaryz & "01011000011"
            Case 81
                Binaryz = Binaryz & "01101000011"
            Case 82
                Binaryz = Binaryz & "01101100001"
            Case 83
                Binaryz = Binaryz & "01000011011"
            Case 84
                Binaryz = Binaryz & "01100001011"
            Case 85
                Binaryz = Binaryz & "01100001101"
            Case 86
                Binaryz = Binaryz & "00001011011"
            Case 87
                Binaryz = Binaryz & "00001101011"
            Case 88
                Binaryz = Binaryz & "00001101101"
            Case 89
                Binaryz = Binaryz & "00100100001"
            Case 90
                Binaryz = Binaryz & "00100001001"
            Case 91
                Binaryz = Binaryz & "00001001001"
            Case 92
                Binaryz = Binaryz & "01010000111"
            Case 93
                Binaryz = Binaryz & "01011100001"
            Case 94
                Binaryz = Binaryz & "01110100001"
            Case 95
                Binaryz = Binaryz & "01000010111"
            Case 96
                Binaryz = Binaryz & "01000011101"
            Case 97
                Binaryz = Binaryz & "00001010111"
            Case 98
                Binaryz = Binaryz & "00001011101"
            Case 99
                Binaryz = Binaryz & "01000100001"
            Case 100
                Binaryz = Binaryz & "01000010001"
            Case 101
                Binaryz = Binaryz & "00010100001"
            Case 102
                Binaryz = Binaryz & "00001010001"
        End Select
        Binaryz = Binaryz & "0011100010100" ' انهاء الكود باضافة الباينرى الخاص بايقاف جميع الاكواد

        ' انشاء صورة عرضها عدد حروف الباينرى المستخدم
        Dim bmp As Bitmap = New Bitmap(Len(Binaryz), 80, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
        Dim z As String ' متغير لمعرفة لون الخط 
        Dim GraphZ As Graphics = Graphics.FromImage(bmp)
        Dim RectZ As Rectangle = New Rectangle(0, 0, bmp.Width, bmp.Height) ' مستطيل بحجم الصورة لاعطاء الخلفية باللون الابيض
        ' فرشاه لدهان المستطيل السابق باللون الابيض
        Dim myBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(RectZ, Color.White, Color.White, Drawing.Drawing2D.LinearGradientMode.ForwardDiagonal)
        ' دهان المستطيل السابق باللون الابيض
        GraphZ.FillRectangle(myBrush, RectZ)
        '  رسم خطوط الباركود
        Dim PenZ As Pen
        Dim point1 As Point ' نقطة بداية الخط
        Dim point2 As Point ' نقطة نهاية الخط
        For I = 1 To Len(Binaryz)
            z = Mid(Binaryz, I, 1)
            If z = "0" Then
                PenZ = New Pen(Color.Black, 1)
                point1 = New Point(I, 20)
                point2 = New Point(I, 40)
                GraphZ.DrawLine(PenZ, point1, point2)
            Else
                PenZ = New Pen(Color.White, 1)
                point1 = New Point(I, 0)
                point2 = New Point(I, 0)
                GraphZ.DrawLine(PenZ, point1, point2)
            End If
        Next
        ' رسم النص المراد ترميزه اسفل الكود
        GraphZ.DrawString(TheText, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 40)
        Dim format1 As New StringFormat(StringFormatFlags.NoClip)
        format1.Alignment = StringAlignment.Center
        GraphZ.DrawString(Kind, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 55)
        GraphZ.DrawString(Price, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 0)
        Code128 = bmp
    End Function
    Function Toc(ByVal Text2CStr As String) As String
        ' دالة لتعويض النص المطلوب تشفيره بالارقام للفئة 
        ' (C)
        Dim X As Integer = 1
        Dim NewText As String = ""
        Dim Z As String = ""
        Do
            Z = Mid(Text2CStr, X, 2)
            ' اضافة رقم32 لقيمة الاسكى واستعادة الحرف الناتج بعد الاضافة
            NewText = NewText & Chr(Val(Z) + 32)
            X += 2
            Z = Mid(Text2CStr, X, 1)
            If X >= Len(Text2CStr) Then Exit Do
            If Z = "" Then Exit Do
        Loop
        Toc = NewText
    End Function
End Module 

كود النموذج

PHP كود :

Public Class Form1
    Dim PrintDoc As Printing.PrintDocument = New Printing.PrintDocument()
    Dim pd_PrintDialog As New PrintDialog
    ' Dim MyImage As System.Drawing.Image = PicBarCode.BackgroundImage

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        ActiveControl = TextBox3
    End Sub

    ' تم ايقاف هذا الاجراء و لم يعد يستخدم و ترك مؤقتا 
    Public Sub PrintBarCodeV()

        pd_PrintDialog.UseEXDialog = True
        pd_PrintDialog.AllowPrintToFile = False

        'تحديد عدد النسخ المراد طباعتها
        pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value

        'عرض صندوق حوار اختيار الطابعة
        If pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.OK Then
            PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings
            AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler

        End If

    End Sub

    Private Sub TextBox3_TextChanged(sender As Object, e As EventArgs) Handles TextBox3.TextChanged
        PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text)
    End Sub

    'This is the event handler for printing bar codes
    Private Sub PrintDocHandler(ByVal sender As Object, ByVal ev As Printing.PrintPageEventArgs)
        ev.Graphics.DrawImage(PicBarCode.BackgroundImage, nud_MarginH.Value, nud_MarginW.Value, nud_MarginWBrcode.Value, nud_MarginHBrcode.Value)

    End Sub

    Private Sub butPageSetup_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butPageSetup.Click

        'اعداد الصفحة

        PageSetupDialog1.Document = PrintDoc
        PageSetupDialog1.ShowDialog()
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        'معاينة قبل الطباعة

        AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler

        'تحديد عدد النسخ المراد طباعتها
        pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value

        PrintPreviewDialog1.Document = PrintDoc
        PrintPreviewDialog1.ShowDialog()

    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        Close()
    End Sub

    Private Sub طباعة_الباركود_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Try

            'كتابة اسم المنتج على ملصق الباركود
            'Dim a As Graphics = PicBarCode.CreateGraphics
            'a.DrawString(TextBox2.Text, Me.Font, Brushes.Black, 100, 5)

            'ActiveControl = TextBox3

        Catch ex As Exception

        End Try
    End Sub

    Private Sub Button11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        PrintBarCodeV()
    End Sub

    Private Sub Button11_Click_2(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button11.Click

        'طباعة الباركود
        If TextBox3.Text = "" Then 'الباركود فارغ 
            MsgBox("من فضلك تأكد من كتابة النص المراد تحويله الى باركود", MsgBoxStyle.DefaultButton1, "ogy soft")
            Exit Sub

        Else

            pd_PrintDialog.UseEXDialog = True
            pd_PrintDialog.AllowPrintToFile = False
            'تحديد عدد النسخ المراد طباعتها.
            pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value
            If pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.OK Then

                PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings

                AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler
                'امر الطباعة
                PrintDoc.Print()

            ElseIf pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then
                Exit Sub

            End If
        End If
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick

        'كتابة اسم المنتج على ملصق الباركود
        PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text)

    End Sub

    Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick

        'كتابة سعر  المنتج على ملصق الباركود
        PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text)
    End Sub

End Class

بالتوفيق اخي

(16-09-16, 08:13 PM)ابو ليلى كتب : [ -> ]وعليكم السلام و رحمة الله
تم تكبير الصورة من 60 الى 80 لاستيعاب النصوص
تم التعديل على الدالة الرئيسية للرسم في Module1 لرسم اسم الصنف و السعر
تم تعديل بعض الكود في النموذج الرئيسي

كود Module1

PHP كود :

Module Module1 'دوال رسم الباركود Function Code128(ByVal TheText As String, ByVal CodeLetter As String, Optional Price As String = Nothing, Optional ByVal Kind As String = Nothing) As Image ' TheText متغير خاص بالنص المراد تشفيره ' CodeLetter متغير خاص بالفئة المراد استخدامها Dim Binaryz As String = "" 'متغير سيحمل النص بعد تحويله إلى باينرى Dim I As Integer Dim NumCode As Integer 'متغير سيحمل قيمة حساب النص التكميلى If CodeLetter = "A" Or CodeLetter = "a" Then NumCode = 103 Binaryz = "00101111011" End If If CodeLetter = "B" Or CodeLetter = "b" Then NumCode = 104 Binaryz = "00101101111" End If If CodeLetter = "C" Or CodeLetter = "c" Then NumCode = 105 Binaryz = "00101100011" End If ' الكود التالى سيقوم باسناد قيمة الحرف بالباينرى حسب الجدول الخاص بالكود 128 For I = 1 To Len(TheText) NumCode = NumCode + ((Asc(Mid(TheText, I, 1)) - 32) * I) Select Case Asc(Mid(TheText, I, 1)) Case 32 Binaryz = Binaryz & "00100110011" Case 33 Binaryz = Binaryz & "00110010011" Case 34 Binaryz = Binaryz & "00110011001" Case 35 Binaryz = Binaryz & "01101100111" Case 36 Binaryz = Binaryz & "01101110011" Case 37 Binaryz = Binaryz & "01110110011" Case 38 Binaryz = Binaryz & "01100110111" Case 39 Binaryz = Binaryz & "01100111011" Case 40 Binaryz = Binaryz & "01110011011" Case 41 Binaryz = Binaryz & "00110110111" Case 42 Binaryz = Binaryz & "00110111011" Case 43 Binaryz = Binaryz & "00111011011" Case 44 Binaryz = Binaryz & "01001100011" Case 45 Binaryz = Binaryz & "01100100011" Case 46 Binaryz = Binaryz & "01100110001" Case 47 Binaryz = Binaryz & "01000110011" Case 48 Binaryz = Binaryz & "01100010011" Case 49 Binaryz = Binaryz & "01100011001" Case 50 Binaryz = Binaryz & "00110001101" Case 51 Binaryz = Binaryz & "00110100011" Case 52 Binaryz = Binaryz & "00110110001" Case 53 Binaryz = Binaryz & "00100011011" Case 54 Binaryz = Binaryz & "00110001011" Case 55 Binaryz = Binaryz & "00010010001" Case 56 Binaryz = Binaryz & "00010110011" Case 57 Binaryz = Binaryz & "00011010011" Case 58 Binaryz = Binaryz & "00011011001" Case 59 Binaryz = Binaryz & "00010011011" Case 60 Binaryz = Binaryz & "00011001011" Case 61 Binaryz = Binaryz & "00011001101" Case 62 Binaryz = Binaryz & "00100100111" Case 63 Binaryz = Binaryz & "00100111001" Case 64 Binaryz = Binaryz & "00111001001" Case 65 Binaryz = Binaryz & "01011100111" Case 66 Binaryz = Binaryz & "01110100111" Case 67 Binaryz = Binaryz & "01110111001" Case 68 Binaryz = Binaryz & "01001110111" Case 69 Binaryz = Binaryz & "01110010111" Case 70 Binaryz = Binaryz & "01110011101" Case 71 Binaryz = Binaryz & "00101110111" Case 72 Binaryz = Binaryz & "00111010111" Case 73 Binaryz = Binaryz & "00111011101" Case 74 Binaryz = Binaryz & "01001000111" Case 75 Binaryz = Binaryz & "01001110001" Case 76 Binaryz = Binaryz & "01110010001" Case 77 Binaryz = Binaryz & "01000100111" Case 78 Binaryz = Binaryz & "01000111001" Case 79 Binaryz = Binaryz & "01110001001" Case 80 Binaryz = Binaryz & "00010001001" Case 81 Binaryz = Binaryz & "00101110001" Case 82 Binaryz = Binaryz & "00111010001" Case 83 Binaryz = Binaryz & "00100010111" Case 84 Binaryz = Binaryz & "00100011101" Case 85 Binaryz = Binaryz & "00100010001" Case 86 Binaryz = Binaryz & "00010100111" Case 87 Binaryz = Binaryz & "00010111001" Case 88 Binaryz = Binaryz & "00011101001" Case 89 Binaryz = Binaryz & "00010010111" Case 90 Binaryz = Binaryz & "00010011101" Case 91 Binaryz = Binaryz & "00011100101" Case 92 Binaryz = Binaryz & "00010000101" Case 93 Binaryz = Binaryz & "00110111101" Case 94 Binaryz = Binaryz & "00001110101" Case 95 Binaryz = Binaryz & "01011001111" Case 96 Binaryz = Binaryz & "01011110011" Case 97 Binaryz = Binaryz & "01101001111" Case 98 Binaryz = Binaryz & "01101111001" Case 99 Binaryz = Binaryz & "01111010011" Case 100 Binaryz = Binaryz & "01111011001" Case 101 Binaryz = Binaryz & "01001101111" Case 102 Binaryz = Binaryz & "01001111011" Case 103 Binaryz = Binaryz & "01100101111" Case 104 Binaryz = Binaryz & "01100111101" Case 105 Binaryz = Binaryz & "01111001011" Case 106 Binaryz = Binaryz & "01111001101" Case 107 Binaryz = Binaryz & "00111101101" Case 108 Binaryz = Binaryz & "00110101111" Case 109 Binaryz = Binaryz & "00001000101" Case 110 Binaryz = Binaryz & "00111101011" Case 111 Binaryz = Binaryz & "01110000101" Case 112 Binaryz = Binaryz & "01011000011" Case 113 Binaryz = Binaryz & "01101000011" Case 114 Binaryz = Binaryz & "01101100001" Case 115 Binaryz = Binaryz & "01000011011" Case 116 Binaryz = Binaryz & "01100001011" Case 117 Binaryz = Binaryz & "01100001101" Case 118 Binaryz = Binaryz & "00001011011" Case 119 Binaryz = Binaryz & "00001101011" Case 120 Binaryz = Binaryz & "00001101101" Case 121 Binaryz = Binaryz & "00100100001" Case 122 Binaryz = Binaryz & "00100001001" Case 123 Binaryz = Binaryz & "00001001001" Case 124 Binaryz = Binaryz & "01010000111" Case 125 Binaryz = Binaryz & "01011100001" Case 126 Binaryz = Binaryz & "01110100001" Case 127 Binaryz = Binaryz & "01000010111" Case 128 Binaryz = Binaryz & "01000011101" Case 129 Binaryz = Binaryz & "00001010111" Case 130 Binaryz = Binaryz & "00001011101" Case 131 Binaryz = Binaryz & "01000100001" Case 132 Binaryz = Binaryz & "01000010001" Case 133 Binaryz = Binaryz & "00010100001" Case 134 Binaryz = Binaryz & "00001010001" Case 135 Binaryz = Binaryz & "00101111011" Case 136 Binaryz = Binaryz & "00101101111" Case 137 Binaryz = Binaryz & "00101100011" Case 138 Binaryz = Binaryz & "0011100010100" End Select Next NumCode = NumCode Mod 103 ' الكود التالى لمعرفة الحرف المراد اضافتة لاستكمال النص Select Case NumCode Case 0 Binaryz = Binaryz & "00100110011" Case 1 Binaryz = Binaryz & "00110010011" Case 2 Binaryz = Binaryz & "00110011001" Case 3 Binaryz = Binaryz & "01101100111" Case 4 Binaryz = Binaryz & "01101110011" Case 5 Binaryz = Binaryz & "01110110011" Case 6 Binaryz = Binaryz & "01100110111" Case 7 Binaryz = Binaryz & "01100111011" Case 8 Binaryz = Binaryz & "01110011011" Case 9 Binaryz = Binaryz & "00110110111" Case 10 Binaryz = Binaryz & "00110111011" Case 11 Binaryz = Binaryz & "00111011011" Case 12 Binaryz = Binaryz & "01001100011" Case 13 Binaryz = Binaryz & "01100100011" Case 14 Binaryz = Binaryz & "01100110001" Case 15 Binaryz = Binaryz & "01000110011" Case 16 Binaryz = Binaryz & "01100010011" Case 17 Binaryz = Binaryz & "01100011001" Case 18 Binaryz = Binaryz & "00110001101" Case 19 Binaryz = Binaryz & "00110100011" Case 20 Binaryz = Binaryz & "00110110001" Case 21 Binaryz = Binaryz & "00100011011" Case 22 Binaryz = Binaryz & "00110001011" Case 23 Binaryz = Binaryz & "00010010001" Case 24 Binaryz = Binaryz & "00010110011" Case 25 Binaryz = Binaryz & "00011010011" Case 26 Binaryz = Binaryz & "00011011001" Case 27 Binaryz = Binaryz & "00010011011" Case 28 Binaryz = Binaryz & "00011001011" Case 29 Binaryz = Binaryz & "00011001101" Case 30 Binaryz = Binaryz & "00100100111" Case 31 Binaryz = Binaryz & "00100111001" Case 32 Binaryz = Binaryz & "00111001001" Case 33 Binaryz = Binaryz & "01011100111" Case 34 Binaryz = Binaryz & "01110100111" Case 35 Binaryz = Binaryz & "01110111001" Case 36 Binaryz = Binaryz & "01001110111" Case 37 Binaryz = Binaryz & "01110010111" Case 38 Binaryz = Binaryz & "01110011101" Case 39 Binaryz = Binaryz & "00101110111" Case 40 Binaryz = Binaryz & "00111010111" Case 41 Binaryz = Binaryz & "00111011101" Case 42 Binaryz = Binaryz & "01001000111" Case 43 Binaryz = Binaryz & "01001110001" Case 44 Binaryz = Binaryz & "01110010001" Case 45 Binaryz = Binaryz & "01000100111" Case 46 Binaryz = Binaryz & "01000111001" Case 47 Binaryz = Binaryz & "01110001001" Case 48 Binaryz = Binaryz & "00010001001" Case 49 Binaryz = Binaryz & "00101110001" Case 50 Binaryz = Binaryz & "00111010001" Case 51 Binaryz = Binaryz & "00100010111" Case 52 Binaryz = Binaryz & "00100011101" Case 53 Binaryz = Binaryz & "00100010001" Case 54 Binaryz = Binaryz & "00010100111" Case 55 Binaryz = Binaryz & "00010111001" Case 56 Binaryz = Binaryz & "00011101001" Case 57 Binaryz = Binaryz & "00010010111" Case 58 Binaryz = Binaryz & "00010011101" Case 59 Binaryz = Binaryz & "00011100101" Case 60 Binaryz = Binaryz & "00010000101" Case 61 Binaryz = Binaryz & "00110111101" Case 62 Binaryz = Binaryz & "00001110101" Case 63 Binaryz = Binaryz & "01011001111" Case 64 Binaryz = Binaryz & "01011110011" Case 65 Binaryz = Binaryz & "01101001111" Case 66 Binaryz = Binaryz & "01101111001" Case 67 Binaryz = Binaryz & "01111010011" Case 68 Binaryz = Binaryz & "01111011001" Case 69 Binaryz = Binaryz & "01001101111" Case 70 Binaryz = Binaryz & "01001111011" Case 71 Binaryz = Binaryz & "01100101111" Case 72 Binaryz = Binaryz & "01100111101" Case 73 Binaryz = Binaryz & "01111001011" Case 74 Binaryz = Binaryz & "01111001101" Case 75 Binaryz = Binaryz & "00111101101" Case 76 Binaryz = Binaryz & "00110101111" Case 77 Binaryz = Binaryz & "00001000101" Case 78 Binaryz = Binaryz & "00111101011" Case 79 Binaryz = Binaryz & "01110000101" Case 80 Binaryz = Binaryz & "01011000011" Case 81 Binaryz = Binaryz & "01101000011" Case 82 Binaryz = Binaryz & "01101100001" Case 83 Binaryz = Binaryz & "01000011011" Case 84 Binaryz = Binaryz & "01100001011" Case 85 Binaryz = Binaryz & "01100001101" Case 86 Binaryz = Binaryz & "00001011011" Case 87 Binaryz = Binaryz & "00001101011" Case 88 Binaryz = Binaryz & "00001101101" Case 89 Binaryz = Binaryz & "00100100001" Case 90 Binaryz = Binaryz & "00100001001" Case 91 Binaryz = Binaryz & "00001001001" Case 92 Binaryz = Binaryz & "01010000111" Case 93 Binaryz = Binaryz & "01011100001" Case 94 Binaryz = Binaryz & "01110100001" Case 95 Binaryz = Binaryz & "01000010111" Case 96 Binaryz = Binaryz & "01000011101" Case 97 Binaryz = Binaryz & "00001010111" Case 98 Binaryz = Binaryz & "00001011101" Case 99 Binaryz = Binaryz & "01000100001" Case 100 Binaryz = Binaryz & "01000010001" Case 101 Binaryz = Binaryz & "00010100001" Case 102 Binaryz = Binaryz & "00001010001" End Select Binaryz = Binaryz & "0011100010100" ' انهاء الكود باضافة الباينرى الخاص بايقاف جميع الاكواد ' انشاء صورة عرضها عدد حروف الباينرى المستخدم Dim bmp As Bitmap = New Bitmap(Len(Binaryz), 80, System.Drawing.Imaging.PixelFormat.Format24bppRgb) Dim z As String ' متغير لمعرفة لون الخط Dim GraphZ As Graphics = Graphics.FromImage(bmp) Dim RectZ As Rectangle = New Rectangle(0, 0, bmp.Width, bmp.Height) ' مستطيل بحجم الصورة لاعطاء الخلفية باللون الابيض ' فرشاه لدهان المستطيل السابق باللون الابيض Dim myBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(RectZ, Color.White, Color.White, Drawing.Drawing2D.LinearGradientMode.ForwardDiagonal) ' دهان المستطيل السابق باللون الابيض GraphZ.FillRectangle(myBrush, RectZ) ' رسم خطوط الباركود Dim PenZ As Pen Dim point1 As Point ' نقطة بداية الخط Dim point2 As Point ' نقطة نهاية الخط For I = 1 To Len(Binaryz) z = Mid(Binaryz, I, 1) If z = "0" Then PenZ = New Pen(Color.Black, 1) point1 = New Point(I, 20) point2 = New Point(I, 40) GraphZ.DrawLine(PenZ, point1, point2) Else PenZ = New Pen(Color.White, 1) point1 = New Point(I, 0) point2 = New Point(I, 0) GraphZ.DrawLine(PenZ, point1, point2) End If Next ' رسم النص المراد ترميزه اسفل الكود GraphZ.DrawString(TheText, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 40) Dim format1 As New StringFormat(StringFormatFlags.NoClip) format1.Alignment = StringAlignment.Center GraphZ.DrawString(Kind, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 55) GraphZ.DrawString(Price, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 0) Code128 = bmp End Function Function Toc(ByVal Text2CStr As String) As String ' دالة لتعويض النص المطلوب تشفيره بالارقام للفئة ' (C) Dim X As Integer = 1 Dim NewText As String = "" Dim Z As String = "" Do Z = Mid(Text2CStr, X, 2) ' اضافة رقم32 لقيمة الاسكى واستعادة الحرف الناتج بعد الاضافة NewText = NewText & Chr(Val(Z) + 32) X += 2 Z = Mid(Text2CStr, X, 1) If X >= Len(Text2CStr) Then Exit Do If Z = "" Then Exit Do Loop Toc = NewText End Function End Module

كود النموذج

PHP كود :

Public Class Form1 Dim PrintDoc As Printing.PrintDocument = New Printing.PrintDocument() Dim pd_PrintDialog As New PrintDialog ' Dim MyImage As System.Drawing.Image = PicBarCode.BackgroundImage Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load ActiveControl = TextBox3 End Sub ' تم ايقاف هذا الاجراء و لم يعد يستخدم و ترك مؤقتا Public Sub PrintBarCodeV() pd_PrintDialog.UseEXDialog = True pd_PrintDialog.AllowPrintToFile = False 'تحديد عدد النسخ المراد طباعتها pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value 'عرض صندوق حوار اختيار الطابعة If pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.OK Then PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler End If End Sub Private Sub TextBox3_TextChanged(sender As Object, e As EventArgs) Handles TextBox3.TextChanged PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text) End Sub 'This is the event handler for printing bar codes Private Sub PrintDocHandler(ByVal sender As Object, ByVal ev As Printing.PrintPageEventArgs) ev.Graphics.DrawImage(PicBarCode.BackgroundImage, nud_MarginH.Value, nud_MarginW.Value, nud_MarginWBrcode.Value, nud_MarginHBrcode.Value) End Sub Private Sub butPageSetup_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butPageSetup.Click 'اعداد الصفحة PageSetupDialog1.Document = PrintDoc PageSetupDialog1.ShowDialog() End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 'معاينة قبل الطباعة AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler 'تحديد عدد النسخ المراد طباعتها pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value PrintPreviewDialog1.Document = PrintDoc PrintPreviewDialog1.ShowDialog() End Sub Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click Close() End Sub Private Sub طباعة_الباركود_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Try 'كتابة اسم المنتج على ملصق الباركود 'Dim a As Graphics = PicBarCode.CreateGraphics 'a.DrawString(TextBox2.Text, Me.Font, Brushes.Black, 100, 5) 'ActiveControl = TextBox3 Catch ex As Exception End Try End Sub Private Sub Button11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) PrintBarCodeV() End Sub Private Sub Button11_Click_2(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button11.Click 'طباعة الباركود If TextBox3.Text = "" Then 'الباركود فارغ MsgBox("من فضلك تأكد من كتابة النص المراد تحويله الى باركود", MsgBoxStyle.DefaultButton1, "ogy soft") Exit Sub Else pd_PrintDialog.UseEXDialog = True pd_PrintDialog.AllowPrintToFile = False 'تحديد عدد النسخ المراد طباعتها. pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value If pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.OK Then PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler 'امر الطباعة PrintDoc.Print() ElseIf pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub End If End If End Sub Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick 'كتابة اسم المنتج على ملصق الباركود PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text) End Sub Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick 'كتابة سعر المنتج على ملصق الباركود PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text) End Sub End Class

بالتوفيق اخي

بارك الله فيك وزادك علماً

جزاكم الله خيرا اخى الكريم على تطوير الكود
الكود يقوم باضافة السعر و الصنف فى الطباعة بصورة جيدة
شكرا لك اخى

(16-09-16, 08:13 PM)ابو ليلى كتب : [ -> ]وعليكم السلام و رحمة الله
تم تكبير الصورة من 60 الى 80 لاستيعاب النصوص
تم التعديل على الدالة الرئيسية للرسم في Module1 لرسم اسم الصنف و السعر
تم تعديل بعض الكود في النموذج الرئيسي

كود Module1

PHP كود :

Module Module1 'دوال رسم الباركود Function Code128(ByVal TheText As String, ByVal CodeLetter As String, Optional Price As String = Nothing, Optional ByVal Kind As String = Nothing) As Image ' TheText متغير خاص بالنص المراد تشفيره ' CodeLetter متغير خاص بالفئة المراد استخدامها Dim Binaryz As String = "" 'متغير سيحمل النص بعد تحويله إلى باينرى Dim I As Integer Dim NumCode As Integer 'متغير سيحمل قيمة حساب النص التكميلى If CodeLetter = "A" Or CodeLetter = "a" Then NumCode = 103 Binaryz = "00101111011" End If If CodeLetter = "B" Or CodeLetter = "b" Then NumCode = 104 Binaryz = "00101101111" End If If CodeLetter = "C" Or CodeLetter = "c" Then NumCode = 105 Binaryz = "00101100011" End If ' الكود التالى سيقوم باسناد قيمة الحرف بالباينرى حسب الجدول الخاص بالكود 128 For I = 1 To Len(TheText) NumCode = NumCode + ((Asc(Mid(TheText, I, 1)) - 32) * I) Select Case Asc(Mid(TheText, I, 1)) Case 32 Binaryz = Binaryz & "00100110011" Case 33 Binaryz = Binaryz & "00110010011" Case 34 Binaryz = Binaryz & "00110011001" Case 35 Binaryz = Binaryz & "01101100111" Case 36 Binaryz = Binaryz & "01101110011" Case 37 Binaryz = Binaryz & "01110110011" Case 38 Binaryz = Binaryz & "01100110111" Case 39 Binaryz = Binaryz & "01100111011" Case 40 Binaryz = Binaryz & "01110011011" Case 41 Binaryz = Binaryz & "00110110111" Case 42 Binaryz = Binaryz & "00110111011" Case 43 Binaryz = Binaryz & "00111011011" Case 44 Binaryz = Binaryz & "01001100011" Case 45 Binaryz = Binaryz & "01100100011" Case 46 Binaryz = Binaryz & "01100110001" Case 47 Binaryz = Binaryz & "01000110011" Case 48 Binaryz = Binaryz & "01100010011" Case 49 Binaryz = Binaryz & "01100011001" Case 50 Binaryz = Binaryz & "00110001101" Case 51 Binaryz = Binaryz & "00110100011" Case 52 Binaryz = Binaryz & "00110110001" Case 53 Binaryz = Binaryz & "00100011011" Case 54 Binaryz = Binaryz & "00110001011" Case 55 Binaryz = Binaryz & "00010010001" Case 56 Binaryz = Binaryz & "00010110011" Case 57 Binaryz = Binaryz & "00011010011" Case 58 Binaryz = Binaryz & "00011011001" Case 59 Binaryz = Binaryz & "00010011011" Case 60 Binaryz = Binaryz & "00011001011" Case 61 Binaryz = Binaryz & "00011001101" Case 62 Binaryz = Binaryz & "00100100111" Case 63 Binaryz = Binaryz & "00100111001" Case 64 Binaryz = Binaryz & "00111001001" Case 65 Binaryz = Binaryz & "01011100111" Case 66 Binaryz = Binaryz & "01110100111" Case 67 Binaryz = Binaryz & "01110111001" Case 68 Binaryz = Binaryz & "01001110111" Case 69 Binaryz = Binaryz & "01110010111" Case 70 Binaryz = Binaryz & "01110011101" Case 71 Binaryz = Binaryz & "00101110111" Case 72 Binaryz = Binaryz & "00111010111" Case 73 Binaryz = Binaryz & "00111011101" Case 74 Binaryz = Binaryz & "01001000111" Case 75 Binaryz = Binaryz & "01001110001" Case 76 Binaryz = Binaryz & "01110010001" Case 77 Binaryz = Binaryz & "01000100111" Case 78 Binaryz = Binaryz & "01000111001" Case 79 Binaryz = Binaryz & "01110001001" Case 80 Binaryz = Binaryz & "00010001001" Case 81 Binaryz = Binaryz & "00101110001" Case 82 Binaryz = Binaryz & "00111010001" Case 83 Binaryz = Binaryz & "00100010111" Case 84 Binaryz = Binaryz & "00100011101" Case 85 Binaryz = Binaryz & "00100010001" Case 86 Binaryz = Binaryz & "00010100111" Case 87 Binaryz = Binaryz & "00010111001" Case 88 Binaryz = Binaryz & "00011101001" Case 89 Binaryz = Binaryz & "00010010111" Case 90 Binaryz = Binaryz & "00010011101" Case 91 Binaryz = Binaryz & "00011100101" Case 92 Binaryz = Binaryz & "00010000101" Case 93 Binaryz = Binaryz & "00110111101" Case 94 Binaryz = Binaryz & "00001110101" Case 95 Binaryz = Binaryz & "01011001111" Case 96 Binaryz = Binaryz & "01011110011" Case 97 Binaryz = Binaryz & "01101001111" Case 98 Binaryz = Binaryz & "01101111001" Case 99 Binaryz = Binaryz & "01111010011" Case 100 Binaryz = Binaryz & "01111011001" Case 101 Binaryz = Binaryz & "01001101111" Case 102 Binaryz = Binaryz & "01001111011" Case 103 Binaryz = Binaryz & "01100101111" Case 104 Binaryz = Binaryz & "01100111101" Case 105 Binaryz = Binaryz & "01111001011" Case 106 Binaryz = Binaryz & "01111001101" Case 107 Binaryz = Binaryz & "00111101101" Case 108 Binaryz = Binaryz & "00110101111" Case 109 Binaryz = Binaryz & "00001000101" Case 110 Binaryz = Binaryz & "00111101011" Case 111 Binaryz = Binaryz & "01110000101" Case 112 Binaryz = Binaryz & "01011000011" Case 113 Binaryz = Binaryz & "01101000011" Case 114 Binaryz = Binaryz & "01101100001" Case 115 Binaryz = Binaryz & "01000011011" Case 116 Binaryz = Binaryz & "01100001011" Case 117 Binaryz = Binaryz & "01100001101" Case 118 Binaryz = Binaryz & "00001011011" Case 119 Binaryz = Binaryz & "00001101011" Case 120 Binaryz = Binaryz & "00001101101" Case 121 Binaryz = Binaryz & "00100100001" Case 122 Binaryz = Binaryz & "00100001001" Case 123 Binaryz = Binaryz & "00001001001" Case 124 Binaryz = Binaryz & "01010000111" Case 125 Binaryz = Binaryz & "01011100001" Case 126 Binaryz = Binaryz & "01110100001" Case 127 Binaryz = Binaryz & "01000010111" Case 128 Binaryz = Binaryz & "01000011101" Case 129 Binaryz = Binaryz & "00001010111" Case 130 Binaryz = Binaryz & "00001011101" Case 131 Binaryz = Binaryz & "01000100001" Case 132 Binaryz = Binaryz & "01000010001" Case 133 Binaryz = Binaryz & "00010100001" Case 134 Binaryz = Binaryz & "00001010001" Case 135 Binaryz = Binaryz & "00101111011" Case 136 Binaryz = Binaryz & "00101101111" Case 137 Binaryz = Binaryz & "00101100011" Case 138 Binaryz = Binaryz & "0011100010100" End Select Next NumCode = NumCode Mod 103 ' الكود التالى لمعرفة الحرف المراد اضافتة لاستكمال النص Select Case NumCode Case 0 Binaryz = Binaryz & "00100110011" Case 1 Binaryz = Binaryz & "00110010011" Case 2 Binaryz = Binaryz & "00110011001" Case 3 Binaryz = Binaryz & "01101100111" Case 4 Binaryz = Binaryz & "01101110011" Case 5 Binaryz = Binaryz & "01110110011" Case 6 Binaryz = Binaryz & "01100110111" Case 7 Binaryz = Binaryz & "01100111011" Case 8 Binaryz = Binaryz & "01110011011" Case 9 Binaryz = Binaryz & "00110110111" Case 10 Binaryz = Binaryz & "00110111011" Case 11 Binaryz = Binaryz & "00111011011" Case 12 Binaryz = Binaryz & "01001100011" Case 13 Binaryz = Binaryz & "01100100011" Case 14 Binaryz = Binaryz & "01100110001" Case 15 Binaryz = Binaryz & "01000110011" Case 16 Binaryz = Binaryz & "01100010011" Case 17 Binaryz = Binaryz & "01100011001" Case 18 Binaryz = Binaryz & "00110001101" Case 19 Binaryz = Binaryz & "00110100011" Case 20 Binaryz = Binaryz & "00110110001" Case 21 Binaryz = Binaryz & "00100011011" Case 22 Binaryz = Binaryz & "00110001011" Case 23 Binaryz = Binaryz & "00010010001" Case 24 Binaryz = Binaryz & "00010110011" Case 25 Binaryz = Binaryz & "00011010011" Case 26 Binaryz = Binaryz & "00011011001" Case 27 Binaryz = Binaryz & "00010011011" Case 28 Binaryz = Binaryz & "00011001011" Case 29 Binaryz = Binaryz & "00011001101" Case 30 Binaryz = Binaryz & "00100100111" Case 31 Binaryz = Binaryz & "00100111001" Case 32 Binaryz = Binaryz & "00111001001" Case 33 Binaryz = Binaryz & "01011100111" Case 34 Binaryz = Binaryz & "01110100111" Case 35 Binaryz = Binaryz & "01110111001" Case 36 Binaryz = Binaryz & "01001110111" Case 37 Binaryz = Binaryz & "01110010111" Case 38 Binaryz = Binaryz & "01110011101" Case 39 Binaryz = Binaryz & "00101110111" Case 40 Binaryz = Binaryz & "00111010111" Case 41 Binaryz = Binaryz & "00111011101" Case 42 Binaryz = Binaryz & "01001000111" Case 43 Binaryz = Binaryz & "01001110001" Case 44 Binaryz = Binaryz & "01110010001" Case 45 Binaryz = Binaryz & "01000100111" Case 46 Binaryz = Binaryz & "01000111001" Case 47 Binaryz = Binaryz & "01110001001" Case 48 Binaryz = Binaryz & "00010001001" Case 49 Binaryz = Binaryz & "00101110001" Case 50 Binaryz = Binaryz & "00111010001" Case 51 Binaryz = Binaryz & "00100010111" Case 52 Binaryz = Binaryz & "00100011101" Case 53 Binaryz = Binaryz & "00100010001" Case 54 Binaryz = Binaryz & "00010100111" Case 55 Binaryz = Binaryz & "00010111001" Case 56 Binaryz = Binaryz & "00011101001" Case 57 Binaryz = Binaryz & "00010010111" Case 58 Binaryz = Binaryz & "00010011101" Case 59 Binaryz = Binaryz & "00011100101" Case 60 Binaryz = Binaryz & "00010000101" Case 61 Binaryz = Binaryz & "00110111101" Case 62 Binaryz = Binaryz & "00001110101" Case 63 Binaryz = Binaryz & "01011001111" Case 64 Binaryz = Binaryz & "01011110011" Case 65 Binaryz = Binaryz & "01101001111" Case 66 Binaryz = Binaryz & "01101111001" Case 67 Binaryz = Binaryz & "01111010011" Case 68 Binaryz = Binaryz & "01111011001" Case 69 Binaryz = Binaryz & "01001101111" Case 70 Binaryz = Binaryz & "01001111011" Case 71 Binaryz = Binaryz & "01100101111" Case 72 Binaryz = Binaryz & "01100111101" Case 73 Binaryz = Binaryz & "01111001011" Case 74 Binaryz = Binaryz & "01111001101" Case 75 Binaryz = Binaryz & "00111101101" Case 76 Binaryz = Binaryz & "00110101111" Case 77 Binaryz = Binaryz & "00001000101" Case 78 Binaryz = Binaryz & "00111101011" Case 79 Binaryz = Binaryz & "01110000101" Case 80 Binaryz = Binaryz & "01011000011" Case 81 Binaryz = Binaryz & "01101000011" Case 82 Binaryz = Binaryz & "01101100001" Case 83 Binaryz = Binaryz & "01000011011" Case 84 Binaryz = Binaryz & "01100001011" Case 85 Binaryz = Binaryz & "01100001101" Case 86 Binaryz = Binaryz & "00001011011" Case 87 Binaryz = Binaryz & "00001101011" Case 88 Binaryz = Binaryz & "00001101101" Case 89 Binaryz = Binaryz & "00100100001" Case 90 Binaryz = Binaryz & "00100001001" Case 91 Binaryz = Binaryz & "00001001001" Case 92 Binaryz = Binaryz & "01010000111" Case 93 Binaryz = Binaryz & "01011100001" Case 94 Binaryz = Binaryz & "01110100001" Case 95 Binaryz = Binaryz & "01000010111" Case 96 Binaryz = Binaryz & "01000011101" Case 97 Binaryz = Binaryz & "00001010111" Case 98 Binaryz = Binaryz & "00001011101" Case 99 Binaryz = Binaryz & "01000100001" Case 100 Binaryz = Binaryz & "01000010001" Case 101 Binaryz = Binaryz & "00010100001" Case 102 Binaryz = Binaryz & "00001010001" End Select Binaryz = Binaryz & "0011100010100" ' انهاء الكود باضافة الباينرى الخاص بايقاف جميع الاكواد ' انشاء صورة عرضها عدد حروف الباينرى المستخدم Dim bmp As Bitmap = New Bitmap(Len(Binaryz), 80, System.Drawing.Imaging.PixelFormat.Format24bppRgb) Dim z As String ' متغير لمعرفة لون الخط Dim GraphZ As Graphics = Graphics.FromImage(bmp) Dim RectZ As Rectangle = New Rectangle(0, 0, bmp.Width, bmp.Height) ' مستطيل بحجم الصورة لاعطاء الخلفية باللون الابيض ' فرشاه لدهان المستطيل السابق باللون الابيض Dim myBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(RectZ, Color.White, Color.White, Drawing.Drawing2D.LinearGradientMode.ForwardDiagonal) ' دهان المستطيل السابق باللون الابيض GraphZ.FillRectangle(myBrush, RectZ) ' رسم خطوط الباركود Dim PenZ As Pen Dim point1 As Point ' نقطة بداية الخط Dim point2 As Point ' نقطة نهاية الخط For I = 1 To Len(Binaryz) z = Mid(Binaryz, I, 1) If z = "0" Then PenZ = New Pen(Color.Black, 1) point1 = New Point(I, 20) point2 = New Point(I, 40) GraphZ.DrawLine(PenZ, point1, point2) Else PenZ = New Pen(Color.White, 1) point1 = New Point(I, 0) point2 = New Point(I, 0) GraphZ.DrawLine(PenZ, point1, point2) End If Next ' رسم النص المراد ترميزه اسفل الكود GraphZ.DrawString(TheText, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 40) Dim format1 As New StringFormat(StringFormatFlags.NoClip) format1.Alignment = StringAlignment.Center GraphZ.DrawString(Kind, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 55) GraphZ.DrawString(Price, New Font("times new roman", 12, FontStyle.Bold), New SolidBrush(Color.Black), 20, 0) Code128 = bmp End Function Function Toc(ByVal Text2CStr As String) As String ' دالة لتعويض النص المطلوب تشفيره بالارقام للفئة ' (C) Dim X As Integer = 1 Dim NewText As String = "" Dim Z As String = "" Do Z = Mid(Text2CStr, X, 2) ' اضافة رقم32 لقيمة الاسكى واستعادة الحرف الناتج بعد الاضافة NewText = NewText & Chr(Val(Z) + 32) X += 2 Z = Mid(Text2CStr, X, 1) If X >= Len(Text2CStr) Then Exit Do If Z = "" Then Exit Do Loop Toc = NewText End Function End Module

كود النموذج

PHP كود :

Public Class Form1 Dim PrintDoc As Printing.PrintDocument = New Printing.PrintDocument() Dim pd_PrintDialog As New PrintDialog ' Dim MyImage As System.Drawing.Image = PicBarCode.BackgroundImage Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load ActiveControl = TextBox3 End Sub ' تم ايقاف هذا الاجراء و لم يعد يستخدم و ترك مؤقتا Public Sub PrintBarCodeV() pd_PrintDialog.UseEXDialog = True pd_PrintDialog.AllowPrintToFile = False 'تحديد عدد النسخ المراد طباعتها pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value 'عرض صندوق حوار اختيار الطابعة If pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.OK Then PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler End If End Sub Private Sub TextBox3_TextChanged(sender As Object, e As EventArgs) Handles TextBox3.TextChanged PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text) End Sub 'This is the event handler for printing bar codes Private Sub PrintDocHandler(ByVal sender As Object, ByVal ev As Printing.PrintPageEventArgs) ev.Graphics.DrawImage(PicBarCode.BackgroundImage, nud_MarginH.Value, nud_MarginW.Value, nud_MarginWBrcode.Value, nud_MarginHBrcode.Value) End Sub Private Sub butPageSetup_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butPageSetup.Click 'اعداد الصفحة PageSetupDialog1.Document = PrintDoc PageSetupDialog1.ShowDialog() End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 'معاينة قبل الطباعة AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler 'تحديد عدد النسخ المراد طباعتها pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value PrintPreviewDialog1.Document = PrintDoc PrintPreviewDialog1.ShowDialog() End Sub Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click Close() End Sub Private Sub طباعة_الباركود_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Try 'كتابة اسم المنتج على ملصق الباركود 'Dim a As Graphics = PicBarCode.CreateGraphics 'a.DrawString(TextBox2.Text, Me.Font, Brushes.Black, 100, 5) 'ActiveControl = TextBox3 Catch ex As Exception End Try End Sub Private Sub Button11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) PrintBarCodeV() End Sub Private Sub Button11_Click_2(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button11.Click 'طباعة الباركود If TextBox3.Text = "" Then 'الباركود فارغ MsgBox("من فضلك تأكد من كتابة النص المراد تحويله الى باركود", MsgBoxStyle.DefaultButton1, "ogy soft") Exit Sub Else pd_PrintDialog.UseEXDialog = True pd_PrintDialog.AllowPrintToFile = False 'تحديد عدد النسخ المراد طباعتها. pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value If pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.OK Then PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler 'امر الطباعة PrintDoc.Print() ElseIf pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub End If End If End Sub Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick 'كتابة اسم المنتج على ملصق الباركود PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text) End Sub Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick 'كتابة سعر المنتج على ملصق الباركود PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text) End Sub End Class

بالتوفيق اخي

شكرا جزيلا مرة اخرى اخى على تعديل الدوال و زادكم الله من فضلة

اخى اريد كود اضعه فى زر امر الطباعة اقوم بتحديد نوع البرينتر كي يطبع افتراضيا و شكرا على مجهوداتك

الاساتذة
يا ريت احد يرفع الملف بعد التعديل

ينقل الى القسم المناسب اسئلة vb.net
حتى يتم تنفيذ الطلب بشكل اسرع

عذراً للتاخير اخي الكريم.....كثرة المشاغل
لتحديد الطابعة من الطابعات المثبتة لديك انت تحتاج الى تمرير اسم الطابعة مباشرة الى اعدادت الطباعة او كفكرة موسعة
لنقم باضافة الطابعات المتوفرة الى ListBox1 و اضافة من عندي نضيف ايضاً الدقة الى ListBox2
و نمرر اسم الطابعة و الدقة الى اجراء الطباعة
المطلوب منك اضافة ListBox1-ListBox2 الى النموذج
و الكود التالي استبدله بكود النموذج لديك

كود النموذج

PHP كود :

Imports System.Drawing.Printing

Public Class Form1
    Dim PrintDoc As Printing.PrintDocument = New Printing.PrintDocument()
    Dim pd_PrintDialog As New PrintDialog
    ' Dim MyImage As System.Drawing.Image = PicBarCode.BackgroundImage

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        ActiveControl = TextBox3

        Dim Print_name As String
        For i As Integer = 0 To PrinterSettings.InstalledPrinters.Count - 1
            Print_name = PrinterSettings.InstalledPrinters.Item(i)
            ListBox1.Items.Add(Print_name)
        Next

        ListBox2.DataSource = pd_PrintDialog.PrinterSettings.PrinterResolutions.OfType(Of Printing.PrinterResolution).Select(Function(x) New PrintQuality(x)).ToArray
        ListBox2.Enabled = ListBox2.Items.Count > 0
        ListBox2.SelectedItem = ListBox2.Items.OfType(Of PrintQuality).FirstOrDefault

    End Sub

    ' تم ايقاف هذا الاجراء و لم يعد يستخدم و ترك مؤقتا 
    Public Sub PrintBarCodeV()

        pd_PrintDialog.UseEXDialog = True
        pd_PrintDialog.AllowPrintToFile = False

        'تحديد عدد النسخ المراد طباعتها
        pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value

        'عرض صندوق حوار اختيار الطابعة
        If pd_PrintDialog.ShowDialog = Windows.Forms.DialogResult.OK Then
            PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings
            AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler

        End If

    End Sub

    Private Sub TextBox3_TextChanged(sender As Object, e As EventArgs) Handles TextBox3.TextChanged
        PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text)
    End Sub

    'This is the event handler for printing bar codes
    Private Sub PrintDocHandler(ByVal sender As Object, ByVal ev As Printing.PrintPageEventArgs)
        ev.Graphics.DrawImage(PicBarCode.BackgroundImage, nud_MarginH.Value, nud_MarginW.Value, nud_MarginWBrcode.Value, nud_MarginHBrcode.Value)

    End Sub

    Private Sub butPageSetup_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butPageSetup.Click

        'اعداد الصفحة

        PageSetupDialog1.Document = PrintDoc
        PageSetupDialog1.ShowDialog()
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        'معاينة قبل الطباعة

        AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler

        'تحديد عدد النسخ المراد طباعتها
        pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value

        PrintPreviewDialog1.Document = PrintDoc
        PrintPreviewDialog1.ShowDialog()

    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        Close()
    End Sub

    Private Sub طباعة_الباركود_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Try

            'كتابة اسم المنتج على ملصق الباركود
            'Dim a As Graphics = PicBarCode.CreateGraphics
            'a.DrawString(TextBox2.Text, Me.Font, Brushes.Black, 100, 5)

            'ActiveControl = TextBox3

        Catch ex As Exception

        End Try
    End Sub

    Private Sub Button11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        PrintBarCodeV()
    End Sub

    Private Sub Button11_Click_2(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button11.Click

        'طباعة الباركود
        If TextBox3.Text = "" Then 'الباركود فارغ 
            MsgBox("من فضلك تأكد من كتابة النص المراد تحويله الى باركود", MsgBoxStyle.DefaultButton1, "ogy soft")
            Exit Sub

        Else

            pd_PrintDialog.PrinterSettings.DefaultPageSettings.PrinterSettings.PrintToFile = False
            'تحديد عدد النسخ المراد طباعتها.
            pd_PrintDialog.PrinterSettings.Copies = nud_Count.Value

            PrintDoc.PrinterSettings = pd_PrintDialog.PrinterSettings
            PrintDoc.PrinterSettings.PrinterName = ListBox1.Text

            'دقة الطباعة
            Dim PrintQuality = TryCast(ListBox2.SelectedItem, PrintQuality)
            If PrintQuality IsNot Nothing Then
                PrintDoc.DefaultPageSettings.PrinterResolution = PrintQuality.Resolution
            End If

            AddHandler PrintDoc.PrintPage, AddressOf PrintDocHandler
            'امر الطباعة
            PrintDoc.Print()
        End If
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick

        'كتابة اسم المنتج على ملصق الباركود
        PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text)

    End Sub

    Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick

        'كتابة سعر  المنتج على ملصق الباركود
        PicBarCode.BackgroundImage = Code128(TextBox3.Text, "A", TextBox4.Text, TextBox2.Text)
    End Sub

End Class

'كلاس للدقة
Public Class PrintQuality
    Public Property Resolution As Printing.PrinterResolution

    Public Overrides Function ToString() As String
        If Resolution.Kind = Printing.PrinterResolutionKind.Custom Then
            Return "Custom (" & Resolution.X & " x " & Resolution.Y & " DPI)"
        Else
            Return Resolution.Kind.ToString
        End If
    End Function

    Public Sub New(Resolution As Printing.PrinterResolution)
        Me.Resolution = Resolution
    End Sub
End Class

و لا تنسى ترفع الملف بعد التعديل لمن طلبه الاصدارة لدي لا تتوافق مع اغلب الاصدارات عند الاعضاء

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

nabil.1710

shwehdi4pc

nabil.1710

ابو ليلى

سيد درويش

nabil.1710

nabil.1710

atefkhalf2004

جميل علي

ابو ليلى