You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
310 lines
9.7 KiB
310 lines
9.7 KiB
Imports System.Drawing.Printing
|
|
Imports System.Windows.Forms
|
|
Imports Microsoft.VisualBasic.PowerPacks.Printing.Compatibility.VB6
|
|
Imports System.IO
|
|
Imports System.Data
|
|
Public Class frmPrinterSettings
|
|
|
|
Dim LogoTray As Integer = 0
|
|
Dim NormalTray As Integer = 0
|
|
Dim ManualTray As Integer = 0
|
|
Dim EnvelopeTray As Integer = 0
|
|
Dim Filepath As String = ""
|
|
Dim OnInit As Boolean = True
|
|
|
|
|
|
Sub New(ByRef a_wdapp As Object, ByVal params As String)
|
|
InitializeComponent()
|
|
Me.Filepath = params
|
|
|
|
End Sub
|
|
|
|
Private Sub frmPrinterSettings_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
|
|
Dim Selindex As Integer = 0
|
|
Dim i As Integer = 0
|
|
For Each p As String In PrinterSettings.InstalledPrinters
|
|
Dim tn As New treenode
|
|
tn.Text = p
|
|
tn.ImageIndex = 1
|
|
tn.SelectedImageIndex = 1
|
|
tn.StateImageIndex = 1
|
|
|
|
'20170711 - SHU
|
|
Dim ConfigFilename As String
|
|
ConfigFilename = Get_ConfigFilename(p)
|
|
|
|
'If File.Exists(Filepath + "\" + p.Replace("\", "@") + ".cfg") Then
|
|
If File.Exists(Filepath + "\" + ConfigFilename) Then
|
|
tn.ImageIndex = 0
|
|
tn.SelectedImageIndex = 0
|
|
tn.StateImageIndex = 0
|
|
End If
|
|
Me.tvPrinters.Nodes.Add(tn)
|
|
Me.tvPrinters.SelectedNode = tvPrinters.Nodes(i)
|
|
i = i + 1
|
|
Next
|
|
Me.SortNodes(Me.tvPrinters.Nodes)
|
|
Me.tvPrinters.Nodes.Find(DefaultPrinterName, True)
|
|
|
|
Me.OnInit = False
|
|
For Each t As TreeNode In Me.tvPrinters.Nodes
|
|
If t.Text = DefaultPrinterName() Then Me.tvPrinters.SelectedNode = t
|
|
Next
|
|
Me.tvPrinters.Focus()
|
|
End Sub
|
|
|
|
Public Sub SortNodes(ByVal NodesCollection As System.Windows.Forms.TreeNodeCollection, _
|
|
Optional ByVal Ascending As Boolean = True)
|
|
Dim node1, node2 As System.Windows.Forms.TreeNode
|
|
Dim iTn1, iTn2 As Integer
|
|
Dim k As Integer
|
|
Dim iCompareResult As Integer
|
|
|
|
' Alle Knoten durchwandern
|
|
For i As Integer = 0 To NodesCollection.Count
|
|
|
|
k = NodesCollection.Count
|
|
|
|
Do While k > i
|
|
|
|
k -= 1
|
|
|
|
' Je zwei Nodes ermitteln und Texte vergleichen
|
|
node1 = NodesCollection(i)
|
|
node2 = NodesCollection(k)
|
|
Console.WriteLine(node1.Text & ", " & node2.Text)
|
|
iCompareResult = node1.Text.CompareTo(node2.Text)
|
|
|
|
' Falls die Sortierung nicht dem übergebenen Sortierkriterium entspricht:
|
|
If (Ascending = True And iCompareResult > 0) _
|
|
OrElse _
|
|
(Ascending = False And iCompareResult < 0) Then
|
|
|
|
' Nodes austauschen
|
|
With NodesCollection
|
|
.Remove(node1)
|
|
.Remove(node2)
|
|
.Insert(i, node2)
|
|
.Insert(k, node1)
|
|
End With
|
|
|
|
End If
|
|
|
|
Loop
|
|
|
|
Next
|
|
|
|
End Sub
|
|
|
|
Public Shared Function DefaultPrinterName() As String
|
|
Dim oPS As New System.Drawing.Printing.PrinterSettings
|
|
Try
|
|
DefaultPrinterName = oPS.PrinterName
|
|
Catch ex As System.Exception
|
|
DefaultPrinterName = ""
|
|
Finally
|
|
oPS = Nothing
|
|
End Try
|
|
End Function
|
|
|
|
|
|
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
|
|
LogoTray = Me.lblLogoTray.SelectedValue
|
|
NormalTray = Me.lblNormalTray.SelectedValue
|
|
ManualTray = Me.lblManualTray.SelectedValue
|
|
EnvelopeTray = Me.lblEnvelopeTray.SelectedValue
|
|
SaveSettings()
|
|
Me.tvPrinters.SelectedNode.ImageIndex = 0
|
|
Me.tvPrinters.SelectedNode.SelectedImageIndex = 0
|
|
Me.tvPrinters.SelectedNode.StateImageIndex = 0
|
|
Exit Sub
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub SaveSettings()
|
|
If Not System.IO.Directory.Exists(Filepath) Then Me.Create_Folders(Filepath)
|
|
'20170724
|
|
Dim ConfigFilename As String = ""
|
|
ConfigFilename = Get_ConfigFilename(Me.tvPrinters.SelectedNode.Text)
|
|
FileOpen(1, Filepath + "\" + ConfigFilename, OpenMode.Output)
|
|
'FileOpen(1, Filepath + "\" + Me.tvPrinters.SelectedNode.Text.Replace("\", "@") + ".cfg", OpenMode.Output)
|
|
'20170724-Ende
|
|
WriteLine(1, LogoTray)
|
|
WriteLine(1, NormalTray)
|
|
WriteLine(1, ManualTray)
|
|
WriteLine(1, EnvelopeTray)
|
|
FileClose(1)
|
|
End Sub
|
|
|
|
Private Function Get_ConfigFilename(ByVal pname As String) As String
|
|
Dim i As Integer
|
|
|
|
Dim cfilename As String = pname.Replace("\", "@") + ".cfg"
|
|
If Microsoft.VisualBasic.Left(cfilename, 2) <> "@@" Then
|
|
cfilename = pname
|
|
i = cfilename.IndexOf("(")
|
|
If i > 0 Then
|
|
cfilename = cfilename.Substring(0, i - 1) + ".cfg"
|
|
|
|
End If
|
|
|
|
End If
|
|
|
|
Return cfilename
|
|
End Function
|
|
|
|
|
|
|
|
Private Sub tvPrinters_AfterSelect(sender As System.Object, e As System.Windows.Forms.TreeViewEventArgs) Handles tvPrinters.AfterSelect
|
|
If OnInit = True Then Exit Sub
|
|
Dim s As String
|
|
Dim i As Integer = 0
|
|
PopulatePrinterTray(Me.tvPrinters.SelectedNode.Text)
|
|
If System.IO.File.Exists(Filepath + "\" + Me.tvPrinters.SelectedNode.Text.Replace("\", "@") + ".cfg") Then
|
|
FileOpen(1, Filepath + "\" + Me.tvPrinters.SelectedNode.Text.Replace("\", "@") + ".cfg", OpenMode.Input)
|
|
While Not EOF(1)
|
|
i = i + 1
|
|
Input(1, s)
|
|
Select Case i
|
|
Case 1
|
|
Me.lblLogoTray.SelectedValue = s
|
|
Case 2
|
|
Me.lblNormalTray.SelectedValue = s
|
|
Case 3
|
|
Me.lblManualTray.SelectedValue = s
|
|
Case 4
|
|
Me.lblEnvelopeTray.SelectedValue = s
|
|
End Select
|
|
End While
|
|
FileClose(1)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
|
|
Me.Close()
|
|
End Sub
|
|
|
|
Dim dt As New System.Data.DataTable
|
|
Dim dt2 As New System.Data.DataTable
|
|
Dim dt3 As New System.Data.DataTable
|
|
Dim dt4 As New System.Data.DataTable
|
|
|
|
Private Sub PopulatePrinterTray(ByRef Printer As String)
|
|
dt.Rows.Clear()
|
|
dt.Columns.Clear()
|
|
dt.Columns.Add("RawKind")
|
|
dt.Columns.Add("Sourcename")
|
|
Dim pkSource As System.Drawing.Printing.PaperSource
|
|
Dim printDoc As New System.Drawing.Printing.PrintDocument
|
|
printDoc.PrinterSettings.PrinterName = Printer
|
|
For Each pkSource In printDoc.PrinterSettings.PaperSources
|
|
Dim dr As DataRow
|
|
dr = dt.NewRow
|
|
dr.Item(0) = pkSource.RawKind
|
|
dr.Item(1) = pkSource.SourceName
|
|
dt.Rows.Add(dr)
|
|
Next
|
|
dt2 = dt.Copy
|
|
dt3 = dt.Copy
|
|
dt4 = dt.Copy
|
|
Me.lblLogoTray.DataSource = dt
|
|
Me.lblLogoTray.ValueMember = "RawKind"
|
|
Me.lblLogoTray.DisplayMember = "Sourcename"
|
|
|
|
Me.lblEnvelopeTray.DataSource = dt2
|
|
Me.lblEnvelopeTray.ValueMember = "RawKind"
|
|
Me.lblEnvelopeTray.DisplayMember = "Sourcename"
|
|
|
|
Me.lblNormalTray.DataSource = dt3
|
|
Me.lblNormalTray.ValueMember = "RawKind"
|
|
Me.lblNormalTray.DisplayMember = "Sourcename"
|
|
|
|
Me.lblManualTray.DataSource = dt4
|
|
Me.lblManualTray.ValueMember = "RawKind"
|
|
Me.lblManualTray.DisplayMember = "Sourcename"
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Private Sub Label2_Click(sender As System.Object, e As System.EventArgs) Handles Label2.Click
|
|
|
|
End Sub
|
|
Private Sub Label3_Click(sender As System.Object, e As System.EventArgs) Handles Label3.Click
|
|
|
|
End Sub
|
|
|
|
Public Function Create_Folders(ByVal s As String) As Boolean
|
|
Dim xt(10) As String
|
|
Dim xti As Integer
|
|
Dim po As Integer
|
|
Dim x As String
|
|
Dim xti1 As Integer
|
|
Dim i As Long
|
|
po = InStr(s, "\")
|
|
xti = 0
|
|
While po <> 0
|
|
xt(xti) = Microsoft.VisualBasic.Left(s, po - 1)
|
|
xti = xti + 1
|
|
s = Microsoft.VisualBasic.Right(s, Len(s) - (po))
|
|
po = InStr(s, "\")
|
|
End While
|
|
xt(xti) = s
|
|
For xti1 = 0 To xti
|
|
If x <> "" Then x = x & "\"
|
|
x = x & xt(xti1)
|
|
If Not FolderExist(x) Then Create_Folder(x)
|
|
Next
|
|
Create_Folders = True
|
|
End Function
|
|
|
|
Public Function Create_Folder(ByVal dn As String) As Boolean
|
|
Try
|
|
System.IO.Directory.CreateDirectory(dn)
|
|
Catch
|
|
Create_Folder = False
|
|
End Try
|
|
End Function
|
|
|
|
Public Function FolderExist(ByVal dn As String) As Boolean
|
|
Try
|
|
If System.IO.Directory.Exists(dn) Then FolderExist = True Else FolderExist = False
|
|
Catch
|
|
FolderExist = False
|
|
End Try
|
|
End Function
|
|
|
|
Public Function Set_Printer_To_Color() As Boolean
|
|
|
|
Dim pr As New Printer
|
|
Dim ps As New PrinterSettings
|
|
|
|
If ps.SupportsColor = True Then
|
|
pr.ColorMode = vbPRCMColor
|
|
'Else
|
|
'pr.ColorMode = vbPRCMMonochrome
|
|
End If
|
|
pr = Nothing
|
|
ps = Nothing
|
|
|
|
End Function
|
|
|
|
Public Function Set_Printer_To_BW() As Boolean
|
|
|
|
Dim pr As New Printer
|
|
Dim ps As New PrinterSettings
|
|
|
|
If ps.SupportsColor = True Then
|
|
pr.ColorMode = vbPRCMMonochrome
|
|
'Else
|
|
' pr.ColorMode = vbPRCMMonochrome
|
|
End If
|
|
pr = Nothing
|
|
ps = Nothing
|
|
|
|
End Function
|
|
End Class
|