MyTimers("图片播放").Enabled = False
Dim r As Row = Tables("背景图片").Current
If r IsNot Nothing Then
Dim str As String = r.DataRow("附图一")
Dim str2 As String = r.DataRow("附图二")
Dim ftp1 As new ftpclient
ftp1.host="192.166.1.100"
ftp1.Account = "zcg"
ftp1.password = "SpQhSS"
If r.DataRow.IsNull("附图一") = False Then
If ftp1.Download("\新闻图片内容\" & FileSys.GetName(str), ProjectPath & "/RemoteFiles/新闻图片内容/" & FileSys.GetName(str)) = False Then
Network.DownloadFile("ftp://192.168.1.200/新闻图片内容/" & FileSys.GetName(str),ProjectPath & "\RemoteFiles\新闻图片内容\" & FileSys.GetName(str),"zcgmxf","SpQhSS0GypjoxCAje4q3iGXv7+9gGe2AX2oixyBr2Zk=",False, "10000", True)
PopMessage("图片下载成功!","提示",PopIconEnum.Infomation,1)
End If
End If
If r.DataRow.IsNull("附图二") = False Then
If ftp1.Download("\新闻图片内容\" & FileSys.GetName(str2), ProjectPath & "/RemoteFiles/新闻图片内容/" & FileSys.GetName(str2)) = False Then
Network.DownloadFile("ftp://192.168.1.200/新闻图片内容/" & FileSys.GetName(str2),ProjectPath & "\RemoteFiles\新闻图片内容\" & FileSys.GetName(str2),"zcgmxf","SpQhSS0GypjoxCAje4q3iGXv7+9gGe2AX2oixyBr2Zk=",False, "10000", True)
PopMessage("新闻图片二下载成功!","提示",PopIconEnum.Infomation,1)
End If
End If
End If
If r IsNot Nothing Then
Dim Doc As new PrintDoc
Dim rt As prt.RenderTable
rt = New prt.RenderTable
rt.Style.GridLines.All = New Prt.LineDef(0, Color.Black)
rt.Rows.Count = 7
rt.Cols.Count = 1
rt.Rows(0).Height = 15
rt.Rows(0).Style.Font = New Font("宋体", 20, FontStyle.Bold)
rt.Rows(1).Style.CharSpacing = 0.1
rt.Rows(1).Style.LineSpacing = 180
rt.Rows(2).Style.Font = New Font("宋体", 12.5)
rt.Rows(2).Height = 20
rt.Rows(3).Style.Font = New Font("宋体", 12.5)
rt.Rows(3).Height = 12
rt.Cells(0,0).Style.TextAlignHorz = prt.AlignHorzEnum.Center
rt.Cells(1,0).Style.TextAlignHorz = prt.AlignHorzEnum.Left
rt.Cells(2,0).Style.TextAlignHorz = prt.AlignHorzEnum.Right
rt.Cells(2,0).Style.TextAlignVert = prt.AlignVertEnum.Bottom
rt.Cells(3,0).Style.TextAlignHorz = prt.AlignHorzEnum.Right
rt.Cells(3,0).Style.TextAlignVert = prt.AlignVertEnum.Center
rt.Cells(0,0).Text = r("标题")
Dim txt As new prt.RenderText
rt.Cells(1,0).RenderObject = txt
txt.text = r("内容")
txt.Style.Font = New Font("宋体", 12.5)
' txt.Style.TextIndent = 9
rt.Cells(1,0).Style.Font = New Font("宋体", 12.5)
rt.Cells(1,0).Style.TextIndent = 9
rt.Cells(2,0).Text = r("所在科室") & "(" & r("编辑人") & ")"
rt.Cells(3,0).Text = Format(r("日期"),"yyyy年M月d日")
If FileSys.FileExists(ProjectPath & "\RemoteFiles\新闻图片内容\" & FileSys.GetName(r("附图一"))) Then
Dim rm As New prt.RenderImage '定义一个图片对象
rt.Cells(4,0).RenderObject = rm
rm.Image = GetImage(ProjectPath & "\RemoteFiles\新闻图片内容\" & FileSys.GetName(r("附图一"))) '设置图片
rm.Width = 70
rm.Height = 50
rm.Style.ImageAlign.StretchHorz = True
rm.Style.ImageAlign.StretchVert = True
' rm.Style.ImageAlign.KeepAspectRatio = False
rm.Style.ImageAlign.AlignHorz = prt.ImageAlignHorzEnum.Center '居中显示
rt.Cells(4,0).Image = rm.Image
End If
rt.Rows(5).Height = 6
If FileSys.FileExists(ProjectPath & "\RemoteFiles\新闻图片内容\" & FileSys.GetName(r("附图二"))) Then
Dim rm2 As New prt.RenderImage '定义一个图片对象
rt.Cells(6,0).RenderObject = rm2
rm2.Image = GetImage(ProjectPath & "\RemoteFiles\新闻图片内容\" & FileSys.GetName(r("附图二"))) '设置图片
rm2.Width = 70
rm2.Height = 50
rm2.Style.ImageAlign.StretchHorz = True
rm2.Style.ImageAlign.StretchVert = True
' rm2.Style.ImageAlign.KeepAspectRatio = False
rm2.Style.ImageAlign.AlignHorz = prt.ImageAlignHorzEnum.Center '居中显示
rt.Cells(6,0).Image = rm2.Image
End If
Doc.Body.Children.Add(rt)
_MyDoc = Doc
Forms("内容").Open()
Else
Messagebox.show("没有动态新闻内容!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
End If
加好友 
发短信
Post By：2018/7/26 8:07:00 [只看该作者]
