المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
السلام عليكم ورحمة الله
عندي كود يطبع من ال DataGridView
يطبع على شكل print label
المشكله الان يطبع السجل الواحد يمين ويسار
المطلوب ان عندي داتا جريد من 5 سجلات يطبع لي السجل الاول على اليمين فوق الثاني على اليسار فوق وهكذا
يعني بدل ما ينزلهم تحت بعض المطلوب ان يكونون يمين ويسار
حاولت اعدل على الكود بس ما ضبط
قمت بالبحث كثير في المنتدى وفي قوقل بس ما حصلت الطريقه
وانا كلي ثقه بان الموجودين هنا ما راح يقصرن باذن الله
شكرا من جديد
واتمنى الفكرة وصلت
مرفق المشروع
Print Example.zip (الحجم : 106.2 ك ب / التحميلات : 53)
المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
09-04-17, 03:06 PM
(آخر تعديل لهذه المشاركة : 09-04-17, 06:32 PM {2} بواسطة dubai.eig.)
(09-04-17, 02:07 PM)khodor1985 كتب : السلام عليكم أخي العزيز ورحمة الله وبركاته
استخدم ReportViewer أو الـ CrystalReport وبلا هيدي الطوشة كلها، ولا تعقد الأمور على نفسك
شكرا لك على الرد
فعلا طوشة هههه
لاني حاولت اغير في كود خاص بال بركوت بس ما نفع وما عندي خبره في التعامل مع CrystalReport او ReportViewer
لو ممكن تعطيني المفتاح وانا اكمل الباقي جزاك خير
المشاركات : 150
المواضيع 1
الإنتساب : Mar 2017
السمعة :
12
الشكر: 211
تم شكره 171 مرات في 94 مشاركات
تفضل التعديل
PHP كود :
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim leftMagin As Integer = e.MarginBounds.Left Dim topMagin As Integer = e.MarginBounds.Top
Dim cellFont As New Font("Arial", 14) Dim cellForeColor As New SolidBrush(Color.Black) Dim cellBackColor As New SolidBrush(Color.WhiteSmoke) Dim cellBorderColor As New Pen(Brushes.Blue, 1) Dim cellSize As New Size(300, 100)
Dim index As Integer = 0
For currentY = 0 To (Me.DataGridView1.Rows.Count - 1) \ 2 For currentX = 0 To 1
Dim cellText As String = "confirming QSO with" & Me.DataGridView1.Rows(index).Cells(1).Value & vbNewLine & _ "Call: " & Me.DataGridView1.Rows(index).Cells(2).Value
Dim cellPoint As New Point(leftMagin + (currentX * cellSize.Width), topMagin + (currentY * cellSize.Height)) Dim cellRectangle As New Rectangle(cellPoint, cellSize)
e.Graphics.FillRectangle(cellBackColor, cellRectangle)
e.Graphics.DrawString(cellText, cellFont, cellForeColor, cellRectangle)
e.Graphics.DrawRectangle(cellBorderColor, cellRectangle)
index += 1 If index > Me.DataGridView1.Rows.Count - If(Me.DataGridView1.AllowUserToAddRows, 2, 1) Then Exit For
Next Next
End Sub
المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
(09-04-17, 08:15 PM)abdualla كتب : تفضل التعديل
PHP كود :
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim leftMagin As Integer = e.MarginBounds.Left Dim topMagin As Integer = e.MarginBounds.Top
Dim cellFont As New Font("Arial", 14) Dim cellForeColor As New SolidBrush(Color.Black) Dim cellBackColor As New SolidBrush(Color.WhiteSmoke) Dim cellBorderColor As New Pen(Brushes.Blue, 1) Dim cellSize As New Size(300, 100)
Dim index As Integer = 0
For currentY = 0 To (Me.DataGridView1.Rows.Count - 1) \ 2 For currentX = 0 To 1
Dim cellText As String = "confirming QSO with" & Me.DataGridView1.Rows(index).Cells(1).Value & vbNewLine & _ "Call: " & Me.DataGridView1.Rows(index).Cells(2).Value
Dim cellPoint As New Point(leftMagin + (currentX * cellSize.Width), topMagin + (currentY * cellSize.Height)) Dim cellRectangle As New Rectangle(cellPoint, cellSize)
e.Graphics.FillRectangle(cellBackColor, cellRectangle)
e.Graphics.DrawString(cellText, cellFont, cellForeColor, cellRectangle)
e.Graphics.DrawRectangle(cellBorderColor, cellRectangle)
index += 1 If index > Me.DataGridView1.Rows.Count - If(Me.DataGridView1.AllowUserToAddRows, 2, 1) Then Exit For
Next Next
End Sub
بارك الله فيك استاذ عبدالله
نعم هذ المطلوب
شكرا لك
في خدمة بسيطه بارك الله فيك
محتاج يكون اذا نفس ال Product
الناتج له يكون تحت بعض
يعني مثلا
Product 1
موجود في الداتا قريد ثلام مرات وله ثلاث نتائج
النتاج ماله يكونون تحت بعض في نفس المربع
Product 1
1000
2000
3000
ان شاءالله وصلت الفكرة بارك الله فيك
السموحه بتعبك معاي
في ميزان اعمالك
المشاركات : 150
المواضيع 1
الإنتساب : Mar 2017
السمعة :
12
الشكر: 211
تم شكره 171 مرات في 94 مشاركات
اسحب سطر For currentX وضعه فوق For currentY
المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
(09-04-17, 09:12 PM)abdualla كتب : اسحب سطر For currentX وضعه فوق For currentY
بارك الله فيك
طلع كذا
بس انا قصدي يكون كذا
وشكرا من جديد جزاك الله الف خير
المشاركات : 150
المواضيع 1
الإنتساب : Mar 2017
السمعة :
12
الشكر: 211
تم شكره 171 مرات في 94 مشاركات
تفضل التعديل
PHP كود :
Private products As New Dictionary(Of String, String)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load DataGridView1.ColumnCount = 3 DataGridView1.Columns(0).Name = "id" DataGridView1.Columns(1).Name = " Name" DataGridView1.Columns(2).Name = "Price"
DataGridView1.Rows.Add("1", "Product 1", "1000") DataGridView1.Rows.Add("2", "Product 1", "2000") DataGridView1.Rows.Add("3", "Product 1", "3000") DataGridView1.Rows.Add("4", "Product 4", "4000") DataGridView1.Rows.Add("5", "Product 5", "5000")
For Each r As DataGridViewRow In Me.DataGridView1.Rows If r.IsNewRow Then Exit For Dim p As String = r.Cells(1).Value If Not products.Keys.Contains(p) Then products.Add(p, "") Next
For i = 0 To products.Count - 1 For Each r As DataGridViewRow In Me.DataGridView1.Rows If r.IsNewRow Then Exit For Dim k As String = r.Cells(1).Value Dim v As String = r.Cells(2).Value If products.Keys(i) = k Then products(k) = products(k) & "Call: " & v & vbNewLine End If Next Next
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim leftMargin As Integer = e.MarginBounds.Left Dim topMargin As Integer = e.MarginBounds.Top
Dim cellFont As New Font("Arial", 14) Dim cellForeColor As New SolidBrush(Color.Black) Dim cellBackColor As New SolidBrush(Color.WhiteSmoke) Dim cellBorderColor As New Pen(Brushes.Blue, 1) Dim cellSize As New Size(300, 100)
Dim index As Integer = 0
For currentY = 0 To (products.Count - 1) \ 2 For currentX = 0 To 1
Dim cellText As String = "confirming QSO with " & products.Keys(index) & vbNewLine & _ products(products.Keys(index))
Dim cellPoint As New Point(leftMargin + (currentX * cellSize.Width), topMargin + (currentY * cellSize.Height)) Dim cellRectangle As New Rectangle(cellPoint, cellSize)
e.Graphics.FillRectangle(cellBackColor, cellRectangle)
e.Graphics.DrawString(cellText.Trim, cellFont, cellForeColor, cellRectangle)
e.Graphics.DrawRectangle(cellBorderColor, cellRectangle)
index += 1 If index = products.Count Then Exit For
Next Next
End Sub
المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
(10-04-17, 01:20 AM)abdualla كتب : تفضل التعديل
PHP كود :
Private products As New Dictionary(Of String, String)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load DataGridView1.ColumnCount = 3 DataGridView1.Columns(0).Name = "id" DataGridView1.Columns(1).Name = " Name" DataGridView1.Columns(2).Name = "Price"
DataGridView1.Rows.Add("1", "Product 1", "1000") DataGridView1.Rows.Add("2", "Product 1", "2000") DataGridView1.Rows.Add("3", "Product 1", "3000") DataGridView1.Rows.Add("4", "Product 4", "4000") DataGridView1.Rows.Add("5", "Product 5", "5000")
For Each r As DataGridViewRow In Me.DataGridView1.Rows If r.IsNewRow Then Exit For Dim p As String = r.Cells(1).Value If Not products.Keys.Contains(p) Then products.Add(p, "") Next
For i = 0 To products.Count - 1 For Each r As DataGridViewRow In Me.DataGridView1.Rows If r.IsNewRow Then Exit For Dim k As String = r.Cells(1).Value Dim v As String = r.Cells(2).Value If products.Keys(i) = k Then products(k) = products(k) & "Call: " & v & vbNewLine End If Next Next
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim leftMargin As Integer = e.MarginBounds.Left Dim topMargin As Integer = e.MarginBounds.Top
Dim cellFont As New Font("Arial", 14) Dim cellForeColor As New SolidBrush(Color.Black) Dim cellBackColor As New SolidBrush(Color.WhiteSmoke) Dim cellBorderColor As New Pen(Brushes.Blue, 1) Dim cellSize As New Size(300, 100)
Dim index As Integer = 0
For currentY = 0 To (products.Count - 1) \ 2 For currentX = 0 To 1
Dim cellText As String = "confirming QSO with " & products.Keys(index) & vbNewLine & _ products(products.Keys(index))
Dim cellPoint As New Point(leftMargin + (currentX * cellSize.Width), topMargin + (currentY * cellSize.Height)) Dim cellRectangle As New Rectangle(cellPoint, cellSize)
e.Graphics.FillRectangle(cellBackColor, cellRectangle)
e.Graphics.DrawString(cellText.Trim, cellFont, cellForeColor, cellRectangle)
e.Graphics.DrawRectangle(cellBorderColor, cellRectangle)
index += 1 If index = products.Count Then Exit For
Next Next
End Sub
احسنت كفيت ووفيت جزاك الله خير
شكرا واسمحلي على تعبك
الحمدالله والشكر
لا ننحرم منك
في ميزان اعمالك
المشاركات : 536
المواضيع 182
الإنتساب : Mar 2016
السمعة :
19
الشكر: 652
تم شكره 264 مرات في 171 مشاركات
(10-04-17, 01:20 AM)abdualla كتب : تفضل التعديل
PHP كود :
Private products As New Dictionary(Of String, String)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load DataGridView1.ColumnCount = 3 DataGridView1.Columns(0).Name = "id" DataGridView1.Columns(1).Name = " Name" DataGridView1.Columns(2).Name = "Price"
DataGridView1.Rows.Add("1", "Product 1", "1000") DataGridView1.Rows.Add("2", "Product 1", "2000") DataGridView1.Rows.Add("3", "Product 1", "3000") DataGridView1.Rows.Add("4", "Product 4", "4000") DataGridView1.Rows.Add("5", "Product 5", "5000")
For Each r As DataGridViewRow In Me.DataGridView1.Rows If r.IsNewRow Then Exit For Dim p As String = r.Cells(1).Value If Not products.Keys.Contains(p) Then products.Add(p, "") Next
For i = 0 To products.Count - 1 For Each r As DataGridViewRow In Me.DataGridView1.Rows If r.IsNewRow Then Exit For Dim k As String = r.Cells(1).Value Dim v As String = r.Cells(2).Value If products.Keys(i) = k Then products(k) = products(k) & "Call: " & v & vbNewLine End If Next Next
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim leftMargin As Integer = e.MarginBounds.Left Dim topMargin As Integer = e.MarginBounds.Top
Dim cellFont As New Font("Arial", 14) Dim cellForeColor As New SolidBrush(Color.Black) Dim cellBackColor As New SolidBrush(Color.WhiteSmoke) Dim cellBorderColor As New Pen(Brushes.Blue, 1) Dim cellSize As New Size(300, 100)
Dim index As Integer = 0
For currentY = 0 To (products.Count - 1) \ 2 For currentX = 0 To 1
Dim cellText As String = "confirming QSO with " & products.Keys(index) & vbNewLine & _ products(products.Keys(index))
Dim cellPoint As New Point(leftMargin + (currentX * cellSize.Width), topMargin + (currentY * cellSize.Height)) Dim cellRectangle As New Rectangle(cellPoint, cellSize)
e.Graphics.FillRectangle(cellBackColor, cellRectangle)
e.Graphics.DrawString(cellText.Trim, cellFont, cellForeColor, cellRectangle)
e.Graphics.DrawRectangle(cellBorderColor, cellRectangle)
index += 1 If index = products.Count Then Exit For
Next Next
End Sub
السلام عليك اخي عبدالله
بعد تجربة الكود عدة مرات اتضح ان هناك خلل بسيط
في حالت تواجد اكثر من سجل باسم واحد يطلع في مربع تحت بعض ويضيع الكلام
حاولت اجعل لكل مربع مثلا ادخالين واذا في اكثر يروح لمربع جديد
كمثال
Product 1
1000
2000
3000
2000
2000
3000
3000
الان نشوف ان Product 1 تحت 7 ادخالات
مثلا نجعل لكل مربع 3 ادخالات والباقي يفتح مربع جديد لكل 3 مربع
بس هذا التعديل وجزاك الله خير
لان من امس بليل احاول العب في الكود بس ما ضبط معاي
وشكرا
المشاركات : 150
المواضيع 1
الإنتساب : Mar 2017
السمعة :
12
الشكر: 211
تم شكره 171 مرات في 94 مشاركات
10-04-17, 10:22 AM
(آخر تعديل لهذه المشاركة : 10-04-17, 10:22 AM {2} بواسطة abdualla.)
شوف ينفع هذا التعديل لنفس الكود الأخير في جز الحدث PrintDocument1_PrintPage
PHP كود :
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim leftMargin As Integer = e.MarginBounds.Left Dim topMargin As Integer = e.MarginBounds.Top
Dim cellFont As New Font("Arial", 14) Dim cellForeColor As New SolidBrush(Color.Black) Dim cellBackColor As New SolidBrush(Color.WhiteSmoke) Dim cellBorderColor As New Pen(Brushes.Blue, 1) Dim cellSize As New Size(300, 100)
Dim y As Integer = 0
For index = 0 To products.Count - 1
Dim cellText As String = "confirming QSO with " & products.Keys(index) & vbNewLine & _ products(products.Keys(index))
Dim txtSize As Size = TextRenderer.MeasureText(cellText, cellFont)
Dim cellPoint As New Point(leftMargin + (0), topMargin + (y)) Dim cellRectangle As New Rectangle(cellPoint, New Size(cellSize.Width, txtSize.Height))
e.Graphics.FillRectangle(cellBackColor, cellRectangle) e.Graphics.DrawString(cellText.Trim, cellFont, cellForeColor, cellRectangle) e.Graphics.DrawRectangle(cellBorderColor, cellRectangle)
y += txtSize.Height
Next
End Sub
لأن الطلب الأخير محتاج وقت
|