R
ron_xin
Unregistered / Unconfirmed
GUEST, unregistred user!
//VB调用labelview标签软件进行打印的实例
//VB源码地址 http://www.winfuture.net/Downloading/VB6LVSAMPLE.zip
Public Function FieldTypeString(fldtype As Integer) As String
FieldTypeString = ""
Select Case fldtype
Case 0
FieldTypeString = "FIXED"
Case 1
FieldTypeString = "WHENPRINTED"
Case 2
FieldTypeString = "LINK"
Case 3
FieldTypeString = "DATABASE"
Case 4
FieldTypeString = "DATESTAMP"
Case 5
FieldTypeString = "TIMESTAMP"
Case 6
FieldTypeString = "SERIAL"
Case 7
FieldTypeString = "ODBC"
Case 8
FieldTypeString = "COMWATCH"
Case 9
FieldTypeString = "ACCUMULATOR"
Case 10
FieldTypeString = "PICKLIST"
End Select
End Function
Public Sub GetLabelData()
Dim count As Integer
Dim PrtName As String
Set LblFlds = Lbl.LabelFields 'collection
If LblFlds Is Nothing Then
Beep
MsgBox "Can not create LabelFields collection."
Exit Sub
End If
count = LblFlds.count
stCount.Caption = CStr(count)
stWidth.Caption = CStr(Lbl.LabelWidth)
stHeight.Caption = CStr(Lbl.lABELHeight)
Set LblPrt = Lbl.LabelPrinter
PrtName = LblPrt.Name
PrinterCB.Text = PrtName
LblPrt.GetAllSpeed Combo1.hWnd, 0
LblPrt.GetAllTemp Combo2.hWnd, 0
If count = 0 Then
Set LblFlds = Nothing
DataGrid1.Rows = 1
Exit Sub
End If
DataGrid1.Rows = count + 1
i = 0
For Each LblFld In LblFlds
DataGrid1.Row = i + 1
DataGrid1.Col = 0
DataGrid1.Text = LblFld.Name
DataGrid1.Col = 1
DataGrid1.Text = LblFld.Value
DataGrid1.Col = 2
DataGrid1.Text = FieldTypeString(LblFld.DataSource)
Set LblFld = Nothing
i = i + 1
Next LblFld
Set LblFlds = Nothing
End Sub
Private Sub btnBrowse_Click()
If Lbl Is Nothing Then
Set Lbl = CreateObject("Lblvw.Document"
If logged = False Then
logged = Lbl.LogonWindow
End If
End If
Dim lblname As String
lblname = Lbl.BrowseLabel
txtLabelName.Text = lblname
GetLabelData
End Sub
Private Sub btnLoad_Click()
If txtLabelName.Text = "" Then
Beep
Exit Sub
End If
If Lbl Is Nothing Then
Set Lbl = CreateObject("Lblvw.Document"
If logged = False Then
logged = Lbl.LogonWindow
End If
End If
Dim RetV As Boolean
RetV = Lbl.Open(txtLabelName.Text)
If Not RetV Then
MsgBox "Error loading label" & txtLabelName.Text
Exit Sub
End If
GetLabelData
End Sub
Private Sub btnPrint_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be laoded"
Else
Dim count As Integer
count = DataGrid1.Rows - 1
Set LblFlds = Lbl.LabelFields
For i = 0 To count - 1
Set LblFld = LblFlds(i)
DataGrid1.Row = i + 1
DataGrid1.Col = 1
LblFld.Value = DataGrid1.Text
Set LblFld = Nothing
Next i
Set LblFlds = Nothing
LblPrt.Speed = Combo1.ListIndex
LblPrt.Temp = CInt(Combo2.Text)
Lbl.PrintLabel (1)
End If
End Sub
Private Sub btnShow_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be loaded."
Exit Sub
ElseIf Lbl.Visible = True Then
Lbl.Visible = False
btnShow.Caption = "Show LabelView"
Else
Lbl.Visible = True
btnShow.Caption = "Hide LabelView"
End If
End Sub
Private Sub Command1_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be loaded."
Else
Lbl.LabelSetup
LblPrt.GetAllSpeed Combo1.hWnd, 0
LblPrt.GetAllTemp Combo2.hWnd, 0
End If
End Sub
Private Sub Command2_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be open before Previewing"
Else
Preview.Show
End If
End Sub
Private Sub Command3_Click()
If LblApp Is Nothing Then
Set LblApp = CreateObject("Lblvw.Application"
End If
LblApp.AddPrinter
Dim Pr As Printer
Dim Prname As String
PrinterCB.Clear
For Each Pr In Printers
Prname = Pr.DeviceName
PrinterCB.AddItem Prname
Next
PrinterCB.Text = PrinterCB.List(0)
PrinterCB.ListIndex = 0
End Sub
Private Sub Command4_Click()
If LblApp Is Nothing Then
Set LblApp = CreateObject("Lblvw.Application"
End If
Dim bLogonOK As Boolean
bLogonOK = LblApp.LogonWindow
If Not bLogonOK Then
End If
End Sub
Private Sub Command5_Click()
'errored here**************
ErrMsg.Caption = Lbl.LastError
End Sub
Private Sub DataGrid1_DblClick()
If DataGrid1.Col < 1 Then
Exit Sub
End If
If DataGrid1.Row = 0 Then
Exit Sub
End If
Dim cellValue As String
cellValue = DataGrid1.Text
If DataGrid1.Col = 1 Then
cellValue = InputBox("Field Value", "Enter Value", cellValue)
If cellValue <> "" Then
DataGrid1.Text = cellValue
End If
ElseIf DataGrid1.Col = 2 Then
If cellValue = "DATABASE" Or cellValue = "PICKLIST" Then
Set LblFld = Lbl.LabelFields.Item(DataGrid1.Row - 1)
If LblFld Is Nothing Then
MsgBox "Can not create field object"
Else
If cellValue = "DATABASE" Then
LblFld.BatchPrintWindow
Else
LblFld.PickListWindow
End If
DataGrid1.Col = 1
DataGrid1.Text = LblFld.Value
Set LblFld = Nothing
End If
End If
End If
End Sub
Private Sub Form_Load()
Set LblApp = Nothing
Set Lbl = Nothing
Set LblPrt = Nothing
Set LblFld = Nothing
Set LblFlds = Nothing
logged = False
Dim Pr As Printer
Dim Prname As String
PrinterCB.Clear
For Each Pr In Printers
Prname = Pr.DeviceName
PrinterCB.AddItem Prname
Next
PrinterCB.Text = PrinterCB.List(0)
PrinterCB.ListIndex = 0
DataGrid1.Rows = 3
DataGrid1.Cols = 3
DataGrid1.ColWidth(0) = 2000
DataGrid1.ColWidth(1) = 2600
DataGrid1.ColWidth(2) = 2000
DataGrid1.ColAlignment(0) = flexAlignLeftCenter
DataGrid1.ColAlignment(1) = flexAlignLeftCenter
DataGrid1.ColAlignment(2) = flexAlignLeftCenter
DataGrid1.Row = 0
DataGrid1.Col = 0
DataGrid1.Text = "Field Name"
DataGrid1.Col = 1
DataGrid1.Text = "Field Value"
DataGrid1.Col = 2
DataGrid1.Text = "Field Type"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set LblApp = Nothing
Set Lbl = Nothing
Set LblPrt = Nothing
Set LblFld = Nothing
Set LblFlds = Nothing
End Sub
//VB源码地址 http://www.winfuture.net/Downloading/VB6LVSAMPLE.zip
Public Function FieldTypeString(fldtype As Integer) As String
FieldTypeString = ""
Select Case fldtype
Case 0
FieldTypeString = "FIXED"
Case 1
FieldTypeString = "WHENPRINTED"
Case 2
FieldTypeString = "LINK"
Case 3
FieldTypeString = "DATABASE"
Case 4
FieldTypeString = "DATESTAMP"
Case 5
FieldTypeString = "TIMESTAMP"
Case 6
FieldTypeString = "SERIAL"
Case 7
FieldTypeString = "ODBC"
Case 8
FieldTypeString = "COMWATCH"
Case 9
FieldTypeString = "ACCUMULATOR"
Case 10
FieldTypeString = "PICKLIST"
End Select
End Function
Public Sub GetLabelData()
Dim count As Integer
Dim PrtName As String
Set LblFlds = Lbl.LabelFields 'collection
If LblFlds Is Nothing Then
Beep
MsgBox "Can not create LabelFields collection."
Exit Sub
End If
count = LblFlds.count
stCount.Caption = CStr(count)
stWidth.Caption = CStr(Lbl.LabelWidth)
stHeight.Caption = CStr(Lbl.lABELHeight)
Set LblPrt = Lbl.LabelPrinter
PrtName = LblPrt.Name
PrinterCB.Text = PrtName
LblPrt.GetAllSpeed Combo1.hWnd, 0
LblPrt.GetAllTemp Combo2.hWnd, 0
If count = 0 Then
Set LblFlds = Nothing
DataGrid1.Rows = 1
Exit Sub
End If
DataGrid1.Rows = count + 1
i = 0
For Each LblFld In LblFlds
DataGrid1.Row = i + 1
DataGrid1.Col = 0
DataGrid1.Text = LblFld.Name
DataGrid1.Col = 1
DataGrid1.Text = LblFld.Value
DataGrid1.Col = 2
DataGrid1.Text = FieldTypeString(LblFld.DataSource)
Set LblFld = Nothing
i = i + 1
Next LblFld
Set LblFlds = Nothing
End Sub
Private Sub btnBrowse_Click()
If Lbl Is Nothing Then
Set Lbl = CreateObject("Lblvw.Document"
If logged = False Then
logged = Lbl.LogonWindow
End If
End If
Dim lblname As String
lblname = Lbl.BrowseLabel
txtLabelName.Text = lblname
GetLabelData
End Sub
Private Sub btnLoad_Click()
If txtLabelName.Text = "" Then
Beep
Exit Sub
End If
If Lbl Is Nothing Then
Set Lbl = CreateObject("Lblvw.Document"
If logged = False Then
logged = Lbl.LogonWindow
End If
End If
Dim RetV As Boolean
RetV = Lbl.Open(txtLabelName.Text)
If Not RetV Then
MsgBox "Error loading label" & txtLabelName.Text
Exit Sub
End If
GetLabelData
End Sub
Private Sub btnPrint_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be laoded"
Else
Dim count As Integer
count = DataGrid1.Rows - 1
Set LblFlds = Lbl.LabelFields
For i = 0 To count - 1
Set LblFld = LblFlds(i)
DataGrid1.Row = i + 1
DataGrid1.Col = 1
LblFld.Value = DataGrid1.Text
Set LblFld = Nothing
Next i
Set LblFlds = Nothing
LblPrt.Speed = Combo1.ListIndex
LblPrt.Temp = CInt(Combo2.Text)
Lbl.PrintLabel (1)
End If
End Sub
Private Sub btnShow_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be loaded."
Exit Sub
ElseIf Lbl.Visible = True Then
Lbl.Visible = False
btnShow.Caption = "Show LabelView"
Else
Lbl.Visible = True
btnShow.Caption = "Hide LabelView"
End If
End Sub
Private Sub Command1_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be loaded."
Else
Lbl.LabelSetup
LblPrt.GetAllSpeed Combo1.hWnd, 0
LblPrt.GetAllTemp Combo2.hWnd, 0
End If
End Sub
Private Sub Command2_Click()
If txtLabelName.Text = "" Then
MsgBox ("A label must be open before Previewing"
Else
Preview.Show
End If
End Sub
Private Sub Command3_Click()
If LblApp Is Nothing Then
Set LblApp = CreateObject("Lblvw.Application"
End If
LblApp.AddPrinter
Dim Pr As Printer
Dim Prname As String
PrinterCB.Clear
For Each Pr In Printers
Prname = Pr.DeviceName
PrinterCB.AddItem Prname
Next
PrinterCB.Text = PrinterCB.List(0)
PrinterCB.ListIndex = 0
End Sub
Private Sub Command4_Click()
If LblApp Is Nothing Then
Set LblApp = CreateObject("Lblvw.Application"
End If
Dim bLogonOK As Boolean
bLogonOK = LblApp.LogonWindow
If Not bLogonOK Then
End If
End Sub
Private Sub Command5_Click()
'errored here**************
ErrMsg.Caption = Lbl.LastError
End Sub
Private Sub DataGrid1_DblClick()
If DataGrid1.Col < 1 Then
Exit Sub
End If
If DataGrid1.Row = 0 Then
Exit Sub
End If
Dim cellValue As String
cellValue = DataGrid1.Text
If DataGrid1.Col = 1 Then
cellValue = InputBox("Field Value", "Enter Value", cellValue)
If cellValue <> "" Then
DataGrid1.Text = cellValue
End If
ElseIf DataGrid1.Col = 2 Then
If cellValue = "DATABASE" Or cellValue = "PICKLIST" Then
Set LblFld = Lbl.LabelFields.Item(DataGrid1.Row - 1)
If LblFld Is Nothing Then
MsgBox "Can not create field object"
Else
If cellValue = "DATABASE" Then
LblFld.BatchPrintWindow
Else
LblFld.PickListWindow
End If
DataGrid1.Col = 1
DataGrid1.Text = LblFld.Value
Set LblFld = Nothing
End If
End If
End If
End Sub
Private Sub Form_Load()
Set LblApp = Nothing
Set Lbl = Nothing
Set LblPrt = Nothing
Set LblFld = Nothing
Set LblFlds = Nothing
logged = False
Dim Pr As Printer
Dim Prname As String
PrinterCB.Clear
For Each Pr In Printers
Prname = Pr.DeviceName
PrinterCB.AddItem Prname
Next
PrinterCB.Text = PrinterCB.List(0)
PrinterCB.ListIndex = 0
DataGrid1.Rows = 3
DataGrid1.Cols = 3
DataGrid1.ColWidth(0) = 2000
DataGrid1.ColWidth(1) = 2600
DataGrid1.ColWidth(2) = 2000
DataGrid1.ColAlignment(0) = flexAlignLeftCenter
DataGrid1.ColAlignment(1) = flexAlignLeftCenter
DataGrid1.ColAlignment(2) = flexAlignLeftCenter
DataGrid1.Row = 0
DataGrid1.Col = 0
DataGrid1.Text = "Field Name"
DataGrid1.Col = 1
DataGrid1.Text = "Field Value"
DataGrid1.Col = 2
DataGrid1.Text = "Field Type"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set LblApp = Nothing
Set Lbl = Nothing
Set LblPrt = Nothing
Set LblFld = Nothing
Set LblFlds = Nothing
End Sub