| |

VB.NET - Ein- und UmsteigerFormular erstellen bzw. drucken | |  | Autor: Erichbru | Datum: 25.04.23 18:42 |
| Guten Abend zusammen,
ja wieder mal das drucken etwas spezieller!
also habe da eine Datengebundene Datagridview bzw. eine Datatable in der ich unter anderem eine Spalte "Pfad", und eine Spalte "Bildname" habe
die Image ausdrucken ist kein Problem, nur wie ich mir die Seite vorstelle das ist das Problem
es passen theoretisch 3 Zeilen auf die Seite (Hochformat) die Image aus dem Pfad sollen nebeneinander gedruckt werden
darunter soll ein Stempel gedruckt werden und mit einer Abschlusslinie soll die Datenzeile beendet werden. Nächste 4 Bilder aus dem Pfad etc.
so habe ich schon mal meine ersten wir Bilder gezeichnet und nun klemmt es bei mir
schreibe ich einen neuen Datensatz in die Tabelle wird das auch in die gleiche Zeile gedruckt da müsste nun was passieren?
Danke für eure Ideen dazu
'--------------------------------------------------------------
Dim imgeLocation As Point = New Point(50, 180)
Dim Belegstempel As Point = New Point(50, 370)
Dim BelegSize As Size = New Size(150, 22)
Dim x As Integer, y As Integer
Dim R As Rectangle
Dim Stempel As String
'--------------------------------------------------------------
Try
For i As Integer = 0 To DS.tabelle.Rows.Count - 1
Dim row As DataRow = DS.tabelle.Rows(i)
Dim bildpfad As String = row("Pfad").ToString
Dim Stempeldate As Date = row("Stempeldatum").ToString
Stempel = Format(Stampeldate, "ddd-dd.MM.yyyy HH:mm")
'Bildpfad prüfen
If IsBildPfad(bildpfad) = True Then
Dim img As Image = Resize_Image(New Bitmap(Image.FromFile(bildpfad)))
e.Graphics.DrawImage(img, imgeLocation)
'Berechnen der Position der nächsten img
imgeLocation.X += img.Width + 2
'Berechnen der Position des nächsten Belegstempel
Belegstempel.X += img.Width
R = New Rectangle(Belegstempel.X + (x - 1) * _
BelegSize.Width, _
Belegstempel.Y + (y - 2) * BelegSize.Height, _
BelegSize.Width, BelegSize.Height)
e.Graphics.FillRectangle(New SolidBrush(HeadColor), R) _
'Belegstempel Farbe
e.Graphics.DrawRectangle(LightGrayPen, R) _
'Rahmen Belegstempel
e.Graphics.DrawString(Stempel, f8, Brushes.White, R, sf) _
'Text Belegstempel
'Abschlusslinie drucken
e.Graphics.DrawLine(p1, 50, Belegstempel.Y + 10, 718, _
Belegstempel.Y + 10)
Else
'?
End If
Next i
Catch ex As Exception
End Try
e.Graphics.Dispose()
p1.Dispose() so soll es nachher ungefähr aussehen:
 |  |
Re: Formular erstellen bzw. drucken | |  | Autor: Erichbru | Datum: 28.04.23 18:20 |
| Guten Abend zusammen,
habe jetzt mal herum experementiert und diesen Code dazu geschrieben.
Private Sub PD_Strombeleg_PrintPage(ByVal sender As Object, ByVal e As _
PrintPageEventArgs) Handles PD_Strombeleg.PrintPage
Dim g As Graphics = e.Graphics
'Beg: Druck-Qualität
g.CompositingQuality = _
System.Drawing.Drawing2D.CompositingQuality.HighSpeed
g.InterpolationMode = _
System.Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
g.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.HighQuality
g.PixelOffsetMode = System.Drawing.Drawing2D.PixelOffsetMode.HighQuality
g.CompositingMode = System.Drawing.Drawing2D.CompositingMode.SourceOver
g.TextRenderingHint = System.Drawing.Text.TextRenderingHint.AntiAlias
g.PageUnit = GraphicsUnit.Display
'End: Druck-Qualität
'Beg: Druckbereich
Dim Druckbereich = g.VisibleClipBounds
Dim margin = Me.PD_Strombeleg.DefaultPageSettings.Margins
Druckbereich.Offset(margin.Left, margin.Top) ' obere linke Ecke
Druckbereich.Width -= (margin.Left + margin.Right) ' neue Breite
Druckbereich.Height -= (margin.Top + margin.Bottom) ' neue Höhe
'End: Druckbereich
DruckSeite += 1
'Beg: Seite 1 - Hauptformular
If DruckSeite = 1 Then
'Titel & Text:
Titel_Text_Block(g, Druckbereich)
If HBDatenbankDS.tblStrom.Rows.Count > 0 Then
e.HasMorePages = True : g.Dispose() : Return
Else
e.HasMorePages = False : g.Dispose() : Return
End If
End If
'End: Seite 1 - Hauptformular
e.Graphics.Dispose()
'p1.Dispose()
End Sub aufgrund das der Text zu groß wird kann ich nur einen kleinen Teil vom Code senden. Gerne sende ich das als PN wenn sich das jemand anschauen möchte
Mein Problem ist der Seiten wechsel, also wenn auf eine weitere Seite weitergedruckt werden muss?
das aktuelle Ergebnis sieht dann so aus! wer zeigt mir den Weg wie ich eine weitere Seite generiere wenn mehr benötigt werden.
aktuell passen 7 Bild Zeilen aufs A4 Hochformat. Ab 8 muss eine neue Seite her wo setze ich da an?

Beitrag wurde zuletzt am 28.04.23 um 18:27:31 editiert. |  |
Re: Formular erstellen bzw. drucken | |  | Autor: Erichbru | Datum: 28.04.23 18:34 |
| OK so lese ich die Bilder ein und male die Untereinander, das klappt auch ich weiß nur nicht wie ich da eine weitere Seite erstelle wenn es nicht mehr auf eine passt?
die Daten kommen aus einer Datatable
'Textblock:
Dim x, y As Single
x = Druckbereich.Left
y = Druckbereich.Top + TitelBox.Height + 75 ' Y_Start
'Dim sf As StringFormat = StringFormat.GenericTypographic
sf.Alignment = StringAlignment.Near
sf.LineAlignment = StringAlignment.Near
Dim Stempel, EintragA, EintragB, EintragC, EintragD As String
Dim minSize As SizeF = g.MeasureString("Belegnummer:", FontBold, _
Druckbereich.Size)
Dim minBreite = minSize.Width + 140
Dim minHöhe = minSize.Height
Dim x2Pos As Single = x + minBreite + 8
Dim line_x2 As Single = Druckbereich.Width + Druckbereich.Left
EintragA = "Belegnummer:"
EintragC = "Ablesewert:"
Try
For i As Integer = 0 To DS.tabelle.Rows.Count - 1
Dim row As DataRow = DS.tabelle.Rows(i)
Dim bildpfad As String = row("Pfad").ToString
Dim Ablesedate As Date = row("Ablesedatum").ToString
Stempel = Format(Ablesedate, "ddd-dd.MM.yyyy HH:mm")
EintragB = row("ID").ToString
EintragD = row("S1258882").ToString
'Bildpfad prüfen
If IsBildPfad(bildpfad) = True Then
Dim img As Bitmap = GetZoomImage(Image.FromFile(testBild), _
New Size(120, 120), _
Drawing2D.InterpolationMode.HighQualityBicubic)
Dim r As New Rectangle(50, y * (i + 1), img.Width + 3, _
img.Height + 3)
g.DrawImage(img, 50, y * (i + 1))
g.DrawRectangle(pen_big, r)
g.DrawString("Beleg vom: " & Stempel, New Font("arial", 8), _
Brushes.Black, New Point(50, y * (i + 1) + img.Height + _
14))
g.DrawString(EintragA, FontBold, Brushes.Black, x + 135, y _
* (i + 1), sf)
g.DrawString(EintragB, FontRegular, Brushes.Black, x2Pos, y _
* (i + 1), sf)
g.DrawString(EintragC, FontBold, Brushes.Black, x + 135, y _
* (i + 1) + minHöhe, sf)
g.DrawString(EintragD, FontRegular, Brushes.Black, x2Pos, y _
* (i + 1) + minHöhe, sf)
'Abschlusslinie
g.DrawLine(p1, 50, y * (i + 1) + img.Height + 12, 718, y * ( _
i + 1) + img.Height + 12)
Else
Dim bild As Bitmap = GetZoomImage(Image.FromFile(keinBild), _
New Size(120, 120), _
Drawing2D.InterpolationMode.HighQualityBicubic)
Dim r As New Rectangle(50, y * (i + 1), bild.Width + 3, _
bild.Height + 3)
g.DrawImage(bild, 50, y * (i + 1))
g.DrawRectangle(pen_big, r)
g.DrawString("kein Beleg: " & Stempel, New Font("arial", _
8), Brushes.Black, New Point(50, y * (i + 1) + _
bild.Height + 14))
g.DrawString(EintragA, FontBold, Brushes.Black, x + 135, y _
* (i + 1), sf)
g.DrawString(EintragB, FontRegular, Brushes.Black, x2Pos, y _
* (i + 1), sf)
g.DrawString(EintragC, FontBold, Brushes.Black, x + 135, y _
* (i + 1) + minHöhe, sf)
g.DrawString(EintragD, FontRegular, Brushes.Black, x2Pos, y _
* (i + 1) + minHöhe, sf)
'Abschlusslinie
g.DrawLine(p1, 50, y * (i + 1) + bild.Height + 12, 718, y * _
(i + 1) + bild.Height + 12)
End If
Next i
Catch ex As Exception
End Try |  |
Re: Formular erstellen bzw. drucken | |  | Autor: Erichbru | Datum: 30.04.23 12:24 |
| Hallo bitte
ich glaube ich check das irgendwie nicht
so bekomme ich nur eine 2te leere Seite ? die erste wird abgeschnitten
'Beg: Druckbereich
Dim Druckbereich = g.VisibleClipBounds
Dim margin = Me.PD_Strombeleg.DefaultPageSettings.Margins
Druckbereich.Offset(margin.Left, margin.Top) ' obere linke Ecke
Druckbereich.Width -= (margin.Left + margin.Right) ' neue Breite
Druckbereich.Height -= (margin.Top + margin.Bottom) ' neue Höhe
Dim x, y As Single
x = Druckbereich.Left
y = Druckbereich.Top
Select Case DruckSeite
Case 1
'Titel & Text:
Titel_Text_Block_Strom(g, Druckbereich)
If Druckbereich.Height < e.MarginBounds.Bottom Then
e.HasMorePages = True
y += 30
DruckSeite += 1
Else
e.HasMorePages = False
DruckSeite = 0
End If
End Select
e.Graphics.Dispose()
g.Dispose()
Beitrag wurde zuletzt am 30.04.23 um 12:28:37 editiert. |  |
Re: Formular erstellen bzw. drucken | |  | Autor: Erichbru | Datum: 07.05.23 12:11 |
| Neuer Versuch eure Gunst zu gewinnen
so passt es in den angelegten Druckbereich:
ich drucke mehr Seiten aber nicht wirklich, d.h. so erhöhe ich nur die Seitenanzahl ist ja nicht im Sinne des Erfinders möchte ja korrekt etwas auf die neue Seite drucken was eben auf Seite eins nicht passt.
hier die Druckroutine
wer hilft mir da noch mal ?
Private Sub PD_Strombeleg_PrintPage(ByVal sender As Object, ByVal e As _
PrintPageEventArgs) Handles PD_Strombeleg.PrintPage
Dim g As Graphics = e.Graphics
DruckSeite += 1
Hier fehlt einiges aufgrund der erlaubten 5KB Text größe
'Titel & Druckdatum & Seite
'Daten holen aus Datatable
For i As Integer = 0 To HBDatenbankDS.tblStrom.Rows.Count - 1
Dim row As DataRow = HBDatenbankDS.tblStrom.Rows(i)
Dim bildpfad As String = row("Pfad").ToString
' Größe für ein Bild
Dim imageBounds As New Size(e.MarginBounds.Width \ 4, _
e.MarginBounds.Height \ 7)
'mit imageBounds so bekomme ich 5 Bilder (Belege) auf die
' Druckseite 1 (Druckbereich)
'Rectangel festlegen
Dim bounds As New Rectangle(BelegLocation.X, BelegLocation.Y, _
imageBounds.Width, imageBounds.Height)
Dim rectA = New Rectangle(BelegLocation.X + 200, txtALocation.Y, _
minSize.Width, minSize.Height)
Dim rectB = New Rectangle(BelegLocation.X + 300, txtBLocation.Y, _
minSize.Width, minSize.Height)
Dim rectC = New Rectangle(BelegLocation.X + 400, txtCLocation.Y, _
minSize.Width, minSize.Height)
Dim rectD = New Rectangle(BelegLocation.X + 500, txtCLocation.Y, _
minSize.Width, minSize.Height)
'Bildpfad prüfen
If IsBildPfad(bildpfad) = True Then
Dim img As Bitmap = GetZoomImage(Image.FromFile(bildpfad), New _
Size(imageBounds), InterpolationMode.HighQualityBicubic)
e.Graphics.DrawString("Belegnummer-N.N." & Format(i, _
"000000000000"), textFont, Brushes.Blue, bounds, textFormat)
'e.Graphics.DrawImage(img, bounds) 'passt sauber ins Rect
BelegLocation.Y += imageBounds.Height + height
e.Graphics.DrawRectangle(pen_gray, bounds) 'nur für Testzwecke
'txtA
txtALocation.Y += imageBounds.Height + height
e.Graphics.DrawString("SpalteA-" & Format(i, "0000"), textFont, _
Brushes.Blue, rectA, textFormat)
e.Graphics.DrawRectangle(pen_gray, rectA)
'----------------------------------------
'txtB
txtBLocation.Y += imageBounds.Height + height
e.Graphics.DrawString("SpalteB-" & Format(i, "0000"), textFont, _
Brushes.Blue, rectB, textFormat)
e.Graphics.DrawRectangle(pen_gray, rectB)
'----------------------------------------
'txtC
txtCLocation.Y += imageBounds.Height + height
e.Graphics.DrawString("SpalteC-" & Format(i, "0000"), textFont, _
Brushes.Blue, rectC, textFormat)
e.Graphics.DrawRectangle(pen_gray, rectC)
'----------------------------------------
'txtD
txtDLocation.Y += imageBounds.Height + height
e.Graphics.DrawString("SpalteD-" & Format(i, "0000"), textFont, _
Brushes.Blue, rectD, textFormat)
e.Graphics.DrawRectangle(pen_gray, rectD)
'----------------------------------------
'Trennlinie
g.DrawLine(p1, imageBounds.Width + 100, BelegLocation.Y - _
height, 718, BelegLocation.Y - height)
Else
Dim img As Bitmap = GetZoomImage(Image.FromFile(testBild), New _
Size(imageBounds), InterpolationMode.HighQualityBicubic)
'trifft zu wenn kein Beleg zugewiesen wurde (Pfad = leer)
e.Graphics.DrawString("kein Beleg-N.N." & Format(i, _
"000000000000"), textFont, Brushes.Blue, bounds, textFormat)
'e.Graphics.DrawImage(img, bounds) 'passt sauber ins Rect
BelegLocation.Y += imageBounds.Height + height
e.Graphics.DrawRectangle(pen_gray, bounds) 'nur für Testzwecke
'Trennlinie
g.DrawLine(p1, imageBounds.Width + 100, BelegLocation.Y - _
height, 718, BelegLocation.Y - height)
End If
Next
If rect_Druckbereich.Height < BelegLocation.Y Then
e.HasMorePages = True
PosY += 30
DruckSeite += 1
Else
e.HasMorePages = False
DruckSeite = 0
End If
textFont.Dispose()
textFormat.Dispose()
End Sub |  |
Re: Formular erstellen bzw. drucken | |  | Autor: Erichbru | Datum: 22.05.23 19:52 |
| Thema erledigt, habe es dann doch noch hinbekommen.
Danke für die Zahlreiche Hilfe hier im Forum.
den code kann ich hier nicht reinstellen, da zu groß.
hier mal das Endergebnis mit Testdaten und "Test-Belegen"
evtl. meldet sich doch noch mal jemand |  |
 | Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
  |
|
vb@rchiv CD Vol.6 vb@rchiv Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion Entwickler-Vollversionen u.v.m.Jetzt zugreifen Tipp des Monats Juni 2023 Dieter OtterPopUp-Menü wird nicht angezeigt :-(In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. Neu! sevCoolbar 3.0 
Professionelle Toolbars im modernen Design!
Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Weitere Infos
|