VB翻译成DELPHI(200分)

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
 
我只需要
GetLabelData()
btnBrowse_Click()
btnPrint_Click() 就可以满足我的要求`~
 
我基本上已经写出来了~~~还有一些不明白的地方
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

VB的,For Each LblFld In LblFlds 看不懂什么意思`~类似于DELPHI的什么呀`~?
 
For Each LblFld In LblFlds的意思是:循环LblFlds中的每个元素,每次调用的时候将值赋给变量LblFld
For Each Pr In Printers的意思是:循环打印机的集合Printers中的每个打印机元素,每次调用的时候将值赋给变量Pr
一般这样写:
for i:=0 to LblFlds.count-1 do begin
LblFld:=LblFlds;
...
end;
 
多人接受答案了。
 

Similar threads

I
回复
0
查看
600
import
I
I
回复
0
查看
703
import
I
I
回复
0
查看
600
import
I
I
回复
0
查看
777
import
I
顶部