Imports System.Data Imports System.Data.SqlTypes Imports System.Data.SqlClient Imports System.ComponentModel Imports System.Drawing Imports System.Drawing.Color Imports System.IO Imports System.Threading Imports System.Windows.Forms Public Class frmSA Dim Partnernr As String Dim PartnerKurzbezeichnung As String Dim Packagegroesse As String Dim DelayTime As String Private Sub BeendenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Me.Close() End Sub Private Function Generic_Select() As DataTable Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim dbconn As New SqlConnection(Globals.sConnectionString) scmCmdToExecute.Connection = dbconn scmCmdToExecute.CommandText = "sp_selbstanzeigen" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim jvon As DateTime Dim jbis As DateTime jvon = Me.Dtvon.Value jbis = Me.DTBis.Value 'If Trim(Me.txtJahrvon.Text) = "" Then jvon = 0 Else jvon = Me.txtJahrvon.Text 'If Trim(Me.txtJahrbis.Text) = "" Then jbis = 0 Else jbis = Me.txtJahrbis.Text scmCmdToExecute.Parameters.Add(New SqlParameter("@bpnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.txtBPNr.Text)) scmCmdToExecute.Parameters.Add(New SqlParameter("@dvon", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, jvon)) scmCmdToExecute.Parameters.Add(New SqlParameter("@dbis", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, jbis)) scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try sdaAdapter.Fill(dtToReturn) Return dtToReturn Catch ex As Exception Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Try Dim dt As New DataTable dt = Generic_Select() Me.DokList.DataSource = Nothing Me.DokList.DataSource = dt Me.DokList.DataMember = dt.TableName Me.Button2.Enabled = True Catch ex As Exception MsgBox(ex.Message) Me.Button2.Enabled = False End Try End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Partnernr = Me.txtBPNr.Text PartnerKurzbezeichnung = Me.Label5.Text Dim gendokCold As New Collection() Dim gendokOffice As New Collection Dim i As Integer Dim colRows As C1.Win.C1TrueDBGrid.SelectedRowCollection colRows = Me.DokList.SelectedRows If colRows.Count = 0 Then For i = 0 To Me.DokList.Splits(0).Rows.Count - 1 colRows.Add(i) Next End If 'Wenn mehr als ein Dokument selektiert ist dann Meldung zum Fragen anzeigen If colRows.Count > 1 Then If MsgBox("Alle markierten Dokumente (" + LTrim(Str(colRows.Count)) + ") drucken?", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub End If End If Me.Cursor = Cursors.WaitCursor Dim packagenr As Integer packagenr = CInt(Math.Truncate(colRows.Count / Packagegroesse)) packagenr = packagenr + 1 Dim f As New FrmDokMDSA_Fortschritt f.MdiParent = Me.MdiParent f.Show() f.ProgressBar1.Value = 0 f.ProgressBar1.Maximum = packagenr 'Loop über die Selektierten Dokumente und die Werte je nach Typ in eine Collection abspeichern Dim RowCunter As Integer = 0 For i = 0 To colRows.Count - 1 Try 'Host Daten abfüllen gendokCold.Add(New clsMehrfachdruck_Data(Me.DokList.Columns("dokumentid").CellValue(colRows(i)), _ Me.DokList.Columns("partnernr_inhaber").CellValue(colRows(i)), clsMehrfachdruck_Data.Enum_Typ.HOST, False, _ Me.DokList.Columns("dokumenttypnr").CellValue(colRows(i)), "", _ Me.DokList.Columns("partnername_inhaber").CellValue(colRows(i)), _ Me.DokList.Columns("valutadatum").CellValue(colRows(i)))) RowCunter = RowCunter + 1 Exit Try Catch ex As Exception End Try If RowCunter > Packagegroesse - 1 Then f.ProgressBar1.Value = f.ProgressBar1.Value + 1 f.Label5.Text = "Druckauftrag " + f.ProgressBar1.Value.ToString + " von " + f.ProgressBar1.Maximum.ToString f.Label5.Text = f.Label5.Text + " - " + DelayTime.ToString + " Sekunden Wartezeit" Application.DoEvents() f.Refresh() f.BringToFront() f.Refresh() RowCunter = 0 fMehrfachdruck.DruckAnfrage(gendokCold, gendokOffice) f.Refresh() Application.DoEvents() gendokCold.Clear() Application.DoEvents() f.Refresh() Dim t1 As DateTime Dim t2 As DateTime Threading.Thread.CurrentThread.Sleep(DelayTime * 1000) gendokCold.Clear() End If Next Try If gendokCold.Count > 0 Then fMehrfachdruck.DruckAnfrage(gendokCold, gendokOffice) Application.DoEvents() Catch ex As Exception Finally Me.Cursor = Cursors.Default End Try f.Close() f.Dispose() End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click Dim f As New FrmPartnersuche f.ShowDialog() If f.PartnerNr <> 0 Then Me.txtBPNr.Text = f.PartnerNr Update_BP() End If End Sub Private Sub txtBPNr_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles txtBPNr.KeyDown If e.KeyCode = Keys.Enter Then Update_BP() End If End Sub Private Sub txtBPNr_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtBPNr.Leave Update_BP() End Sub Private Sub Update_BP() Try If Me.txtBPNr.Text = "" Then Exit Sub Dim f As New FrmPartnersuche f.Partner_Suche(Me.txtBPNr.Text) If f.PartnerKurzbezeichnnung = "" Then MsgBox("Eingegebener Parter ist nicht vorhanden", MsgBoxStyle.Critical) Me.Label5.Text = "[Kein Partner ausgwählt]" Me.Button1.Enabled = False Me.Button2.Enabled = False Else Me.Label5.Text = f.PartnerKurzbezeichnnung Me.Button1.Enabled = True Me.Button2.Enabled = False End If Catch End Try End Sub Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click Me.Close() End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Packagegroesse = DivFnkt.Get_Office_2010_Param(33) Me.DelayTime = DivFnkt.Get_Office_2010_Param(34) Me.Dtvon.Value = DivFnkt.Get_Office_2010_Param(35) Me.DTBis.Value = DivFnkt.Get_Office_2010_Param(36) End Sub Private Sub txtBPNr_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtBPNr.TextChanged End Sub End Class