Dim jgdr As DataRow = DataTables("机构").Find("","")
Dim jg As String
If jgdr IsNot Nothing Then
jg = jgdr("公司名称")
End If
Dim rm As New prt.RenderImage() '定义一个图片对象
Dim che1 As WinForm.CheckBox = e.Form.Controls("CheckBox1")
Dim st0 As String = e.Form.Controls("ComboBox1").Value
Dim st1 As String = e.Form.Controls("ComboBox2").Value
Dim cmb0 As String = e.Form.Controls("ComboBox6").Value
Dim dr1 As DataRow
Dim i As Integer
Dim ii As Integer
Dim dr As DataRow = DataTables("项目跟踪").find("客户名称 = '" & st0 & "' and 任务编号 = '" & st1 & "'")
Dim dr0 As DataRow = DataTables("样品登记").find("客户名称 = '" & st0 & "' and 任务编号 = '" & st1 & "'")
Dim cmbs As DataRow = DataTables("样品登记").find("[客户名称] = '" & st0 & "' and [任务编号] = '" & st1 & "' And [任务序号] = '" & cmb0 & "' And [样品接收日期] is not null")
Dim cmb As String = DataTables("样品登记").GetComboListString("样品接收日期","[客户名称] = '" & st0 & "' and [任务编号] = '" & st1 & "' And [任务序号] = '" & cmb0 & "' And [样品接收日期] is not null")
If cmbs Is Nothing Then
MessageBox.Show("该任务下没有任何样品或还未登记采样时间!!","提示")
Else
Dim doc As New PrintDoc '定义一个报表
' If dr0 IsNot Nothing AndAlso dr IsNot Nothing AndAlso (dr.IsNull("调查提交人") = False OrElse dr("不需要调查") = True) Then
If dr0 IsNot Nothing AndAlso dr IsNot Nothing Then
doc = New PrintDoc '定义一个报表
doc.PageSetting.PaperKind = 9 '纸张类型
doc.PageSetting.Landscape = False '横向打印
Doc.PageSetting.LeftMargin = 10 '设置左边距
Doc.PageSetting.RightMargin = 10 '设置右边距
Doc.PageSetting.TopMargin = 10 '设置上边距
Doc.PageSetting.BottomMargin = 10 '设置下边距
For Each da01 As Date In cmb.Split("|")
Dim da0 As Date = da01.Date
Dim ra As New prt.RenderArea '定义一个容器
Dim rt As New prt.RenderTable() '定义一个表格对象
Dim rtt As new prt.RenderText '定义一个文本对象
'设置页眉
rtt.Text = jg & " T-ETS-429" '设置文本内容
rtt.Style.TextAlignHorz = prt.AlignHorzEnum.Right '靠右对齐
rtt.Style.FontSize = 10 '字体大小为8磅
Doc.PageHeader = rtt '作为页眉使用
rtt = new prt.RenderText '定义一个文本对象
rt.RowGroups(0,4).Header = prt.TableHeaderEnum.All '将第一行作为表头.
rt.Cols.Count = 9 '设置总列数
rt.Cols(0).Width = 15 '设置前四列的宽度,剩余的宽度被分配给5列(显示图片的那列)
rt.Cols(1).Width = 38
rt.Cols(2).Width = 18
rt.Cols(3).Width = 10
rt.Cols(4).Width = 10
rt.Cols(5).Width = 25
rt.Cols(6).Width = 26
rt.Cols(7).Width = 12
rt.Cols(8).Width = 8
rt.CellStyle.Spacing.All = 1 '单元格内容缩进1毫米
rt.Style.GridLines.All = New prt.Linedef '设置网格线
rt.Style.TextAlignVert = prt.AlignVertEnum.Center '内容垂直居中
rt.Style.TextAlignHorz = prt.AlignVertEnum.Center '内容平行居中
rt.Style.FontSize = 12
'设置主标题
rt.Cells(0,0).text = Chr(13) & Chr(10) & "样品交接记录表"
rt.Cells(0,0).SpanCols = 9 '合并第一行全部单元格,用于显示主标题
rt.Cells(0,0).Style.TextAlignHorz = prt.AlignHorzEnum.Center '主标题居中
rt.Cells(0,0).Style.Font = New Font("宋体", 16, FontStyle.Bold) '设置主标题字体
rt.Rows(0).Style.Borders.All = New prt.LineDef("0mm", Color.white) '去掉第一行的网格线
'设置副标题
rt.Cells(1,0).text = "修订号:000 第[PageNo]页/共[PageCount]页" '通过左边空格数量来调整副标题位置
rt.Cells(1,0).SpanCols = 9 '合并地二行全部单元格,用于显示副标题
rt.Cells(1,0).Style.TextAlignHorz = prt.AlignHorzEnum.right '副标题内容居左
rt.Rows(1).Style.Borders.All = New prt.LineDef("0mm", Color.white) '去掉第二行的网格线
rt.Rows(1).Style.Borders.Bottom = New prt.Linedef '恢复第二行底端的网格线
rt.Cells(2,0).text = "用人单位:" & dr("客户名称") & Chr(13) & Chr(10) & "检测类别:" & dr("项目类别") & " 委托序号:" & st1 & " 检测任务编号:" & cmb0 '通过左边空格数量来调整副标题位置
rt.Cells(2,0).SpanCols = 9 '合并地二行全部单元格,用于显示副标题
rt.Cells(2,0).Style.TextAlignHorz = prt.AlignHorzEnum.left '副标题内容居左
rt.Rows(2).Style.Borders.All = New prt.LineDef("0mm", Color.white) '去掉第二行的网格线
rt.Rows(2).Style.Borders.Bottom = New prt.Linedef '恢复第二行底端的网格线
rt.Rows(2).Height = 18 '设置第二行的高度,拉开和表格主体的距离.
'设置列标题
rt.Cells(3,0).Text = "检测类别"
rt.Cells(3,1).Text = "样品编号"
rt.Cells(3,2).Text = "采样介质"
rt.Cells(3,3).Text = "样品状态"
rt.Cells(3,4).Text = "样品数量"
rt.Cells(3,5).Text = "检测项目"
rt.Cells(3,6).Text = "样品保存条件"
rt.Cells(3,7).Text = "破损登记"
rt.Cells(3,8).Text = "备注"
i = 3
Dim str3 As String
Dim str4 As String
Dim jcf As String
Dim jyr As String
Dim syr As String
Dim dac1 As String
Dim dtby As DataTable = DataTables("样品列表")
For Each dry As DataRow In dtby.dataRows
dry.Delete()
Next
Dim tby As Table = Tables("样品列表")
For Each dr1 In DataTables("样品登记").Select("[客户名称] = '" & st0 & "' and [任务编号] = '" & st1 & "' and [任务序号] = '" & cmb0 & "' and [样品接收日期] >= #" & da0 & "# and [样品接收日期] < #" & da0.AddDays(1) & "# and [取消] <> true and [分析部组别] <> '现场检测'","项目类别,样品编号,项目名称,检测方法")
Dim ry As Row = tby.Current
If tby.Rows.Count = 0 Then
ry = tby.AddNew()
ry("检测项目") = dr1("项目名称")
ry("检测方法") = dr1("检测方法")
ry("检测类别") = dr1("项目类别")
ry("样品编号") = dr1("样品编号1")
ry("采样介质") = dr1("空气收集器")
ry("样品数量") = dr1("样品数量")
ry("样品状态") = dr1("样品状态")
ry("破损登记") = dr1("损坏")
ry("样品保存条件") = dr1("样品保存期限和保存条件")
ry("备注") = dr1("备注")
ry("交样人") = dr1("交样人")
ry("样品接收人") = dr1("样品接收人")
ry("样品接收日期") = dr1("样品接收日期")
Else
If ry("样品编号") = dr1("样品编号1") Then
ry("检测项目") = ry("检测项目") & ";" & dr1("项目名称")
ry("检测方法") = ry("检测方法") & ";" & dr1("检测方法")
Else
ry = tby.AddNew()
ry("检测项目") = dr1("项目名称")
ry("检测方法") = dr1("检测方法")
ry("检测类别") = dr1("项目类别")
ry("样品编号") = dr1("样品编号1")
ry("采样介质") = dr1("空气收集器")
ry("样品数量") = dr1("样品数量")
ry("样品状态") = dr1("样品状态")
ry("破损登记") = dr1("损坏")
ry("样品保存条件") = dr1("样品保存期限和保存条件")
ry("备注") = dr1("备注")
ry("交样人") = dr1("交样人")
ry("样品接收人") = dr1("样品接收人")
ry("样品接收日期") = dr1("样品接收日期")
End If
End If
Next
For Each dr1 In DataTables("样品列表").Select("","检测类别,检测方法,检测项目,样品编号")
If dr1.IsNull("样品接收日期") = False Then
dac1 = Format(dr1("样品接收日期"),"yyyy-MM-dd HH:mm")
End If
If che1.Checked = False Then
If dr1.IsNull("交样人") = False Then
jyr = dr1("交样人")
End If
If dr1.IsNull("样品接收人") = False Then
syr = dr1("样品接收人")
End If
End If
If str3 = dr1("检测项目") AndAlso str4 = dr1("检测方法") AndAlso i > 3 Then
ii = ii + 1
If ii Mod 3 <> 0 Then
rt.Cells(i,1).Text = rt.Cells(i,1).Text & dr1("样品编号") & ";"
Else
rt.Cells(i,1).Text = rt.Cells(i,1).Text & dr1("样品编号") & ";" & Chr(13) & Chr(10)
End If
rt.Cells(i,4).Text = rt.Cells(i,4).Text + dr1("样品数量")
If dr1("破损登记") = True Then
rt.Cells(i,7).Text = rt.Cells(i,7).Text & ";" & dr1("样品编号")
rt.Cells(i,7).Text = rt.Cells(i,7).Text.Replace("无","")
Else
rt.Cells(i,7).Text = "无"
End If
rt.Cells(21,0).SpanRows = 2
rt.Cells(21,1).SpanRows = 2
rt.Cells(21,2).SpanRows = 2
rt.Cells(21,3).SpanRows = 2
rt.Cells(21,4).SpanRows = 2
rt.Cells(21,5).SpanRows = 2
rt.Cells(21,6).SpanRows = 2
rt.Cells(21,7).SpanRows = 2
rt.Cells(21,8).SpanRows = 2
Else
ii = 1
i = i + 1
rt.Cells(i,0).Text = dr1("检测类别")
rt.Cells(i,5).Text = dr1("检测项目")
If dr1.IsNull("样品数量") Then
rt.Cells(i,4).Text = 0
Else
rt.Cells(i,4).Text = dr1("样品数量")
End If
rt.Cells(i,1).Text = dr1("样品编号") & ";"
rt.Cells(i,2).Text = dr1("采样介质")
rt.Cells(i,3).Text = dr1("样品状态")
rt.Cells(i,6).Text = dr1("样品保存条件")
If dr1("破损登记") = True Then
rt.Cells(i,7).Text = dr1("样品编号")
Else
rt.Cells(i,7).Text = "无"
End If
rt.Cells(i,8).Text = dr1("备注")
End If
str3 = dr1("检测项目")
str4 = dr1("检测方法")
Next
ra.Children.Add(rt)
Dim jys As String
Dim sys As String
If che1.Checked = False Then
Dim jr As DataRow = DataTables("Users").Find("Name = '" & jyr & "'")
If jr IsNot Nothing Then
If jr.IsNull("签名") = False Then
Dim srt22 As String = jr("签名")
Dim Values() As String
Values = srt22.Split("/")
jys = Values(Values.Length - 1)
Dim ftp1 As new ftpclient
ftp1.host = ftpip
ftp1.Account = ftpyh
ftp1.password = ftpmm
If ftp1.Download(jr("签名"),"Images\" & jys) = True Then
End If
End If
End If
Dim sr As DataRow = DataTables("Users").Find("Name = '" & syr & "'")
If sr IsNot Nothing Then
If sr.IsNull("签名") = False Then
Dim srt22 As String = sr("签名")
Dim Values() As String
Values = srt22.Split("/")
sys = Values(Values.Length - 1)
Dim ftp1 As new ftpclient
ftp1.host = ftpip
ftp1.Account = ftpyh
ftp1.password = ftpmm
If ftp1.Download(sr("签名"),"Images\" & sys) = True Then
End If
End If
End If
End If
rt = New prt.RenderTable() '定义一个表格对象
rt.Style.FontSize = 12
rt.Cols.Count = 6 '设置总列数
rt.Cols(0).Width = 20 '设置前四列的宽度,剩余的宽度被分配给5列(显示图片的那列)
rt.Cols(1).Width = 40
rt.Cols(2).Width = 20
rt.Cols(3).Width = 40
rt.Cols(4).Width = 20
rt.Cols(5).Width = 40
rt.rows(0).Height = 10
rt.Cells(0,0).Style.TextAlignHorz = prt.AlignHorzEnum.right
rt.Cells(0,0).Style.TextAlignVert = prt.AlignVertEnum.Center
rt.Cells(0,0).Text = "交样人:"
rm = New prt.RenderImage() '定义一个图片对象
rm.Image = GetImage("Images\" & jys) '请改为实际的图标名称和路径
rm.Style.ImageAlign.AlignHorz = prt.ImageAlignHorzEnum.left '图片水平居中
rm.Style.ImageAlign.AlignVert = prt.ImageAlignVertEnum.Center '图片垂直居中
rm.Height = 11
rm.Style.ImageAlign.KeepAspectRatio = True
rt.Cells(0,1).RenderObject = rm
rt.Cells(0,2).Style.TextAlignHorz = prt.AlignHorzEnum.right
rt.Cells(0,2).Style.TextAlignVert = prt.AlignVertEnum.Center
rt.Cells(0,2).Text = "接样人:"
rm = New prt.RenderImage() '定义一个图片对象
rm.Image = GetImage("Images\" & sys) '请改为实际的图标名称和路径
rm.Style.ImageAlign.AlignHorz = prt.ImageAlignHorzEnum.left '图片水平居中
rm.Style.ImageAlign.AlignVert = prt.ImageAlignVertEnum.Center '图片垂直居中
rm.Height = 11
rm.Style.ImageAlign.KeepAspectRatio = True
rt.Cells(0,3).RenderObject = rm
rt.Cells(0,4).Style.TextAlignHorz = prt.AlignHorzEnum.right
rt.Cells(0,4).Style.TextAlignVert = prt.AlignVertEnum.Center
rt.Cells(0,4).Text = "时间:"
rt.Cells(0,5).Style.TextAlignHorz = prt.AlignHorzEnum.left
rt.Cells(0,5).Style.TextAlignVert = prt.AlignVertEnum.Center
rt.Cells(0,5).Text = dac1
doc.PageFooter = rt
doc.Body.Children.Add(ra) '加入到报表中
doc.Preview()
Next
Else
MessageBox.Show("亲! 还没有登记样品或者没有提交采样计划!", "提示",MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Dim cmbs1s As String
For Each cmbs1 As DataRow In DataTables("样品登记").Select("[客户名称] = '" & st0 & "' and [任务编号] = '" & st1 & "' And [任务序号] = '" & cmb0 & "' And [样品接收日期] is null")
cmbs1s = cmbs1s & cmbs1("项目名称") & ";"
Next
If cmbs1s <> "" Then
MessageBox.Show("亲! 还有样品(" & cmbs1s & ")没有收样哦!赶紧催催提交样品吧!", "提示",MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End If