Boonlive_RD_Web/Desktop_CorelDrawTool
8
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
6d5b527e223796a6d9247db67b57f4bc398792aa
Desktop_CorelDrawTool/CorelDRAW.vb

2980 lines
133 KiB
VB.net
Raw Normal View History

初始化
2025-12-11 10:52:49 +08:00
Imports System.IO
Imports System.Threading
Imports System.Threading.Channels
Imports System.Windows.Forms.VisualStyles.VisualStyleElement
Imports CorelDRAW
Imports CorelDRAW.RuningLog
Imports Newtonsoft.Json
Imports StackExchange.Redis
Imports VGCore
Public Class CorelDRAW
Public M_Redisip As String = "127.0.0.1"
Public M_Redisport As Integer = 10079 '6379 ' 10079
Public M_Redispassword As String = "blw@redis-ser@123" ' "" '
'redis消息队列
Public M_RedisQueue As Queue
'事件处理线程
Public M_EventThread As Thread
'素材库路径
Private M_MaterialPath As String = "R:\Canvas\material\" '"D:\Canvas\material\" '
'成平文件路径
Private M_TplPath As String = "D:\CorelDRAW\"
Public G_RedisSub, G_Redislish As RedisSubscriber
'发布字段
Public G_Publish As String = ""
Public G_Subscribe As String = ""
Public G_OldSubscribe As String = ""
'日志对象
Public G_Log As RuningLog
Public APP As Object
Public G_LibDoc As Document
'数据库连接字符串
Public LocalConnString As String = "server=10.8.8.212;database=lowmachinelog;charset=utf8;uid=BLWlog;pwd=Blw@1234;port=16036"
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'定义一个画布
Text = "CorelDRAW" & "_" & System.Windows.Forms.Application.ProductVersion
M_RedisQueue = New Queue()
'启动事件处理线程
M_EventThread = New Thread(AddressOf EventThread)
M_EventThread.Start()
'Dim t As Type = Type.GetTypeFromProgID("CorelDRAW.Application.22")
'If t IsNot Nothing Then
' Console.WriteLine("COM 已注册，可以连接！")
'Else
' Console.WriteLine("COM 未注册！")
'End If
APP = New Application()
Thread.Sleep(300)
APP.Visible = False
' Dim MaterialPath As String = M_MaterialPath & "素材模板.cdr"
'G_LibDoc = APP.OpenDocument(MaterialPath, False)
G_Log = New RuningLog(RichTextBox1, System.Windows.Forms.Application.StartupPath & "\log")
GetSeting()
initRedisSubscriber(G_Subscribe, G_OldSubscribe)
initRedisPublisher()
End Sub
Private Sub EventThread()
Dim item As RedisMsgNode
While True
If M_RedisQueue.Count > 0 Then
item = M_RedisQueue.Dequeue()
If item Is Nothing Then Continue While
Select Case item.MsgType
Case 1
Dim MsgNode = JsonConvert.DeserializeObject(Of RedisInfoNode)(item.MsgNode.ToString)
DisposeRedisMsgNode1(MsgNode)
Case 2
Dim MsgNode = JsonConvert.DeserializeObject(Of PreviewRoomTypePanel)(item.MsgNode.ToString)
DisposeRedisMsgNode2(MsgNode)
End Select
End If
System.Threading.Thread.Sleep(10)
End While
End Sub
Sub DisposeRedisMsgNode1(item As RedisInfoNode)
Dim gLogNode As LogNode
Try
gLogNode = New LogNode($"开始进行用户【{item.User}】_[{item.ProjectName}]项目[{item.TemplateName.Replace("Mode_", "") }]图像生成！", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
'gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
If HandleNodeInformation3(item) Then
gLogNode = New LogNode($"开始进行用户【{item.User}】_[{item.ProjectName}]项目[{item.TemplateName.Replace("Mode_", "") }]图像生成成功！", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
'gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Else
gLogNode = New LogNode($"开始进行用户【{item.User}】_[{item.ProjectName}]项目[{item.TemplateName.Replace("Mode_", "") }]图像生成失败！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
End If
Catch ex As Exception
Dim RsNode As New RedisSendNode
RsNode.User = item.User
RsNode.ProjectName = item.ProjectName
RsNode.ProjectId = item.ProjectId
RsNode.PictureNum = item.PictureNum
RsNode.Status = RedisSendNode.StatusType.SerializeFail
RsNode.Process = item.Process
RsNode.Msg = "序列化数据错误!"
Dim RMNode As New RedisMsgNode
RMNode.MsgType = 1
RMNode.MsgNode = RsNode
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode($"序列化数据错误！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
APP = New Application()
Thread.Sleep(500)
End Try
End Sub
Sub DisposeRedisMsgNode2(node As PreviewRoomTypePanel)
Dim gLogNode As LogNode
Dim filedir As String = "R:\IIS ROOT\BLWLog\Web\wwwroot\PanelSelectionPic"
Dim RsNode As New RedisSendNode
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.PictureNum = node.picNum
Dim RMNode As New RedisMsgNode
RMNode.MsgType = 2
RMNode.MsgNode = RsNode
Try
InpotMessage1("1、文档初始化")
gLogNode = New LogNode($"生成酒店房间面板预览文档！", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
G_Log.AddLogNode(gLogNode)
Dim doc As Document
Try
doc = APP.CreateDocument()
doc.Unit = cdrUnit.cdrMillimeter ' 设置单位为毫米
Catch ex As Exception
APP = New Application()
Thread.Sleep(1000)
APP.Visible = False
doc = APP.CreateDocument()
doc.Unit = cdrUnit.cdrMillimeter ' 设置单位为毫米
End Try
InpotMessage1("3、打开模板库并创建新文件等待构建图像")
InpotMessage1("2、酒店标题生成")
Dim hotelName As String = ""
If node.project IsNot Nothing AndAlso node.project.Count > 0 Then
hotelName = node.project(0).hotel_name
RsNode.Guid = node.project(0).guid
End If
InpotMessage1("创建酒店标题文本")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = "创建酒店标题失败!!"
'Dim hotelText As Shape = doc.ActiveLayer.CreateArtisticText(0, 0, hotelName)
Dim remark As String() = {"思源黑体", "48"}
Dim hotelText As Shape = CreateTextImage2(doc.ActiveLayer, hotelName, remark)
hotelText.CenterY = 0
hotelText.LeftX = 0
'With hotelText.Text.Properties
' .Font = "Source Han Sans SC"
' .Size = 48
'End With
' 计算当前文档高度
Dim currentY As Double = hotelText.CenterY - 20 ' 标题底部向下50mm
InpotMessage1("3、数据分组处理")
Dim roomGroups As Dictionary(Of String, List(Of Panel)) = New Dictionary(Of String, List(Of Panel))()
For Each panel As Panel In node.panels
If Not roomGroups.ContainsKey(panel.room_name) Then
roomGroups.Add(panel.room_name, New List(Of Panel)())
End If
roomGroups(panel.room_name).Add(panel)
Next
InpotMessage1("4、房型分类处理")
For Each roomName As String In roomGroups.Keys
InpotMessage1("创建房型标题文本")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = "创建酒店房型标题失败!!"
remark = {"思源黑体", "28"}
Dim roomText As Shape = CreateTextImage2(doc.ActiveLayer, roomName, remark)
roomText.CenterY = currentY
roomText.LeftX = 0
'Dim roomText As Shape = doc.ActiveLayer.CreateArtisticText(0, currentY, roomName)
'With roomText.Text.Properties
' .Font = "Source Han Sans SC"
' .Size = 28
'End With
currentY = roomText.CenterY - (roomText.OriginalHeight / 2) - 10 ' 房型标题底部向下30mm
Dim currentX As Double = 0 ' 当前行的X坐标
Dim maxHeight As Double = 0 ' 当前行最高图像的高度
InpotMessage1("遍历该房型对应的所有panel")
For Each panel As Panel In roomGroups(roomName)
Dim cdr_filename As String = $"{filedir}\{panel.cdr_filename}".Replace("\\", "\")
InpotMessage1("5、CDR文件图像处理")
If File.Exists(cdr_filename) Then
InpotMessage1("打开CDR文件")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = $"拷贝文件{vbCrLf}{cdr_filename}{vbCrLf}中的面板图像失败!!"
Dim cdrDoc As Document = APP.OpenDocument(cdr_filename, False)
If cdrDoc.Pages.Count > 0 AndAlso cdrDoc.Pages(1).ActiveLayer.Shapes.Count > 0 Then
InpotMessage1("复制第一个图像")
Dim cdrShape As Shape = cdrDoc.Pages(1).ActiveLayer.Shapes(1)
'cdrShape.Copy()
shapeCopy(cdrShape)
InpotMessage1("粘贴到当前文档")
Dim pastedShape As Shape = doc.ActiveLayer.Paste() 'doc.ActiveLayer.Shapes(doc.ActiveLayer.Shapes.Count)
InpotMessage1("设置图像位置")
pastedShape.LeftX = currentX
pastedShape.CenterY = currentY - (pastedShape.OriginalHeight / 2)
InpotMessage1("6、属性文本生成")
InpotMessage1("生成panel_list_name文本")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = $"生成名称文本图像失败：{panel.panel_list_name} !!"
remark = {"思源黑体", "24"}
Dim listNameText As Shape = CreateTextImage2(doc.ActiveLayer, "名称：" & panel.panel_list_name, remark)
Dim textY As Double = pastedShape.CenterY - (pastedShape.OriginalHeight / 2) - 10
listNameText.CenterY = textY
listNameText.LeftX = currentX
'Dim listNameText As Shape = doc.ActiveLayer.CreateArtisticText(currentX, textY, "名称：" & panel.panel_list_name)
'With listNameText.Text.Properties
' .Font = "Source Han Sans SC"
' .Size = 12
'End With
InpotMessage1("生成position文本")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = $"生成位置文本图像失败：{panel.position} !!"
Dim positionText As Shape = CreateTextImage2(doc.ActiveLayer, "位置：" & panel.position, remark)
textY = listNameText.CenterY - (listNameText.OriginalHeight / 2) - 10
positionText.CenterY = textY
positionText.LeftX = currentX
'Dim positionText As Shape = doc.ActiveLayer.CreateArtisticText(currentX, textY + 10, "位置：" & panel.position)
'With positionText.Text.Properties
' .Font = "Source Han Sans SC"
' .Size = 12
'End With
InpotMessage1("生成carving_quantity文本")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = $"生成数量文本图像失败：{panel.carving_quantity} !!"
Dim quantityText As Shape = CreateTextImage2(doc.ActiveLayer, "数量：" & panel.carving_quantity, remark)
textY = positionText.CenterY - (positionText.OriginalHeight / 2) - 10
quantityText.CenterY = textY
quantityText.LeftX = currentX
'Dim quantityText As Shape = doc.ActiveLayer.CreateArtisticText(currentX, textY + 20, "数量：" & panel.carving_quantity)
'With quantityText.Text.Properties
' .Font = "Source Han Sans SC"
' .Size = 12
'End With
InpotMessage1("7、图文组合")
pastedShape.Selected = True
listNameText.Selected = True
positionText.Selected = True
quantityText.Selected = True
Dim group As Shape = doc.SelectionRange.Group()
group.Name = pastedShape.Name 'Path.GetFileNameWithoutExtension(panel.cdr_filename)
group.Selected = False
pastedShape.Selected = False
listNameText.Selected = False
positionText.Selected = False
quantityText.Selected = False
InpotMessage1("更新X坐标，为下一个图像留出50mm间距")
InpotMessage1("计算当前行的最大高度")
If group.OriginalHeight > maxHeight Then
maxHeight = group.OriginalHeight
End If
currentX += pastedShape.SizeWidth + 50
Else
RsNode.Status = RedisSendNode.StatusType.MaterialNotExist
RsNode.Msg = $"未找到文件{vbCrLf}{cdr_filename}{vbCrLf}中的图像!!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode($"生成酒店房间面板预览文档失败：{ RsNode.Msg}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
InpotMessage1("关闭CDR文件")
cdrDoc.Close()
Else
RsNode.Status = RedisSendNode.StatusType.MaterialNotExist
RsNode.Msg = $"文件{vbCrLf}{cdr_filename}{vbCrLf}不存在!!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode($"生成酒店房间面板预览文档失败：{ RsNode.Msg}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
Next
' 更新Y坐标，为下一个房型留出50mm间距
currentY = currentY - maxHeight - 20
Next
InpotMessage1("8、文档保存")
RsNode.Status = RedisSendNode.StatusType.SaveFileFail
RsNode.Msg = $"生成文件失败 !!"
Dim savePath As String = $"{filedir}\{hotelName}\{Now:yyyyMMdd}"
If Not Directory.Exists(savePath) Then
Directory.CreateDirectory(savePath)
End If
Dim cdrFileName As String = $"{node.picNum}.cdr"
Dim cdrFilePath As String = Path.Combine(savePath, cdrFileName)
Dim ssao As New StructSaveAsOptions
ssao.Filter = VGCore.cdrFilter.cdrCDR
ssao.Range = VGCore.cdrExportRange.cdrAllPages
ssao.Version = VGCore.cdrFileVersion.cdrVersion19
doc.SaveAs(cdrFilePath, ssao)
'InpotMessage1("9、文档导出")
'Dim pltFileName As String = $"PreviewRoomTypePanel{node.picNum}.plt"
'Dim pltFilePath As String = Path.Combine(savePath, pltFileName)
'doc.Export(pltFilePath, cdrExportFileFormat.cdrPLT)
InpotMessage1("关闭文档")
doc.Close()
RsNode.Status = RedisSendNode.StatusType.Success
RsNode.Msg = "Ok"
RsNode.CdrPath = cdrFilePath.Replace(filedir & "\", "")
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
InpotMessage1($"18、向Redis写入生成成功信息")
gLogNode = New LogNode($"成功生成酒店房间面板预览文档：{cdrFilePath}", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
G_Log.AddLogNode(gLogNode)
Return
Catch ex As Exception
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode($"生成酒店房间面板预览文档失败：{ex.Message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
End Try
End Sub
Public Function HandleNodeInformation1(node As RedisInfoNode) As Boolean
Dim oldTime As DateTime = Now
Dim MaterialPath As String = M_MaterialPath & node.MaterialLibraryName
Dim RsNode As New RedisSendNode
RsNode.User = node.User
RsNode.ProjectName = node.ProjectName
RsNode.ProjectId = node.ProjectId
RsNode.PictureNum = node.PictureNum
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Process = node.Process
RsNode.Guid = node.Guid
Dim gLogNode As LogNode
Dim ProjectPath As String
Dim locionbuf(), indexbuf() As String
Dim shp, lhp, rhp, chp, clhp As Shape
Dim x#, y#, w#, h#
Dim dx As Double, dy As Double
Dim destLayer As Layer
'''Console.WriteLine($"到达节点1耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
'查找素材库
If Not File.Exists(MaterialPath) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = "素材库不存在!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
gLogNode = New LogNode("素材库不存在", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
'''Console.WriteLine($"到达节点2耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Try
Try
G_LibDoc = APP.OpenDocument(MaterialPath, False)
Catch ex As Exception
APP = New Application()
Thread.Sleep(500)
APP.Visible = False
G_LibDoc = APP.OpenDocument(MaterialPath, False)
End Try
ProjectPath = $"{M_TplPath}{node.ProjectName}\{Now:yyyyMMdd}"
'判断项目文件夹是否存在
If Not Directory.Exists(ProjectPath) Then
'MsgBox("项目文件夹不存在")
'创建文件夹
Directory.CreateDirectory(ProjectPath)
End If
'查找模板
locionbuf = node.TemplateNameIndex.Split("_")
Dim page As Page = G_LibDoc.Pages(CInt(locionbuf(0)))
'''Console.WriteLine($"到达节点8耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Dim layer As Layer = page.Layers(CInt(locionbuf(1)))
'''Console.WriteLine($"到达节点7耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shp = layer.Shapes(CInt(locionbuf(2)))
'''Console.WriteLine($"到达节点6耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
If IsNothing(shp) OrElse Not node.TemplateName.Trim.Equals(shp.Name.Trim) Then
RsNode.Status = RedisSendNode.StatusType.TemplateNotExist
RsNode.Msg = "未找到模板信息！！"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
gLogNode = New LogNode("未找到模板信息！！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
'''Console.WriteLine($"到达节点3耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Dim li As New List(Of (Shape, Shape))
Dim ctdic As New List(Of (Shape, Shape))
'遍历node.MaterialDic
For Each item In node.PatternList
'''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
indexbuf = item.ShapeNumber.Split("_")
RsNode.Status = RedisSendNode.StatusType.MaterialPositionNotExist
lhp = shp.Shapes(CInt(item.IndexNumber))
RsNode.Status = RedisSendNode.StatusType.MaterialNotExist
page = G_LibDoc.Pages(CInt(indexbuf(0)))
layer = page.Layers(CInt(indexbuf(1)))
rhp = layer.Shapes(CInt(indexbuf(2)))
'单体先挪到槽位
x = lhp.CenterX - rhp.CenterX
y = lhp.CenterY - rhp.CenterY
dx = lhp.LeftX
dy = lhp.TopY
rhp.Move(x, y)
clhp = rhp.Shapes(rhp.Shapes.Count)
clhp.Visible = False
li.Add((rhp, lhp))
'再将素材挪到指定的小槽位
For Each LocationNode In item.LocationList
clhp = rhp.Shapes(CInt(LocationNode.IndexNumber))
indexbuf = LocationNode.ShapeNumber.Split("_")
page = G_LibDoc.Pages(CInt(indexbuf(0)))
layer = page.Layers(CInt(indexbuf(1)))
chp = layer.Shapes(CInt(indexbuf(2)))
x = clhp.CenterX - chp.CenterX
y = clhp.CenterY - chp.CenterY
dx = clhp.LeftX
dy = clhp.TopY
chp.Move(x, y)
ctdic.Add((chp, clhp))
Next
Next
'''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
shp.Selected = True
For Each item In li
item.Item1.OrderToFront()
item.Item1.Selected = True
''Console.WriteLine(item.Item2.Name)
item.Item2.Delete()
Next
For Each item In ctdic
item.Item1.OrderToFront()
item.Item1.Selected = True
item.Item2.Delete()
Next
'''Console.WriteLine($"到达节点4耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Dim sr As ShapeRange = APP.ActiveSelectionRange
shp = sr.Group()
shp.Name = node.TemplateName
page = G_LibDoc.Pages(CInt(locionbuf(0)))
SetIconToCentered(page, shp)
'''Console.WriteLine($"到达节点11耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
RsNode.Status = RedisSendNode.StatusType.SaveFileFail
shp.Selected = True
'Dim sel As ShapeRange = APP.ActiveSelectionRange
'0-预览小图 1-生成文件
Select Case node.Process
Case 0
ProjectPath = $"{ProjectPath}\{node.TemplateName.Replace("Mode_", "")}_{Now:yyyyMMddHHmmss}.png"
Dim Ef As ExportFilter = G_LibDoc.ExportBitmap(ProjectPath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
Case 1
ProjectPath = $"{ProjectPath}\{node.TemplateName.Replace("Mode_", "")}_{Now:yyyyMMddHHmmss}.cdr"
Dim ssao As New StructSaveAsOptions
ssao.Filter = VGCore.cdrFilter.cdrCDR
ssao.Range = VGCore.cdrExportRange.cdrSelection
G_LibDoc.SaveAs(ProjectPath, ssao)
Case Else
G_LibDoc.Close()
RsNode.Status = RedisSendNode.StatusType.UnknownFail
RsNode.Msg = "位置操作!!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
Return False
End Select
G_LibDoc.Close()
RsNode.Status = RedisSendNode.StatusType.Success
RsNode.Msg = "Ok"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
Return True
Catch ex As Exception
Select Case RsNode.Status
Case RedisSendNode.StatusType.MaterialPositionNotExist
RsNode.Msg = "素材位置不存在!!"
Case RedisSendNode.StatusType.MaterialNotExist
RsNode.Msg = "素材不存在!!"
Case RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = "生成图像失败!!"
Case RedisSendNode.StatusType.SaveFileFail
RsNode.Msg = "保存文件失败!!"
End Select
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
If Not IsNothing(G_LibDoc) Then
G_LibDoc.Close()
End If
gLogNode = New LogNode($"{RsNode.Msg}{vbCrLf}{ex.Message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End Try
End Function
Public Function HandleNodeInformation2(node As RedisInfoNode) As Boolean
Dim oldTime As DateTime = Now
Dim MaterialPath As String = M_MaterialPath & node.MaterialLibraryName
Dim RsNode As New RedisSendNode
RsNode.User = node.User
RsNode.ProjectName = node.ProjectName
RsNode.ProjectId = node.ProjectId
RsNode.PictureNum = node.PictureNum
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Process = node.Process
RsNode.Guid = node.Guid
Dim gLogNode As LogNode
Dim ProjectPath As String
Dim locionbuf(), indexbuf() As String
Dim fshp, shp, lhp, rhp, chp, clhp As Shape
Dim x#, y#, w#, h#
Dim dx As Double, dy As Double
Dim destLayer As Layer
Dim MLibDoc As Document
Dim ServerFilePath As String = "D:\BLWLog\Web\wwwroot\PanelSelectionPic\"
'''Console.WriteLine($"到达节点1耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
'查找素材库
If Not File.Exists(MaterialPath) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = "素材库不存在!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
gLogNode = New LogNode("素材库不存在", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
'''Console.WriteLine($"到达节点2耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Try
Try
G_LibDoc = APP.OpenDocument(MaterialPath, False)
MLibDoc = APP.CreateDocument()
Catch ex As Exception
APP = New Application()
Thread.Sleep(1000)
APP.Visible = False
G_LibDoc = APP.OpenDocument(MaterialPath, False)
MLibDoc = APP.CreateDocument()
End Try
APP.EventsEnabled = False
APP.Optimization = True
'APP.EventsEnabled = True
'APP.Optimization = False
'APP.Refresh()
ProjectPath = $"{ServerFilePath}{node.ProjectName}\{Now:yyyyMMdd}"
'判断项目文件夹是否存在
If Not Directory.Exists(ProjectPath) Then
'MsgBox("项目文件夹不存在")
'创建文件夹
Directory.CreateDirectory(ProjectPath)
End If
'查找模板
locionbuf = node.TemplateNameIndex.Split("_")
Dim npage As Page
Dim page As Page = G_LibDoc.Pages(CInt(locionbuf(0)))
'''Console.WriteLine($"到达节点8耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Dim layer As Layer = page.Layers(CInt(locionbuf(1)))
Dim nlayer As Layer
'''Console.WriteLine($"到达节点7耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shp = layer.Shapes(CInt(locionbuf(2)))
'''Console.WriteLine($"到达节点6耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
If IsNothing(shp) OrElse Not node.TemplateName.Trim.Equals(shp.Name.Trim) Then
RsNode.Status = RedisSendNode.StatusType.TemplateNotExist
RsNode.Msg = "未找到模板信息！！"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
gLogNode = New LogNode("未找到模板信息！！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
Else
'将模板复制到新文档
'''Console.WriteLine($"到达节点5耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
''Console.WriteLine($"到达节点1耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shapeCopy(shp)
npage = MLibDoc.Pages(1)
nlayer = MLibDoc.ActiveLayer
''Console.WriteLine($"到达节点2耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
fshp = nlayer.Paste()
''Console.WriteLine($"到达节点3耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
End If
'''Console.WriteLine($"到达节点3耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Dim li As New List(Of (Shape, Shape))
Dim ctdic As New List(Of (Shape, Shape))
Dim Uctdic As New Dictionary(Of Integer, List(Of Shape）)
'遍历node.MaterialDic
For Each item In node.PatternList
' ''Console.WriteLine(item.ShapeNumber)
'''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
indexbuf = item.ShapeNumber.Split("_")
RsNode.Status = RedisSendNode.StatusType.MaterialPositionNotExist
lhp = fshp.Shapes(CInt(item.IndexNumber))
RsNode.Status = RedisSendNode.StatusType.MaterialNotExist
page = G_LibDoc.Pages(CInt(indexbuf(0)))
layer = page.Layers(CInt(indexbuf(1)))
rhp = layer.Shapes(CInt(indexbuf(2)))
'延时20个毫秒
''Console.WriteLine(rhp.Name)
''Console.WriteLine($"到达节点4耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shapeCopy(rhp)
''Console.WriteLine($"到达节点5耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
rhp = nlayer.Paste()
''Console.WriteLine($"到达节点6耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
rhp.Name = rhp.Name & "_" & item.IndexNumber
'单体先挪到槽位
li.Add((rhp, lhp))
'再将素材挪到指定的小槽位
For Each LocationNode In item.LocationList
''Console.WriteLine(LocationNode.ShapeNumber)
If LocationNode.ShapeType = 0 Then
Dim remark As String() = LocationNode.Remark.Split("_")
If remark.Length > 1 Then
clhp = rhp.Shapes(CInt(LocationNode.IndexNumber))
chp = CreateTextImage(nlayer, LocationNode.ShapeNumber, remark)
If IsNothing(chp) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = "生成文本图像失败!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
gLogNode = New LogNode("生成文本图像失败！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
chp.Name = chp.Name & "_" & item.IndexNumber & "_" & LocationNode.IndexNumber
ctdic.Add((chp, clhp))
If remark.Length > 2 Then
Dim chpli As List(Of Shape)
If Uctdic.ContainsKey(remark(2)) Then
chpli = Uctdic(remark(2))
chpli.Add(chp)
Else
chpli = New List(Of Shape)
chpli.Add(chp)
Uctdic.Add(remark(2), chpli)
End If
End If
Else
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = "生成文本图像失败!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
gLogNode = New LogNode("生成文本图像失败!", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
Else
clhp = rhp.Shapes(CInt(LocationNode.IndexNumber))
indexbuf = LocationNode.ShapeNumber.Split("_")
page = G_LibDoc.Pages(CInt(indexbuf(0)))
layer = page.Layers(CInt(indexbuf(1)))
chp = layer.Shapes(CInt(indexbuf(2)))
'延时10个毫秒
'延时20个毫秒
''Console.WriteLine($"到达节点7耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
''Console.WriteLine(chp.Name)
'延时50ms
''Console.WriteLine($"到达节点8耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shapeCopy(chp)
''Console.WriteLine($"到达节点9耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
chp = nlayer.Paste()
''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
chp.Name = chp.Name & "_" & item.IndexNumber & "_" & LocationNode.IndexNumber
ctdic.Add((chp, clhp))
End If
Next
''Console.WriteLine(rhp.Name)
Next
'''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
'fshp.Selected = True
For Each item In li
item.Item1.OrderToFront()
x = item.Item2.CenterX - item.Item1.CenterX
y = item.Item2.CenterY - item.Item1.CenterY
item.Item1.Move(x, y)
clhp = item.Item1.Shapes(item.Item1.Shapes.Count)
clhp.Visible = False
' li.Add((rhp, lhp))
'item.Item1.Selected = True
''Console.WriteLine(item.Item2.Name)
item.Item2.Delete()
Next
For Each item In ctdic
item.Item1.OrderToFront()
x = item.Item2.CenterX - item.Item1.CenterX
y = item.Item2.CenterY - item.Item1.CenterY
item.Item1.Move(x, y)
'ctdic.Add((chp, clhp))
'item.Item1.Selected = True
item.Item2.Delete()
Next
Dim topl As Single = 0
For Each item In Uctdic
For i = 0 To item.Value.Count - 1
If i = 0 Then
topl = item.Value(0).TopY
End If
item.Value(i).TopY = topl
Next
Next
'''Console.WriteLine($"到达节点4耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
'Dim sr As ShapeRange = APP.ActiveSelectionRange
fshp = nlayer.Shapes.All().Group()
'shp = sr.Group()
fshp.Name = node.TemplateName
'page = G_LibDoc.Pages(CInt(locionbuf(0)))
'SetIconToCentered(page, shp)
'''Console.WriteLine($"到达节点11耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
RsNode.Status = RedisSendNode.StatusType.SaveFileFail
fshp.Selected = True
SetIconToCentered(npage, fshp)
'Dim sel As ShapeRange = APP.ActiveSelectionRange
'0-预览小图 1-生成文件
Select Case node.Process
Case 0
ProjectPath = $"{ProjectPath}\{node.TemplateName.Replace("Mode_", "")}_{Now:yyyyMMddHHmmss}.png"
Dim Ef As ExportFilter = MLibDoc.ExportBitmap(ProjectPath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
RsNode.ImagePath = ProjectPath.Replace(ServerFilePath, "")
Case 1
ProjectPath = $"{ProjectPath}\{node.TemplateName.Replace("Mode_", "")}_{Now:yyyyMMddHHmmss}.cdr"
Dim ssao As New StructSaveAsOptions
ssao.Filter = VGCore.cdrFilter.cdrCDR
ssao.Range = VGCore.cdrExportRange.cdrSelection
MLibDoc.SaveAs(ProjectPath, ssao)
RsNode.CdrPath = ProjectPath.Replace(ServerFilePath, "")
Case Else
MLibDoc.Close()
G_LibDoc.Close()
RsNode.Status = RedisSendNode.StatusType.UnknownFail
RsNode.Msg = "位置操作!!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
Return False
End Select
APP.EventsEnabled = True
APP.Optimization = False
APP.Refresh()
MLibDoc.Close()
G_LibDoc.Close()
RsNode.Status = RedisSendNode.StatusType.Success
RsNode.Msg = "Ok"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
Return True
Catch ex As Exception
APP.EventsEnabled = True
APP.Optimization = False
APP.Refresh()
Select Case RsNode.Status
Case RedisSendNode.StatusType.MaterialPositionNotExist
RsNode.Msg = "素材位置不存在!!"
Case RedisSendNode.StatusType.MaterialNotExist
RsNode.Msg = "素材不存在!!"
Case RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = "生成图像失败!!"
Case RedisSendNode.StatusType.SaveFileFail
RsNode.Msg = "保存文件失败!!"
End Select
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RsNode))
If Not IsNothing(MLibDoc) Then
MLibDoc.Close()
End If
If Not IsNothing(G_LibDoc) Then
G_LibDoc.Close()
End If
gLogNode = New LogNode($"{RsNode.Msg}{vbCrLf}{ex.Message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End Try
End Function
'输出日志
Public Sub InpotMessage1(PictureNum As String)
If Isdisply Then
Dim gLogNode As LogNode
gLogNode = New LogNode(PictureNum, RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Blue)
G_Log.AddLogNode(gLogNode)
End If
End Sub
Public Function HandleNodeInformation3(node As RedisInfoNode) As Boolean
InpotMessage1("1、开始生成文件")
Dim oldTime As DateTime = Now
Dim MaterialPath As String = M_MaterialPath & node.MaterialLibraryName
Dim RsNode As New RedisSendNode
RsNode.User = node.User
RsNode.ProjectName = node.ProjectName
RsNode.ProjectId = node.ProjectId
RsNode.PictureNum = node.PictureNum
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Process = node.Process
RsNode.Guid = node.Guid
Dim RMNode As New RedisMsgNode
RMNode.MsgType = 1
RMNode.MsgNode = RsNode
Dim gLogNode As LogNode
Dim ProjectPath As String
Dim locionbuf(), indexbuf() As String
Dim fshp, shp, lhp, rhp, chp, clhp As Shape
Dim x#, y#, w#, h#
Dim dx As Double, dy As Double
Dim destLayer As Layer
Dim MLibDoc As Document
Dim li As New List(Of (Shape, Shape))
Dim ServerFilePath As String = "R:\IIS ROOT\BLWLog\Web\wwwroot\PanelSelectionPic\" ' "D:\IIS ROOT\BLWLog\Web\wwwroot\PanelSelectionPic\" '
'''Console.WriteLine($"到达节点1耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
'查找素材库
InpotMessage1("2、检测模版素材库是否存在")
If Not File.Exists(MaterialPath) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = "模版素材库不存在!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode("模版素材库不存在", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
'''Console.WriteLine($"到达节点2耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Try
Try
G_LibDoc = APP.OpenDocument(MaterialPath, False)
MLibDoc = APP.CreateDocument()
InpotMessage1("3、打开模板库并创建新文件等待构建图像")
Catch ex As Exception
APP = New Application()
Thread.Sleep(1000)
APP.Visible = False
G_LibDoc = APP.OpenDocument(MaterialPath, False)
MLibDoc = APP.CreateDocument()
End Try
APP.EventsEnabled = False
APP.Optimization = True
'APP.EventsEnabled = True
'APP.Optimization = False
'APP.Refresh()
ProjectPath = $"{ServerFilePath}{node.ProjectName}\{Now:yyyyMMdd}"
'判断项目文件夹是否存在
InpotMessage1("4、创建项目文件夹")
If Not Directory.Exists(ProjectPath) Then
'MsgBox("项目文件夹不存在")
'创建文件夹
Directory.CreateDirectory(ProjectPath)
End If
'查找模板
InpotMessage1("5、开始查找模板图像")
locionbuf = node.TemplateNameIndex.Split("_")
Dim npage As Page
Dim page As Page = G_LibDoc.Pages(CInt(locionbuf(0)))
'''Console.WriteLine($"到达节点8耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Dim layer As Layer = page.Layers(CInt(locionbuf(1)))
Dim nlayer As Layer
'''Console.WriteLine($"到达节点7耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shp = layer.Shapes(CInt(locionbuf(2)))
'''Console.WriteLine($"到达节点6耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
If IsNothing(shp) OrElse Not node.TemplateName.Trim.Equals(shp.Name.Trim) Then
RsNode.Status = RedisSendNode.StatusType.TemplateNotExist
RsNode.Msg = "未找到模板信息！！"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode("未找到模板信息！！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
Else
'将模板复制到新文档
'''Console.WriteLine($"到达节点5耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
''Console.WriteLine($"到达节点1耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
InpotMessage1("6、开始拷贝模版图像到目标文件")
shapeCopy(shp)
npage = MLibDoc.Pages(1)
nlayer = MLibDoc.ActiveLayer
''Console.WriteLine($"到达节点2耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
fshp = nlayer.Paste()
InpotMessage1("7、拷贝模版图像到目标文件")
If Not String.IsNullOrEmpty(node.LogoPosition) Then
MaterialPath = M_MaterialPath & node.LogoFileName
If Not File.Exists(MaterialPath) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = $"Logo素材库不存在!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode($"Logo素材库不存在!", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
InpotMessage1("8、查找Logo图像")
Dim cshape, vshape As Shape
G_LibDoc = APP.OpenDocument(MaterialPath, False)
vshape = fshp.Shapes(CInt(node.LogoPosition))
indexbuf = node.LogoIndexNumber.Split("_")
page = G_LibDoc.Pages(CInt(indexbuf(0)))
layer = page.Layers(CInt(indexbuf(1)))
cshape = layer.Shapes(CInt(indexbuf(2)))
InpotMessage1("9、开始拷贝Logo图像")
shapeCopy(cshape)
''Console.WriteLine($"到达节点9耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
cshape = nlayer.Paste()
''Console.WriteLine($"到达节点3耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
'Console.WriteLine($"logo:{cshape.Name} 复制完成{ cshape.LeftX},{cshape.TopY}！")
InpotMessage1("10、拷贝Logo图像到目标文件")
cshape.OrderToFront()
vshape.Visible = True
vshape.Selected = True
x = vshape.CenterX - cshape.CenterX
y = vshape.CenterY - cshape.CenterY
cshape.Move(x, y)
'cshape.SetPosition(vshape.LeftX, vshape.TopY)
'cshape.SetSize(vshape.SizeWidth, vshape.SizeHeight)
'Dim Stretchbuf As (Double, Double) = GetScale(cshape.SizeWidth, cshape.SizeHeight, vshape.SizeWidth, vshape.SizeHeight)
'cshape.Stretch(Stretchbuf.Item1, Stretchbuf.Item2)
Console.WriteLine($"{cshape.Name}_{cshape.CenterX}_{cshape.CenterY}->{vshape.Name}_{vshape.CenterX}_{vshape.CenterY }")
InpotMessage1("11、设置Logo图像在目标文件的为位置")
li.Add((cshape, vshape))
End If
End If
'''Console.WriteLine($"到达节点3耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
Dim ctdic As New List(Of (Shape, Shape))
Dim Uctdic As New Dictionary(Of Integer, List(Of Shape）)
'遍历node.MaterialDic
'APP.EventsEnabled = True
'APP.Optimization = False
'APP.Refresh()
InpotMessage1("12、开始构建单体")
For Each item In node.PatternList
' ''Console.WriteLine(item.ShapeNumber)
'''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
MaterialPath = M_MaterialPath & item.FileName
If Not File.Exists(MaterialPath) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = $"单体素材库不存在!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode($"单体素材库不存在!", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
InpotMessage1($"打开单体所在文件{vbCrLf}{MaterialPath}")
G_LibDoc = APP.OpenDocument(MaterialPath, False)
InpotMessage1($"开始查找单体")
indexbuf = item.ShapeNumber.Split("_")
RsNode.Status = RedisSendNode.StatusType.MaterialPositionNotExist
lhp = fshp.Shapes(CInt(item.IndexNumber))
RsNode.Status = RedisSendNode.StatusType.MaterialNotExist
page = G_LibDoc.Pages(CInt(indexbuf(0)))
layer = page.Layers(CInt(indexbuf(1)))
rhp = layer.Shapes(CInt(indexbuf(2)))
InpotMessage1($"开始拷贝单体{rhp.Name}")
'延时20个毫秒
''Console.WriteLine(rhp.Name)
''Console.WriteLine($"到达节点4耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shapeCopy(rhp)
''Console.WriteLine($"到达节点5耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
rhp = nlayer.Paste()
''Console.WriteLine($"到达节点6耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
rhp.Name = rhp.Name & "_" & item.IndexNumber
'单体先挪到槽位
InpotMessage1($"拷贝单体:{rhp.Name} 到目标文件")
li.Add((rhp, lhp))
'再将素材挪到指定的小槽位
For Each LocationNode In item.LocationList
''Console.WriteLine(LocationNode.ShapeNumber)
If LocationNode.ShapeType = 0 Then
InpotMessage1($"开始创建字体图像:{LocationNode.ShapeNumber} 到目标文件")
Dim remark As String() = LocationNode.Remark.Split("_")
clhp = rhp.Shapes(CInt(LocationNode.IndexNumber))
chp = CreateTextImage1(nlayer, LocationNode.ShapeNumber, LocationNode)
If IsNothing(chp) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = "生成文本图像失败!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode("生成文本图像失败！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
InpotMessage1($"创建字体图像:{LocationNode.ShapeNumber} 到目标文件")
chp.Name = chp.Name & "_" & item.IndexNumber & "_" & LocationNode.IndexNumber
ctdic.Add((chp, clhp))
If Not String.IsNullOrEmpty(LocationNode.LineNumber) Then
Dim chpli As List(Of Shape)
Dim LineNumber As Integer = CInt(LocationNode.LineNumber)
If Uctdic.ContainsKey(LineNumber) Then
chpli = Uctdic(LineNumber)
chpli.Add(chp)
Else
chpli = New List(Of Shape)
chpli.Add(chp)
Uctdic.Add(LineNumber, chpli)
End If
End If
Else
MaterialPath = M_MaterialPath & LocationNode.FileName
InpotMessage1($"开始检测素材库文件是否存在:{MaterialPath} ")
If Not File.Exists(MaterialPath) Then
RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
RsNode.Msg = $"图标素材库不存在!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
gLogNode = New LogNode($"图标素材库不存在!", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End If
InpotMessage1($"打开素材库文件:{MaterialPath} ")
G_LibDoc = APP.OpenDocument(MaterialPath, False)
InpotMessage1($"开始查找素材 ")
clhp = rhp.Shapes(CInt(LocationNode.IndexNumber))
indexbuf = LocationNode.ShapeNumber.Split("_")
page = G_LibDoc.Pages(CInt(indexbuf(0)))
layer = page.Layers(CInt(indexbuf(1)))
chp = layer.Shapes(CInt(indexbuf(2)))
InpotMessage1($"开始拷贝素材 ")
'延时10个毫秒
'延时20个毫秒
'''Console.WriteLine($"到达节点7耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
''Console.WriteLine(chp.Name)
'延时50ms
''Console.WriteLine($"到达节点8耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
shapeCopy(chp)
''Console.WriteLine($"到达节点9耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
chp = nlayer.Paste()
InpotMessage1($"拷贝素材 {chp.Name}到目标文件")
'Dim chpcolor As New VGCore.color '
Dim chpcolor As Color = New Color
Dim colorint As (Integer, Integer, Integer) = HexToRgb(LocationNode.ShapeColor)
chpcolor.RGBAssign(colorint.Item1, colorint.Item2, colorint.Item3)
Dim chpcolor1 As IVGColor = chp.Fill.UniformColor
chp.Fill.ApplyUniformFill(chpcolor)
InpotMessage1($"设置素材 {chp.Name}图像颜色")
''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
chp.Name = chp.Name & "_" & item.IndexNumber & "_" & LocationNode.IndexNumber
ctdic.Add((chp, clhp))
End If
Next
'这里要先把单体移到对应位置
InpotMessage1($"开始设置单体位置")
rhp.OrderToFront()
lhp.Visible = True
x = lhp.CenterX - rhp.CenterX
y = lhp.CenterY - rhp.CenterY
rhp.Move(x, y)
clhp = rhp.Shapes(rhp.Shapes.Count)
clhp.Delete() ' = False
'将替换的元素移到对应位置
InpotMessage1($"开始设置该单体内的素材图像位置")
For Each nitem In ctdic
nitem.Item1.OrderToFront()
x = nitem.Item2.CenterX - nitem.Item1.CenterX
y = nitem.Item2.CenterY - nitem.Item1.CenterY
nitem.Item1.Move(x, y)
'ctdic.Add((chp, clhp))
'item.Item1.Selected = True
nitem.Item2.Delete()
InpotMessage1($"设置素材{nitem.Item1.Name} 图像位置")
Next
ctdic.Clear()
'对齐
Dim topl As Single = 0
InpotMessage1($"开始设素材图像顶部对齐")
For Each Uitem In Uctdic
For i = 0 To Uitem.Value.Count - 1
If i = 0 Then
topl = Uitem.Value(0).TopY
End If
Uitem.Value(i).TopY = topl
Next
Next
InpotMessage1($"素材图像顶部对齐完毕")
Uctdic.Clear()
Next
'''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
RsNode.Status = RedisSendNode.StatusType.BuildImageFail
InpotMessage1($"开始删除单体槽位")
For Each mitem In li
'Console.WriteLine(mitem.Item1.Name)
'Console.WriteLine(mitem.Item2.Name)
mitem.Item2.Delete()
Next
InpotMessage1($"单体槽位删除完毕")
li.Clear()
'''Console.WriteLine($"到达节点4耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
'Dim sr As ShapeRange = APP.ActiveSelectionRange
InpotMessage1($"13、开始组合整个图像")
fshp = nlayer.Shapes.All().Group()
'shp = sr.Group()
fshp.Name = node.TemplateName
'page = G_LibDoc.Pages(CInt(locionbuf(0)))
'SetIconToCentered(page, shp)
'''Console.WriteLine($"到达节点11耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
RsNode.Status = RedisSendNode.StatusType.SaveFileFail
fshp.Selected = True
InpotMessage1($"14、开始将整个图像移动至中心位置")
SetIconToCentered(npage, fshp)
'Dim sel As ShapeRange = APP.ActiveSelectionRange
APP.EventsEnabled = True
APP.Optimization = False
APP.Refresh()
'fshp.SetSize(Math.Abs(fshp.SizeWidth) * 10000, Math.Abs(fshp.SizeHeight) * 10000)
InpotMessage1($"15、开始保存图像成文件")
'0-预览小图 1-生成文件
Select Case node.Process
Case 0
ProjectPath = $"{ProjectPath}\{node.TemplateName.Replace("Mode_", "")}_{Now:yyyyMMddHHmmss}.png"
Dim Ef As ExportFilter = MLibDoc.ExportBitmap(ProjectPath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
RsNode.ImagePath = ProjectPath.Replace(ServerFilePath, "")
Case 1
ProjectPath = $"{ProjectPath}\{node.TemplateName.Replace("Mode_", "")}_{Now:yyyyMMddHHmmss}.cdr"
Dim ssao As New StructSaveAsOptions
ssao.Filter = VGCore.cdrFilter.cdrCDR
ssao.Range = VGCore.cdrExportRange.cdrSelection
MLibDoc.SaveAs(ProjectPath, ssao)
InpotMessage1($"16、保存图像成plt文件")
ProjectPath = ProjectPath.Replace(".cdr", ".plt")
'ssao.Filter = VGCore.cdrFilter.cdrPLT
'ssao.Range = VGCore.cdrExportRange.cdrSelection
'MLibDoc.FullFileName = ProjectPath
'MLibDoc.SaveAs(ProjectPath, ssao)
'fshp.SizeWidth = fshp.SizeWidth * 10000
'fshp.SizeHeight = fshp.SizeHeight * 10000
Dim originalUnit As cdrUnit
originalUnit = MLibDoc.Unit
' 将文档单位设置为毫米
MLibDoc.Unit = VGCore.cdrUnit.cdrMillimeter
'1. 宽高（mm）
Dim wMm As Double = Format(fshp.SizeWidth, "0.000")
Dim hMm As Double = Format(fshp.SizeHeight, "0.000")
fshp.GetSize(wMm, hMm)
hMm = (hMm * 100) ' / 304.8
wMm = (wMm * 100) '/ 304.8
'fshp.Scale
'fshp.SizeWidth = wMm
'fshp.SizeHeight = hMm
'fshp.SetSizeEx(fshp.CenterX, fshp.CenterY, wMm, hMm)
fshp.SetSize(wMm, hMm)
'4. 打印
Console.WriteLine($"宽 : {wMm:F2} mm")
Console.WriteLine($"高 : {hMm:F2} mm")
'Console.WriteLine($"X 放大倍数: {scaleX:F2}")
'Console.WriteLine($"Y 放大倍数: {scaleY:F2}")
'Console.WriteLine($"比例锁定 : {locked}")
Dim opt As New StructExportOptions
opt.MaintainAspect = True
'opt.ResolutionX = 100
'opt.ResolutionY = 100
'opt.SizeX = wMm
'opt.SizeY = hMm
opt.AntiAliasingType = VGCore.cdrAntiAliasingType.cdrSupersampling
'MLibDoc.Export(ProjectPath, VGCore.cdrFilter.cdrPLT, VGCore.cdrExportRange.cdrSelection, opt)
Dim Ef As ExportFilter = MLibDoc.ExportEx(ProjectPath, VGCore.cdrFilter.cdrPLT, VGCore.cdrExportRange.cdrSelection, opt)
Ef.Finish()
RsNode.CdrPath = ProjectPath.Replace(ServerFilePath, "")
Case Else
MLibDoc.Close()
G_LibDoc.Close()
RsNode.Status = RedisSendNode.StatusType.UnknownFail
RsNode.Msg = "位置操作!!"
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
Return False
End Select
InpotMessage1($"16、保存图像成文件完成")
G_LibDoc.Close()
MLibDoc.Close()
RsNode.Status = RedisSendNode.StatusType.Success
RsNode.Msg = "Ok"
InpotMessage1($"17、关闭素材库和目标文件")
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
InpotMessage1($"18、向Redis写入生成成功信息")
Return True
Catch ex As Exception
APP.EventsEnabled = True
APP.Optimization = False
APP.Refresh()
Select Case RsNode.Status
Case RedisSendNode.StatusType.MaterialPositionNotExist
RsNode.Msg = "素材位置不存在!!"
Case RedisSendNode.StatusType.MaterialNotExist
RsNode.Msg = "素材不存在!!"
Case RedisSendNode.StatusType.BuildImageFail
RsNode.Msg = "生成图像失败!!"
Case RedisSendNode.StatusType.SaveFileFail
RsNode.Msg = "保存文件失败!!"
End Select
RedisPublishMessage1(RsNode.PictureNum, JsonConvert.SerializeObject(RMNode))
If Not IsNothing(MLibDoc) Then
MLibDoc.Close()
End If
If Not IsNothing(G_LibDoc) Then
G_LibDoc.Close()
End If
gLogNode = New LogNode($"{RsNode.Msg}{vbCrLf}{ex.Message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End Try
End Function
''' <summary>
''' 计算缩放因子
''' </summary>
''' <param name="imgW">图像原始宽度</param>
''' <param name="imgH">图像原始高度</param>
''' <param name="slotW">槽位宽度</param>
''' <param name="slotH">槽位高度</param>
''' <param name="mode">0=填满 1=完整 2=拉伸</param>
''' <returns>（scaleX, scaleY）</returns>
Public Function GetScale(imgW As Double, imgH As Double, slotW As Double, slotH As Double, Optional mode As Integer = 1) As (Double, Double)
Dim sx As Double = slotW / imgW
Dim sy As Double = slotH / imgH
' Return mode switch
'{
' 0 => (Math.Max(sx, sy), Math.Max(sx, sy)), // 填满（保持比例）
' 1 => (Math.Min(sx, sy), Math.Min(sx, sy)), // 完整（保持比例）
' 2 => (sx, sy), // 强制拉伸
' _ => (sx, sy)
'};
Select Case mode
Case 0
Return (Math.Max(sx, sy), Math.Max(sx, sy))
Case 1
Return (Math.Min(sx, sy), Math.Min(sx, sy))
Case 2
Return (sx, sy)
Case Else
Return (sx, sy)
End Select
End Function
'創建字體圖像
Public Function CreateTextImage(nlayer As Layer, ShapeNumber As String, remark As String()) As Shape
Dim chp As Shape
Dim txtsize As Single
If Not txtsize.TryParse(remark(1), txtsize) Then
Return Nothing
End If
Try
chp = nlayer.CreateArtisticText(0, 0, ShapeNumber, cdrTextLanguage.cdrLanguageNone, cdrTextCharSet.cdrCharSetDefault, remark(0), txtsize, cdrFontStyle.cdrNormalFontStyle)
'chp = nlayer.CreateArtisticText(0, 0, ShapeNumber, cdrTextLanguage.cdrLanguageNone, cdrTextCharSet.cdrCharSetDefault, remark(0), txtsize, cdrFontStyle.cdrNormalFontStyle)
'Dim chpcolor As New VGCore.Color
Dim chpcolor As Color = New Color
chpcolor.RGBAssign(255, 255, 255)
chp.Fill.ApplyUniformFill(chpcolor)
Return chp
Catch ex As Exception
Return Nothing
End Try
End Function
'創建字體圖像
Public Function CreateTextImage2(nlayer As Layer, ShapeNumber As String, remark As String()) As Shape
Dim chp As Shape
Dim txtsize As Single
If Not txtsize.TryParse(remark(1), txtsize) Then
Return Nothing
End If
Try
chp = nlayer.CreateArtisticText(0, 0, ShapeNumber, cdrTextLanguage.cdrLanguageNone, cdrTextCharSet.cdrCharSetDefault, remark(0), txtsize, cdrFontStyle.cdrNormalFontStyle)
'chp = nlayer.CreateArtisticText(0, 0, ShapeNumber, cdrTextLanguage.cdrLanguageNone, cdrTextCharSet.cdrCharSetDefault, remark(0), txtsize, cdrFontStyle.cdrNormalFontStyle)
'Dim chpcolor As New VGCore.Color
Dim chpcolor As Color = New Color
chpcolor.RGBAssign(0, 0, 0)
chp.Fill.ApplyUniformFill(chpcolor)
Return chp
Catch ex As Exception
Return Nothing
End Try
End Function
Public Function CreateTextImage1(nlayer As Layer, ShapeNumber As String, LocationNode As LocationList) As Shape
Dim chp As Shape
Dim txtsize As Single
If Not txtsize.TryParse(LocationNode.ShapeFontSize, txtsize) Then
Return Nothing
End If
Try
chp = nlayer.CreateArtisticText(0, 0, ShapeNumber, cdrTextLanguage.cdrLanguageNone, cdrTextCharSet.cdrCharSetDefault, LocationNode.ShapeFont, txtsize, cdrFontStyle.cdrNormalFontStyle)
'chp = nlayer.CreateArtisticText(0, 0, ShapeNumber, cdrTextLanguage.cdrLanguageNone, cdrTextCharSet.cdrCharSetDefault, remark(0), txtsize, cdrFontStyle.cdrNormalFontStyle)
'Dim chpcolor As New VGCore.Color
Dim chpcolor As Color = New Color
Dim colorint As (Integer, Integer, Integer) = HexToRgb(LocationNode.ShapeColor)
chpcolor.RGBAssign(colorint.Item1, colorint.Item2, colorint.Item3)
chp.Fill.ApplyUniformFill(chpcolor)
chp.ConvertToCurves()
Return chp
Catch ex As Exception
Return Nothing
End Try
End Function
Public Sub shapeCopy(shp As Shape)
Try
shp.Copy()
Catch ex As Exception
''Console.WriteLine($"图像[{shp.Name}]复制失败！")
shapeCopy(shp)
End Try
End Sub
'处理节点信息
'Public Function HandleNodeInformation(node As RedisInfoNode) As Boolean
' Dim gLogNode As LogNode
' Dim ProjectPath As String
' Dim MaterialPath As String = M_MaterialPath & node.MaterialLibraryName
' Dim RsNode As New RedisSendNode
' RsNode.User = node.User
' RsNode.ProjectName = node.ProjectName
' RsNode.ProjectId = node.ProjectId
' RsNode.PictureNum = node.PictureNum
' Dim oldTime As DateTime = Now
' '判断素材库是否存在
' If Not File.Exists(MaterialPath) Then
' 'MsgBox("素材库不存在")
' RsNode.Status = RedisSendNode.StatusType.MaterialLibraryNotExist
' RsNode.Msg = "素材库不存在!"
' RedisPublishMessage(JsonConvert.SerializeObject(RsNode))
' gLogNode = New LogNode("素材库不存在", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
' gLogNode.SetLogColor(System.Drawing.Color.Red)
' G_Log.AddLogNode(gLogNode)
' Return False
' End If
' ProjectPath = $"{M_TplPath}{node.ProjectName}\{Now:yyyyMMdd}"
' '判断项目文件夹是否存在
' If Not Directory.Exists(ProjectPath) Then
' 'MsgBox("项目文件夹不存在")
' '创建文件夹
' Directory.CreateDirectory(ProjectPath)
' End If
' '''Console.WriteLine($"到达节点1耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' ' Dim srcDoc As Document '素材文件
' Dim NewDoc As Document '成平文件
' Dim destLayer As Layer
' Dim shp As Shape = Nothing
' Dim dic As Dictionary(Of String, (Integer, Integer, Integer))
' 'Dim app As New Application() '打开CorelDRAW并显示
' '''Console.WriteLine($"到达节点2耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' Try
' 'Thread.Sleep(2000)
' 'APP.documents.CloseAll()
' '打开素材文件
' '''Console.WriteLine($"到达节点11耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' 'Thread.Sleep(500)
' '创建新的成平文件
' NewDoc = APP.CreateDocument()
' '''Console.WriteLine($"到达节点10耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' '查询素材数据并以键值对保存
' dic = Gettbl_iconlibrary(node.MaterialLibraryName)
' If IsNothing(dic) OrElse dic.Count = 0 Then
' RsNode.Status = RedisSendNode.StatusType.GetMaterialFromDBFail
' RsNode.Msg = $"获取数据库素材失败！"
' RedisPublishMessage(JsonConvert.SerializeObject(RsNode))
' Return False
' End If
' '''Console.WriteLine($"到达节点3耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' 'Thread.Sleep(500)
' destLayer = NewDoc.Pages(1).Layers(2)
' If queryThenIconTonewDoc(node.TemplateName, dic, G_LibDoc, destLayer, NewDoc.Pages(1)) Then
' '''Console.WriteLine($"到达节点4耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' For Each item In node.MaterialDic
' If queryThenIconTonewDoc(item.Value, dic, G_LibDoc, destLayer) Then
' '''Console.WriteLine($"到达节点5耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' If ReplaceTheCorrespondingImage(node.TemplateName, item.Key, item.Value, destLayer) Then
' NewDoc.Close()
' RsNode.Status = RedisSendNode.StatusType.MaterialPositionNotExist
' RsNode.Msg = $"未找到素材放置位置:'{item.Key}' ！"
' RedisPublishMessage(JsonConvert.SerializeObject(RsNode))
' gLogNode = New LogNode($"未找到素材放置位置:'{item.Key}' ！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
' gLogNode.SetLogColor(System.Drawing.Color.Red)
' G_Log.AddLogNode(gLogNode)
' Return False
' End If
' Else
' NewDoc.Close()
' RsNode.Status = RedisSendNode.StatusType.MaterialNotExist
' RsNode.Msg = $"未找到素材:'{item.Value}' !"
' RedisPublishMessage(JsonConvert.SerializeObject(RsNode))
' gLogNode = New LogNode($"未找到素材:'{item.Value}' ！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
' gLogNode.SetLogColor(System.Drawing.Color.Red)
' G_Log.AddLogNode(gLogNode)
' Return False
' End If
' Next
' '''Console.WriteLine($"到达节点6耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' Else
' NewDoc.Close()
' RsNode.Status = RedisSendNode.StatusType.TemplateNotExist
' RsNode.Msg = $"未找到模板'{node.TemplateName}'！！"
' RedisPublishMessage(JsonConvert.SerializeObject(RsNode))
' gLogNode = New LogNode($"未找到模板'{node.TemplateName}'！！", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
' gLogNode.SetLogColor(System.Drawing.Color.Red)
' G_Log.AddLogNode(gLogNode)
' Return False
' End If
' SetIconName(node.TemplateName, destLayer)
' destLayer.SelectableShapes.All.Group().Name = node.TemplateName
' '''Console.WriteLine($"到达节点7耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' ProjectPath = $"{ProjectPath}\{node.TemplateName.Replace("Mode_", "")}_{Now:yyyyMMddHHmmss}.cdr"
' MaterialPath = ProjectPath.Replace(".cdr", ".jpg")
' '// 4) 导出 JPG
' Dim Ef As ExportFilter = NewDoc.ExportBitmap(MaterialPath, VGCore.cdrFilter.cdrPNG)
' Ef.Finish()
' NewDoc.SaveAs(ProjectPath)
' '''Console.WriteLine($"到达节点8耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' NewDoc.Close()
' RsNode.ImagePath = MaterialPath
' RsNode.CdrPath = ProjectPath
' RsNode.Status = RedisSendNode.StatusType.Success
' RsNode.Msg = "成功"
' RedisPublishMessage(JsonConvert.SerializeObject(RsNode))
' gLogNode = New LogNode($"'{node.TemplateName.Replace("Mode_", "")}'图像文件生成完毕！！！", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
' 'gLogNode.SetLogColor(System.Drawing.Color.Red)
' G_Log.AddLogNode(gLogNode)
' '''Console.WriteLine($"到达节点9耗时：{(Now - oldTime).TotalMilliseconds}毫秒")
' Return True
' Catch ex As Exception
' If Not IsNothing(NewDoc) Then
' ' NewDoc.Close()
' End If
' gLogNode = New LogNode(ex.Message, RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
' gLogNode.SetLogColor(System.Drawing.Color.Red)
' G_Log.AddLogNode(gLogNode)
' Return False
' End Try
' Return True
'End Function
'将hex转为rgb
Public Function HexToRgb(hex As String) As (Integer, Integer, Integer)
Try
If String.IsNullOrEmpty(hex) Then Return (255, 255, 255)
Dim r As Integer = Convert.ToInt32(hex.Substring(1, 2), 16)
Dim g As Integer = Convert.ToInt32(hex.Substring(3, 2), 16)
Dim b As Integer = Convert.ToInt32(hex.Substring(5, 2), 16)
Return (r, g, b)
Catch ex As Exception
Return (255, 255, 255)
End Try
End Function
Public Function Gettbl_iconlibrary(Version As String) As Dictionary(Of String, (Integer, Integer, Integer))
Dim dic As New Dictionary(Of String, (Integer, Integer, Integer))
Dim npgsqldb As DbExecutor = New DbExecutor(DbExecutor.DbTypeEnum.Mysql, LocalConnString)
Dim gLogNode As LogNode
'将列表中的数据库语句组装成事务语句
Dim transStr As String = $"select * from `Cdr_library`.`tbl_iconlibrary` where `Version` ='{Version}';"
'插入数据库
' Using db As New DbExecutor(DbExecutor.DbTypeEnum.npgsql, LocalConnString)
Dim dt As DataTable
Try
npgsqldb.Open()
' npgsqldb.ExecuteDataTable(transStr)
dt = npgsqldb.ExecuteDataTable(transStr)
'遍历行添加数据到dic
For Each row As DataRow In dt.Rows
If Not dic.ContainsKey(row("KeyName").ToString()) Then
dic.Add(row("KeyName").ToString(), (row("PageNumber"), row("LayerNumber"), row("Shapenumber")))
Else
dic.Item(row("KeyName").ToString()) = (row("PageNumber"), row("LayerNumber"), row("Shapenumber"))
End If
Next
npgsqldb.Close()
Catch ex As Exception
If Not IsNothing(npgsqldb) Then
npgsqldb.Close()
End If
'AddLogMessage($"写入酒店日志异常！")
gLogNode = New LogNode($"获取素材失败!{vbCrLf}{ex.Message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return Nothing
End Try
'gLogNode = New LogNode($"获取素材成功!{vbCrLf}", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
''gLogNode.SetLogColor(System.Drawing.Color.Red)
'G_Log.AddLogNode(gLogNode)
Return dic
End Function
Public Sub SetIconToCentered(page As Page, nshape As Shape)
Dim totalW As Double, totalH As Double
totalW = page.SizeWidth
totalH = page.SizeHeight
Dim docCX As Double, docCY As Double
docCX = totalW / 2
docCY = totalH / 2
nshape.SetPosition(docCX - nshape.SizeWidth / 2, totalH - nshape.SizeHeight / 2)
'nshape.CenterX = page.Width / 2
'nshape.CenterY = page.Height / 2
'nshape.Move(docCX, docCY)
End Sub
''' <summary>
'''
''' </summary>
''' <param name="iconnameA">被替换的图像</param>
''' <param name="iconnameB">用来替换的图像名</param>
''' <param name="destLayer"></param>
''' <returns></returns>
'替换对应图像
Public Function ReplaceTheCorrespondingImage(TemplateName As String, iconnameA As String, iconnameB As String, destLayer As Layer) As Boolean
Dim gLogNode As LogNode
Dim shpA, shpB As Shape
Dim x#, y#, w#, h#
Dim dx As Double, dy As Double
For Each shp As Shape In destLayer.Shapes
'''Console.WriteLine(shp.Name)
If shp.Name.Equals(TemplateName.Trim) Then
For Each shp2 As Shape In shp.Shapes
If shp2.Name.Equals(iconnameA.Trim) Then
shpA = shp2
Exit For
End If
Next
End If
If shp.Name.Equals(iconnameB.Trim) Then
shpB = shp
End If
Next
If shpA Is Nothing Then
Return False
End If
If shpB Is Nothing Then
Return True
End If
x = shpA.CenterX - shpB.CenterX
y = shpA.CenterY - shpB.CenterY
dx = shpA.LeftX
dy = shpA.TopY
'''Console.WriteLine(shpA.Name)
shpB.Move(x, y)
shpA.Delete()
End Function
'设置图像名称
Public Function SetIconName(iconname As String, destLayer As Layer) As Boolean
For Each shp As Shape In destLayer.Shapes
If shp.Name.Equals(iconname.Trim) Then
If shp.Type = cdrShapeType.cdrGroupShape Then
shp.Ungroup()
End If
End If
Next
End Function
''' <summary>
''' 查找图像并拷贝到目标图层 中
''' </summary>
''' <param name="iconname"></param>
''' <param name="srcDoc"></param>
''' <param name="NewDoc"></param>
''' <returns></returns>
Public Function queryThenIconTonewDoc(iconname As String, dic As Dictionary(Of String, (Integer, Integer, Integer)), srcDoc As Document, destLayer As Layer, Optional fpage As Page = Nothing) As Boolean
If String.IsNullOrEmpty(iconname) Then Return True
Dim val As (Integer, Integer, Integer)
Dim nshape As Shape
If dic.ContainsKey(iconname.Trim) Then
val = dic(iconname.Trim)
Else
Return False
End If
Dim page As Page = srcDoc.Pages(val.Item1)
Dim layer As Layer = page.Layers(val.Item2)
Dim shape As Shape = layer.Shapes(val.Item3)
' srcDoc.Pages(val.Item1).Layers(val.Item2).Shapes(val.Item3).Copy()
'nshape.Copy()
shape.Copy()
nshape = destLayer.Paste()
If Not IsNothing(fpage) Then
SetIconToCentered(fpage, nshape)
End If
Return True
'遍历素材文件内的所有图层
'For Each nPage As Page In srcDoc.Pages
' '''Console.WriteLine(nPage.Name)
' '遍历图层内的所有图像
' For Each Layer As Layer In nPage.Layers
' '''Console.WriteLine(Layer.Name)
' For Each Shape As Shape In Layer.Shapes
' '''Console.WriteLine(Shape.Name)
' '判断模板图像是否存在
' If Shape.Name.Equals(iconname.Trim) Then
' Shape.Copy()
' nshape = destLayer.Paste()
' If Not IsNothing(fpage) Then
' SetIconToCentered(fpage, nshape)
' End If
' Return True
' End If
' Next
' Next
'Next
'Return False
End Function
'获取系统缓存参数
Public Sub GetSeting()
'刷新系统缓存
My.Settings.Reload()
'获取系统缓存参数
'ComboBox1.Text = My.Settings.SerialPortName
'ComboBox2.Text = My.Settings.BaudRate
If My.Settings.THigh = 0 OrElse My.Settings.TWide = 0 Then
Else
Me.Height = My.Settings.THigh
Me.Width = My.Settings.TWide
End If
G_Subscribe = My.Settings.G_Subscribe
G_Publish = My.Settings.G_Publish
ToolStripTextBox2.Text = G_Subscribe
ToolStripTextBox1.Text = G_Publish
'Dim dic As Dictionary(Of Integer, (String, String, String))
'dic = JsonConvert.DeserializeObject(Of Dictionary(Of Integer, (String, String, String)))(My.Settings.GTable)
'If IsNothing(dic) OrElse dic.Count = 0 Then Return
'JsonConvert.SerializeObject(m_Applicationconfig)
End Sub
'保存系统缓存参数
Public Sub SaveSeting()
'刷新系统缓存
My.Settings.Reload()
'获取系统缓存参数
'My.Settings.SerialPortName = ComboBox1.Text
'My.Settings.BaudRate = ComboBox2.Text
My.Settings.THigh = Me.Height
My.Settings.TWide = Me.Width
My.Settings.G_Subscribe = G_Subscribe
My.Settings.G_Publish = G_Publish
Dim dic As New Dictionary(Of Integer, (String, String, String))
'My.Settings.GTable = JsonConvert.SerializeObject(dic)
My.Settings.Save()
End Sub
Public Sub initRedisPublisher()
If Not IsNothing(G_Redislish) AndAlso G_Redislish.IsConnected Then
G_Redislish.CloseConnection()
End If
' 替换为你的 Redis 连接字符串
'Dim connectionString = "127.0.0.1:6379"
Try
G_Redislish = New RedisSubscriber(M_Redisip, M_Redisport, M_Redispassword)
Catch ex As Exception
MsgBox($"redis发布初始化失败:{ex.Message}")
End Try
End Sub
Public Sub RedisPublishMessage(message As String)
If String.IsNullOrEmpty(G_Publish) Then
MsgBox("未设置发布频道")
Return
End If
If String.IsNullOrEmpty(message) Then
MsgBox("未输入发布内容")
Return
End If
If G_Redislish.IsConnected Then
Dim gLogNode As LogNode
Try
G_Redislish.PublishMessage(G_Publish, message)
gLogNode = New LogNode($"Redis:{G_Publish}: {message}", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
G_Log.AddLogNode(gLogNode)
Catch ex As Exception
'MsgBox($"redis发布失败:{ex.Message}")
gLogNode = New LogNode(ex.Message, RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
End Try
Else
MsgBox("redis未连接")
End If
End Sub
Public Sub RedisPublishMessage1(key As String, message As String)
If String.IsNullOrEmpty(G_Publish) Then
MsgBox("未设置发布频道")
Return
End If
If String.IsNullOrEmpty(message) Then
MsgBox("未输入发布内容")
Return
End If
Dim gLogNode As LogNode
Try
Dim config As ConfigurationOptions = New ConfigurationOptions()
config.EndPoints.Add(M_Redisip, M_Redisport) ' 设置Redis服务器地址和端口
config.Password = M_Redispassword ' 设置Redis密码
config.AbortOnConnectFail = False ' 连接失败时不中止
Dim conn = ConnectionMultiplexer.Connect(config)
Dim db = conn.GetDatabase(0)
db.StringSet(key, message)
gLogNode = New LogNode($"Redis:{G_Publish}: {message}", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
G_Log.AddLogNode(gLogNode)
Catch ex As Exception
'MsgBox($"redis发布失败:{ex.Message}")
gLogNode = New LogNode(ex.Message, RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
End Try
End Sub
Private Sub ToolStripButton4_Click(sender As Object, e As EventArgs) Handles ToolStripButton4.Click
If String.IsNullOrEmpty(ToolStripTextBox2.Text) Then
MsgBox("请输入订阅频道")
Return
Else
G_OldSubscribe = G_Subscribe
G_Subscribe = ToolStripTextBox2.Text.Trim
End If
If String.IsNullOrEmpty(ToolStripTextBox1.Text) Then
MsgBox("请输入发布频道")
Return
Else
G_Publish = ToolStripTextBox1.Text.Trim
End If
initRedisSubscriber(G_Subscribe, G_OldSubscribe)
initRedisPublisher()
End Sub
Public Sub initRedisSubscriber(Subscribe As String, OldSubscribe As String)
If String.IsNullOrEmpty(Subscribe) Then
MsgBox("未设置订阅频道")
Return
End If
If Not IsNothing(G_RedisSub) AndAlso G_RedisSub.IsConnected Then
' 取消订阅并关闭连接
G_RedisSub.UnsubscribeFromChannel(OldSubscribe)
G_RedisSub.CloseConnection()
End If
' 替换为你的 Redis 连接字符串
' Dim connectionString = "127.0.0.1:10079,password="
Try
G_RedisSub = New RedisSubscriber(M_Redisip, M_Redisport, M_Redispassword)
' 定义消息处理程序
Dim messageHandler As Action(Of RedisChannel, RedisValue) = Sub(channel, message)
'将消息输出添加到队列
Dim gLogNode As LogNode
Dim g_CallInfoNode As RedisMsgNode
Try
g_CallInfoNode = JsonConvert.DeserializeObject(Of RedisMsgNode)(message)
Catch ex As Exception
'MsgBox($"消息解析失败:{ex.Message}")
gLogNode = New LogNode(ex.Message, RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End Try
If IsNothing(g_CallInfoNode) Then
gLogNode = New LogNode($"【序列化失败】Redis:{channel}: {message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
gLogNode = New LogNode($"Redis:{channel}: {message}", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
G_Log.AddLogNode(gLogNode)
M_RedisQueue.Enqueue(g_CallInfoNode)
'RuningLog.OutputLogsToTheControl(RichTextBox1, New RuningLogConfig($"Redis接收到来自 {channel} 的消息: {message}", System.Drawing.Color.DarkOrange, 12), 1)
''''Console.WriteLine($"接收到来自 {channel} 的消息: {message}")
End Sub
' 订阅频道
G_RedisSub.SubscribeToChannel(Subscribe, messageHandler)
Catch ex As Exception
MsgBox($"订阅失败:{ex.Message}")
End Try
'' 发布消息示例
''''Console.WriteLine("发布测试消息...")
'G_RedisSub.PublishMessage("testChannel", "Hello from publisher!")
'' 保持程序运行以接收更多消息
''''Console.WriteLine("按任意键退出...")
'''Console.ReadKey()
End Sub
Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
If RichTextBox1.Lines.Length > 2147000000 Then
RichTextBox1.Clear()
End If
End Sub
Private Sub ToolStripButton3_Click(sender As Object, e As EventArgs) Handles ToolStripButton3.Click
RichTextBox1.Clear()
Dim dic As New Dictionary(Of String, String)
'dic.Add("a", "1")
''将dic 序列化成字符串
'Dim json As String = JsonConvert.SerializeObject(dic)
''控制台输出(json)
''''Console.WriteLine(json)
End Sub
Private Sub CorelDRAW_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
SaveSeting()
RedisClose()
If Not IsNothing（M_EventThread） AndAlso M_EventThread.IsAlive Then
M_EventThread.Abort()
End If
If Not IsNothing（G_Log） Then
G_Log.CloseThread()
End If
End Sub
'关闭redis
Public Sub RedisClose()
If Not IsNothing(G_RedisSub) AndAlso G_RedisSub.IsConnected Then
G_RedisSub.UnsubscribeFromChannel(G_Subscribe)
G_RedisSub.CloseConnection()
End If
If Not IsNothing(G_Redislish) AndAlso G_Redislish.IsConnected Then
G_Redislish.CloseConnection()
End If
End Sub
Private Sub ToolStripButton1_Click_1(sender As Object, e As EventArgs) Handles ToolStripButton1.Click
'打开文件选择器 选择cDR后缀的文件
Dim ServerFilePath As String = "R:\IIS ROOT\BLWLog\Web\wwwroot\PanelSelectionPic" ' "D:\IIS ROOT\BLWLog\Web\wwwroot\PanelSelectionPic" '
Dim OpenFileDialog1 As New OpenFileDialog()
OpenFileDialog1.Filter = "CorelDRAW Files (*.cdr)|*.cdr"
Dim srcDoc As Document '素材文件
Dim MaterialPath As String
Dim strbuf() As String
Dim li As New List(Of String)
Dim Version As String
Dim Location As String
Dim icontype As Integer
Dim pint, lint, Sint, Locationint, nsint, typeid As Integer
Dim gLogNode As LogNode
Dim ProjectPath As String
Dim SafeFileName As String
If OpenFileDialog1.ShowDialog() = DialogResult.OK Then
Dim fid As Integer = AddFileToSQL(OpenFileDialog1.SafeFileName)
If fid = -1 Then
gLogNode = New LogNode($"获取FId失败，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
'创建以文件名去除后缀 命名的文件夹
SafeFileName = OpenFileDialog1.SafeFileName.Substring(0, OpenFileDialog1.SafeFileName.LastIndexOf("."))
ProjectPath = ServerFilePath & "\" & SafeFileName
If Not Directory.Exists(ProjectPath) Then
Directory.CreateDirectory(ProjectPath)
End If
If Not Directory.Exists(ProjectPath & "\iconlibrary\") Then
Directory.CreateDirectory(ProjectPath & "\iconlibrary\")
End If
MaterialPath = OpenFileDialog1.FileName
srcDoc = APP.OpenDocument(MaterialPath, False)
'Version=文件名称
Version = srcDoc.Name
'遍历素材文件内的所有图层
Dim nshape As Shape
pint = 0
lint = 0
Sint = 0
nsint = 0
Dim xm, hm, wm As Double
Dim modeindex As Integer = 0
'遍历所有页
For Each nPage As Page In srcDoc.Pages
'''Console.WriteLine("PAGE:" & nPage.Name)
pint = pint + 1
lint = 0
'遍历图层内的所有图层
For Each Layer As Layer In nPage.Layers
'''Console.WriteLine("Layer:" & Layer.Name)
lint = lint + 1
Sint = 0
'遍历图层内的所有形状
For Each Shape As Shape In Layer.Shapes
Sint = Sint + 1
If String.IsNullOrEmpty(Shape.Name) Then Continue For
'''Console.WriteLine("Shape:" & Shape.Name)
strbuf = Shape.Name.Split("_")
If strbuf.Length < 2 Then Continue For
Location = $"{pint}_{lint}_{Sint}"
Select Case strbuf(0).ToLower
Case "Mode".ToLower
Dim modepath As String = $"{ProjectPath}\Mode\"
If Not Directory.Exists(modepath) Then
Directory.CreateDirectory(modepath)
End If
Dim Direction As String
Direction = strbuf(1).Replace("连体", "").Trim
If Not Double.TryParse(Direction, xm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
If Not Double.TryParse(strbuf(4), wm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
If Not Double.TryParse(strbuf(5), hm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
If strbuf(2).Equals("横向") OrElse strbuf(2).Equals("竖向") Then
Direction = strbuf(2).Trim
Else
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
modepath = $"{SafeFileName}\Mode\{Shape.Name}.png"
nsint = AddModeToSql(Shape.Name, fid, Location, Direction, xm, wm, hm, strbuf(3), modepath)
modepath = $"{ProjectPath}\Mode\{Shape.Name}.png"
If nsint = -1 Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
Dim schpcolor As New Color
schpcolor.RGBAssign(255, 255, 255)
schpcolor = SetImageStyle(Shape, True, schpcolor)
Shape.Selected = True
Dim Ef As ExportFilter = srcDoc.ExportBitmap(modepath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
SetImageStyle(Shape, False, schpcolor)
Shape.Selected = False
If modeindex = 0 Then
'更新 tbl_cdr_file表
Shape.Selected = True
modepath = $"{ProjectPath}\Mode\ShapeName.png"
Dim NEf As ExportFilter = srcDoc.ExportBitmap(modepath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
NEf.Finish()
Shape.Selected = False
modepath = $"{SafeFileName}\Mode\ShapeName.png"
Dim sql As String = $"UPDATE `Cdr_library`.`tbl_cdr_file` SET `PreviewPath` = '{modepath.Replace("\", "\\")}' WHERE `ID` = {fid};{vbCrLf}"
li.Add(sql)
End If
Locationint = 0
For Each nshape In Shape.Shapes
Locationint = Locationint + 1
If nshape.Name.Contains("Trench_") Then
Dim cstrbuf As String() = nshape.Name.Split("_")
If Not Double.TryParse(cstrbuf(2), wm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
If Not Double.TryParse(cstrbuf(3), hm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
li.Add($"INSERT INTO `Cdr_library`.`tbl_trench` (`MID`,`TrenchName`,`SizeH`,`SizeW`,`IndexNum`)VALUES({nsint},'{nshape.Name.Trim}',{hm},{wm},{Locationint});{vbCrLf}")
ElseIf nshape.Name.Contains("Logo_") Then
Dim cstrbuf As String() = nshape.Name.Split("_")
If Not Double.TryParse(cstrbuf(3), wm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
If Not Double.TryParse(cstrbuf(4), hm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
'判断 第3个元素 是否为R或L
If cstrbuf(2).Trim.ToLower = "l" Then
li.Add($"UPDATE `Cdr_library`.`tbl_model` SET `LOGO_L` = '{Locationint}',`LOGO_L_W` = {wm},`LOGO_L_H` = {hm} WHERE `ID` = {nsint};{vbCrLf}")
ElseIf cstrbuf(2).Trim.ToLower = "r" Then
'更新 tbl_model 表
li.Add($"UPDATE `Cdr_library`.`tbl_model` SET `LOGO_R` = '{Locationint}',`LOGO_R_W` = {wm},`LOGO_R_H` = {hm} WHERE `ID` = {nsint};{vbCrLf}")
End If
End If
Next
Case "Mono".ToLower
Dim modepath As String = $"{ProjectPath}\Mono"
If Not Directory.Exists(modepath) Then
Directory.CreateDirectory(modepath)
End If
modepath = $"{SafeFileName}\Mono\{Shape.Name}.png"
nsint = AddMonoToSQL(Shape.Name, fid, Location, modepath)
modepath = $"{ProjectPath}\Mono\{Shape.Name}.png"
If nsint = -1 Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
Dim schpcolor As New Color
schpcolor.RGBAssign(255, 255, 255)
schpcolor = SetImageStyle(Shape, True, schpcolor)
Shape.Selected = True
Dim Ef As ExportFilter = srcDoc.ExportBitmap(modepath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
SetImageStyle(Shape, False, schpcolor)
Shape.Selected = False
Dim dic As New Dictionary(Of String, Integer)
Locationint = 0
Dim Keygroup As Integer = 1
Dim KeygroupID As Integer = 0
For Each nshape In Shape.Shapes
Locationint = Locationint + 1
If nshape.Name.Contains("location_") Then
Dim cstrbuf As String() = nshape.Name.Split("_")
If dic.ContainsKey(cstrbuf(2).Trim) Then
KeygroupID = dic(cstrbuf(2).Trim)
Else
Keygroup = Keygroup + 1
KeygroupID = Keygroup
dic.Add(cstrbuf(2).Trim, Keygroup)
End If
If Not Double.TryParse(cstrbuf(3), wm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
If Not Double.TryParse(cstrbuf(4), hm) Then
gLogNode = New LogNode($"图像{Shape.Name}异常，上传素材失败!{vbCrLf}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return
End If
typeid = GetIconType(cstrbuf(1).Trim)
If typeid = 3 Then
If cstrbuf.Length > 5 Then
li.Add($"INSERT INTO `Cdr_library`.`tbl_location` (`PID`,`LocationName`,`Type`,`SizeH`,`SizeW`,`IndexNum`,`lineNumber`,`KeyGroup`)VALUES({nsint},'{nshape.Name.Trim}','{typeid}',{hm},{wm},{Locationint},'{cstrbuf(5).Trim}',{KeygroupID});{vbCrLf}")
Else
li.Add($"INSERT INTO `Cdr_library`.`tbl_location` (`PID`,`LocationName`,`Type`,`SizeH`,`SizeW`,`IndexNum`,`KeyGroup`)VALUES({nsint},'{nshape.Name.Trim}','{typeid}',{hm},{wm},{Locationint},{KeygroupID});{vbCrLf}")
End If
Else
li.Add($"INSERT INTO `Cdr_library`.`tbl_location` (`PID`,`LocationName`,`Type`,`SizeH`,`SizeW`,`IndexNum`,`KeyGroup`)VALUES({nsint},'{nshape.Name.Trim}','{typeid}',{hm},{wm},{Locationint},{KeygroupID});{vbCrLf}")
End If
End If
Next
Case "Icon".ToLower
Dim chpcolor As New Color
Dim ShapeName As String = Shape.Name.Trim
ShapeName = ShapeName.Replace("%", "").Replace("/", "").Replace(":", "").Replace("*", "").Replace("?", "").Replace("""", "").Replace("<", "").Replace(">", "").Replace("|", "").Replace("+", "")
chpcolor.RGBAssign(0, 0, 0)
Shape.Fill.ApplyUniformFill(chpcolor)
Dim modepath As String = $"{ProjectPath}\iconlibrary\{ShapeName}.png"
Console.WriteLine(modepath)
Shape.Selected = True
Dim Ef As ExportFilter = srcDoc.ExportBitmap(modepath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
Dim KeyNamebuf As String() = Shape.Name.Trim.Split("_")
chpcolor.RGBAssign(255, 255, 255)
Shape.Fill.ApplyUniformFill(chpcolor)
Shape.Selected = False
modepath = $"{SafeFileName}\iconlibrary\{ShapeName}.png"
modepath = modepath.Replace("\", "\\")
'文件名不能包含以下字符：‌反斜杠(\)、正斜杠(/)、冒号(:)、星号(*)、问号(?)、双引号(")、小于号(<)、大于号(>)、竖线(|)‌，以及‌点(.)或百分号(%)‌作为名称。‌
icontype = 1
li.Add($"INSERT INTO `Cdr_library`.`tbl_iconlibrary` (`IconType`,`KeyName`,`FID`,`Shapenumber`,`PreviewPath`,`NameCN`,`NameEn`)VALUES({icontype},'{Shape.Name.Trim}',{fid},'{Location}','{modepath}','{KeyNamebuf(1) }','{KeyNamebuf(2) }');{vbCrLf}")
Case "Txt".ToLower
Dim chpcolor As New Color
chpcolor.RGBAssign(0, 0, 0)
Shape.Fill.ApplyUniformFill(chpcolor)
Dim modepath As String = $"{ProjectPath}\iconlibrary\{Shape.Name}.png"
Shape.Selected = True
Dim Ef As ExportFilter = srcDoc.ExportBitmap(modepath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
chpcolor.RGBAssign(255, 255, 255)
Shape.Fill.ApplyUniformFill(chpcolor)
Shape.Selected = False
modepath = $"{SafeFileName}\iconlibrary\{Shape.Name}.png"
modepath = modepath.Replace("\", "\\")
icontype = 2
li.Add($"INSERT INTO `Cdr_library`.`tbl_iconlibrary` (`IconType`,`KeyName`,`FID`,`Shapenumber`,`PreviewPath`)VALUES({icontype},'{Shape.Name.Trim}',{fid},'{Location}','{modepath}');{vbCrLf}")
Case "TxtEn".ToLower
Dim chpcolor As New Color
chpcolor.RGBAssign(0, 0, 0)
Shape.Fill.ApplyUniformFill(chpcolor)
Dim modepath As String = $"{ProjectPath}\iconlibrary\{Shape.Name}.png"
Shape.Selected = True
Dim Ef As ExportFilter = srcDoc.ExportBitmap(modepath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
chpcolor.RGBAssign(255, 255, 255)
Shape.Fill.ApplyUniformFill(chpcolor)
Shape.Selected = False
modepath = $"{SafeFileName}\iconlibrary\{Shape.Name}.png"
modepath = modepath.Replace("\", "\\")
icontype = 3
li.Add($"INSERT INTO `Cdr_library`.`tbl_iconlibrary` (`IconType`,`KeyName`,`FID`,`Shapenumber`,`PreviewPath`)VALUES({icontype},'{Shape.Name.Trim}',{fid},'{Location}','{modepath}');{vbCrLf}")
'Case "IconB".ToLower
' icontype = 5
' li.Add($"INSERT INTO `Cdr_library`.`tbl_iconlibrary` (`IconType`,`KeyName`,`Version`,`Shapenumber`)VALUES({icontype},'{Shape.Name.Trim}','{Version.Trim}','{Location}');{vbCrLf}")
Case "Logo".ToLower
Dim chpcolor As New Color
chpcolor.RGBAssign(0, 0, 0)
Shape.Fill.ApplyUniformFill(chpcolor)
Dim modepath As String = $"{ProjectPath}\iconlibrary\{Shape.Name}.png"
Shape.Selected = True
Dim Ef As ExportFilter = srcDoc.ExportBitmap(modepath, VGCore.cdrFilter.cdrPNG, VGCore.cdrExportRange.cdrSelection, VGCore.cdrImageType.cdrRGBColorImage)
Ef.Finish()
chpcolor.RGBAssign(255, 255, 255)
Shape.Fill.ApplyUniformFill(chpcolor)
Shape.Selected = False
modepath = $"{SafeFileName}\iconlibrary\{Shape.Name}.png"
modepath = modepath.Replace("\", "\\")
icontype = 4
li.Add($"INSERT INTO `Cdr_library`.`tbl_iconlibrary` (`IconType`,`KeyName`,`FID`,`Shapenumber`,`PreviewPath`)VALUES({icontype},'{Shape.Name.Trim}',{fid},'{Location}','{modepath}');{vbCrLf}")
Case Else
Continue For
End Select
If li.Count >= 500 Then
If AddLogMessageToSQL(li) Then
li.Clear()
Else
srcDoc.Close()
Return
End If
End If
Next
Next
Next
If AddLogMessageToSQL(li) Then
li.Clear()
Else
srcDoc.Close()
Return
End If
srcDoc.Close()
End If
End Sub
'设置图片样式
Private Function SetImageStyle(Shape As Shape, isTransparent As Boolean, Transparentcolor As Color)
'设置图像背景色为透明
Dim Transparent As Integer
Dim chpcolor As New Color
Dim result As New Color
Dim r, g, b, a As Integer
If isTransparent Then
Transparent = 100
chpcolor.RGBAssign(102, 102, 102)
Else
Transparent = 0
chpcolor.RGBAssign(255, 255, 255)
End If
For i As Integer = 1 To Shape.Shapes.Count
If i = Shape.Shapes.Count Then
Select Case Shape.Shapes(i).Fill.UniformColor.Type
Case cdrColorType.cdrColorCMYK
Dim C As Double, M As Double, Y As Double, K As Double
C = Shape.Shapes(i).Fill.UniformColor.CMYKCyan
M = Shape.Shapes(i).Fill.UniformColor.CMYKMagenta
Y = Shape.Shapes(i).Fill.UniformColor.CMYKYellow
K = Shape.Shapes(i).Fill.UniformColor.CMYKBlack
result.CMYKAssign(C, M, Y, K)
Case cdrColorType.cdrColorRGB
r = Shape.Shapes(i).Fill.UniformColor.RGBRed
g = Shape.Shapes(i).Fill.UniformColor.RGBGreen
b = Shape.Shapes(i).Fill.UniformColor.RGBBlue
result.RGBAssign(r, g, b)
Case Else
result.RGBAssign(255, 255, 255)
End Select
'Shape.Shapes(i).Transparency.ApplyUniformTransparency(Transparent)
Shape.Shapes(i).Fill.ApplyUniformFill(Transparentcolor)
Else
Shape.Shapes(i).Fill.ApplyUniformFill(chpcolor)
End If
Next
Return result
End Function
'获取类型信息
Private Function GetIconType(Shapetype As String) As Integer
Select Case Shapetype.ToLower
Case "Icon".ToLower
Return 1
Case "Txt".ToLower
Return 2
Case "TxtEn".ToLower
Return 3
'Case "IconB".ToLower
' Return 5
Case "Logo".ToLower
Return 5
Case Else
Return 0
End Select
End Function
Public Function AddModeToSql(modename As String, fid As Integer, Location As String, Direction As String, xm As Integer, wm As Integer, hm As Integer, Colorstr As String, PreviewPath As String) As Integer
Dim npgsqldb As DbExecutor = New DbExecutor(DbExecutor.DbTypeEnum.Mysql, LocalConnString)
Dim transStr As String
Dim transStr1 As String
Dim dt As DataTable
Dim result As Integer = -1
PreviewPath = PreviewPath.Replace("\", "\\")
transStr = $"INSERT INTO `Cdr_library`.`tbl_model` (`FID`,`ModelName`,`Direction`,`SizeH`,`SizeW`,`Color`,`PanelCount`,`ShapeNumber`,`PreviewPath`)VALUES({fid},'{modename}','{Direction}',{hm},{wm},'{Colorstr}',{xm},'{Location}','{PreviewPath}');{vbCrLf}"
transStr1 = $"select * From `Cdr_library`.`tbl_model` where `FID`={fid} and `ModelName`='{modename}'"
Try
npgsqldb.Open()
npgsqldb.ExecuteNonQuery(transStr)
dt = npgsqldb.ExecuteDataTable(transStr1)
If dt.Rows.Count > 0 Then
result = dt.Rows(0).Item("ID")
End If
npgsqldb.Close()
Catch ex As Exception
If Not IsNothing(npgsqldb) Then
npgsqldb.Close()
End If
End Try
Return result
End Function
Private Function AddMonoToSQL(Mononame As String, Fid As Integer, Location As String, PreviewPath As String) As Integer
Dim npgsqldb As DbExecutor = New DbExecutor(DbExecutor.DbTypeEnum.Mysql, LocalConnString)
Dim strbuf As String() = Mononame.Split("_")
Dim transStr As String
Dim transStr1 As String
Dim dt As DataTable
Dim result As Integer = -1
Dim xm, hm, wm As Double
PreviewPath = PreviewPath.Replace("\", "\\")
If strbuf.Length > 3 Then
If Not Double.TryParse(strbuf(2), wm) Then
Return result
End If
If Not Double.TryParse(strbuf(3), hm) Then
Return result
End If
transStr = $"INSERT INTO `Cdr_library`.`tbl_pattern` (`FID`,`PatternName`,`ShapeNumber`,`SizeW`,`SizeH`,`PreviewPath`)VALUES({Fid},'{Mononame}','{Location}',{wm},{hm},'{PreviewPath}');{vbCrLf}"
Else
Return result
End If
transStr1 = $"select * From `Cdr_library`.`tbl_pattern` where `FID`={Fid} and `PatternName`='{Mononame}'"
Try
npgsqldb.Open()
npgsqldb.ExecuteNonQuery(transStr)
dt = npgsqldb.ExecuteDataTable(transStr1)
If dt.Rows.Count > 0 Then
result = dt.Rows(0).Item("ID")
End If
npgsqldb.Close()
Catch ex As Exception
If Not IsNothing(npgsqldb) Then
npgsqldb.Close()
End If
End Try
Return result
End Function
'录入文件到数据表
Private Function AddFileToSQL(filenmae As String, Optional username As String = "TestUser", Optional Remark As String = "") As Integer
Dim npgsqldb As DbExecutor = New DbExecutor(DbExecutor.DbTypeEnum.Mysql, LocalConnString)
Dim gLogNode As LogNode
Dim strbuf As String() = filenmae.Split("_")
Dim transStr As String
Dim transStr1 As String
Dim transStr2 As String
Dim dt As DataTable
Dim result As Integer = -1
If strbuf.Length > 3 Then
transStr = $"INSERT INTO `Cdr_library`.`tbl_cdr_file` (`Company`,`Series`,`FileName`,`Version`,`Remark`,`User`,`UpdateTime`)VALUES('{strbuf(0)}','{strbuf(1)}','{filenmae}','{strbuf(3)}','{Remark}','{username}','{Now.ToString("yyyy-MM-dd HH:mm:ss") }');{vbCrLf}"
ElseIf strbuf.Length > 4 Then
transStr = $"INSERT INTO `Cdr_library`.`tbl_cdr_file` (`Company`,`Series`,`FileName`,`Version`,`Remark`,`User`,`UpdateTime`,`Remark`)VALUES('{strbuf(0)}','{strbuf(1)}','{filenmae}','{strbuf(3)}','{Remark}','{username}','{Now.ToString("yyyy-MM-dd HH:mm:ss") }','{strbuf(4)}');{vbCrLf}"
Else
transStr = $"INSERT INTO `Cdr_library`.`tbl_cdr_file` (`Company`,`Series`,`FileName`,`Version`,`Remark`,`User`,`UpdateTime`)VALUES('未知','未知','{filenmae}','未知','{Remark}','{username}','{Now.ToString("yyyy-MM-dd HH:mm:ss")}');{vbCrLf}"
End If
transStr1 = $"select * From `Cdr_library`.`tbl_cdr_file` where `FileName`='{filenmae}'"
Try
npgsqldb.Open()
dt = npgsqldb.ExecuteDataTable(transStr1)
If dt.Rows.Count > 0 Then
Return -1
End If
npgsqldb.ExecuteNonQuery(transStr)
dt = npgsqldb.ExecuteDataTable(transStr1)
If dt.Rows.Count > 0 Then
result = dt.Rows(0).Item("ID")
End If
npgsqldb.Close()
Catch ex As Exception
If Not IsNothing(npgsqldb) Then
npgsqldb.Close()
End If
End Try
Return result
End Function
'添加一天数据如果数据超过500条则插入到数据库中
Private Function AddLogMessageToSQL(msglist As List(Of String)) As Boolean
'最大条数 = 500
Dim npgsqldb As DbExecutor = New DbExecutor(DbExecutor.DbTypeEnum.Mysql, LocalConnString)
Dim gLogNode As LogNode
'将列表中的数据库语句组装成事务语句
Dim transStr As String = String.Join("", msglist.ToArray)
'插入数据库
' Using db As New DbExecutor(DbExecutor.DbTypeEnum.npgsql, LocalConnString)
Try
npgsqldb.Open()
npgsqldb.BeginTransaction()
npgsqldb.ExecuteNonQuery(transStr)
npgsqldb.CommitTransaction()
msglist.Clear()
npgsqldb.Close()
Catch ex As Exception
If Not IsNothing(npgsqldb) Then
npgsqldb.RollbackTransaction()
npgsqldb.Close()
End If
'AddLogMessage($"写入酒店日志异常！")
gLogNode = New LogNode($"上传素材失败!{vbCrLf}{ex.Message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
Return False
End Try
gLogNode = New LogNode($"上传素材成功!{vbCrLf}", RuningLog.LogType.e_info, RuningLog.LogMode.e_fileandRichTextBox)
'gLogNode.SetLogColor(System.Drawing.Color.Red)
G_Log.AddLogNode(gLogNode)
' End Using
'清空列表
Return True
End Function
Public Isdisply As Boolean = False
Private Sub ToolStripButton2_Click(sender As Object, e As EventArgs) Handles ToolStripButton2.Click
Isdisply = Not Isdisply
'Dim srcDoc， destDoc1， destDoc2 As Document '素材文件
'Dim OpenFileDialog1 As New OpenFileDialog()
'OpenFileDialog1.Filter = "CorelDRAW Files (*.cdr)|*.cdr"
'Dim MaterialPath As String
'Dim oldTime As DateTime
'Dim shp, nshp As Shape
'If OpenFileDialog1.ShowDialog() = DialogResult.OK Then
' oldTime = Now
' MaterialPath = OpenFileDialog1.FileName
' srcDoc = APP.OpenDocument(MaterialPath, False)
' shp = srcDoc.Pages(1).Layers(2).Shapes(19)
' ''Console.WriteLine("打开库文件耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' destDoc1 = APP.OpenDocument(M_MaterialPath & "test1.cdr", False)
' destDoc1.Close()
' ''Console.WriteLine("打开关闭目标文件耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' destDoc1 = APP.OpenDocument(M_MaterialPath & "test1.cdr", False)
' ''Console.WriteLine("打开目标文件耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' '循环复制图像到目标文件
' shp.Copy()
' For i = 1 To 10
' destDoc1.Pages(1).Layers(2).Paste()
' Next
' ''Console.WriteLine("复制耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' destDoc1.Save()
' destDoc1.Close()
' ''Console.WriteLine("保存耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' destDoc1 = APP.CreateDocument()
' ''Console.WriteLine("创建新文件耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' For i = 1 To 10
' destDoc1.Pages(1).Layers(2).Paste()
' Next
' ''Console.WriteLine("复制耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' Dim srcFile1 As String = M_MaterialPath & "test2.cdr"
' destDoc1.SaveAs(srcFile1)
' destDoc1.Close()
' ''Console.WriteLine("保存耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
' srcDoc.Close()
' ''Console.WriteLine("关闭库耗时：" & (Now - oldTime).TotalMilliseconds & "ms")
'End If
End Sub
''把剩余的数据也插入到数据库中
'Private Sub AddLogMessageToSQL(ByRef msglist As List(Of String), npgsqldb As DbExecutor)
' If msglist.Count = 0 Then Return
' Dim transStr As String = String.Join("", msglist.ToArray)
' '插入数据库
' ' Using db As New DbExecutor(DbExecutor.DbTypeEnum.npgsql, LocalConnString)
' npgsqldb.Open()
' Try
' npgsqldb.BeginTransaction()
' npgsqldb.ExecuteNonQuery(transStr)
' npgsqldb.CommitTransaction()
' msglist.Clear()
' Catch ex As Exception
' npgsqldb.RollbackTransaction()
' AddLogMessage($"写入酒店日志异常！")
' gLogNode = New LogNode($"【序列化失败】Redis:{channel}: {Message}", RuningLog.LogType.e_Error, RuningLog.LogMode.e_fileandRichTextBox)
' gLogNode.SetLogColor(System.Drawing.Color.Red)
' G_Log.AddLogNode(gLogNode)
' End Try
' npgsqldb.Close()
' 'End Using
'End Sub
Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs)
Dim srcDoc As Document
Dim destDoc As Document
Dim destDoc1 As Document
Dim srcLayer As Layer
Dim destLayer As Layer
Dim shp, nshp As Shape
Dim srcFile As String
Dim destFile As String
Dim srPaste As New ShapeRange
Dim boxShape As Shape, sh As Shape
Dim dx As Double, dy As Double
Dim srcFile1 As String = "C:\Canvas\ms_2.cdr"
destFile = "C:\Canvas\ms_1.cdr"
srcFile = "C:\Canvas\Test_3.cdr"
Dim app As New Application()
app.Visible = False
Thread.Sleep(2000)
Dim nn As Integer = 0
Dim x#, y#, w#, h#
'Dim doc As Document = app.OpenDocument(tplPath, False)
'Dim doc1 As Document = app.OpenDocument(imgFolder, False)
Try
srcDoc = app.OpenDocument(srcFile, False)
' '延时(1000)
Thread.Sleep(500)
destDoc = app.OpenDocument(destFile, False)
Thread.Sleep(500)
srcLayer = srcDoc.Pages(1).Layers("Layer_1")
destLayer = destDoc.Pages(1).Layers("Key_8")
If destLayer Is Nothing Then
destLayer = destDoc.Pages(1).Layers.Add("Key_8")
End If
For Each shp In srcLayer.Shapes
'If nn = 0 Then
' nn = nn + 1
' Continue For
'End If
If nn < 8 Then
nn = nn + 1
'''Console.WriteLine(shp.Name)
shp.Copy()
shp = destLayer.Paste()
For Each nshp In destLayer.Shapes
If nshp.Name.Equals($"Kuan_{nn}") Then
x = nshp.CenterX - shp.CenterX
y = nshp.CenterY - shp.CenterY
'w = nshp.SizeWidth
'h = nshp.SizeHeight
'Dim st = destLayer.CreateArtisticText(
' x, y,
' "X=" & Format(x, "0.0") & vbCrLf &
' "Y=" & Format(y, "0.0") & vbCrLf &
' "W=" & Format(w, "0.0") & vbCrLf &
' "H=" & Format(h, "0.0"))
'st.Fill.UniformColor.CMYKAssign(0, 0, 0, 100) '黑色文字
dx = nshp.LeftX
dy = nshp.TopY
shp.Move(x, y)
Thread.Sleep(500)
End If
Next nshp
'shp.MoveToLayer(,)
Else
Exit For
End If
Next shp
destLayer.Shapes.All().Group()
destDoc.SaveAs(srcFile1)
srcDoc.Close()
destDoc.Close()
destDoc1 = app.OpenDocument(srcFile1, False)
'Dim opt As StructExportOptions = New StructExportOptions()
'opt.ImageType = cdrImageType.cdrDuotoneImage
'opt.JPEGQuality = 90
'opt.ResolutionX = 300 ' // 300 dpi
'opt.ResolutionY = 300
'opt.MaintainAspect = True
'opt.AntiAliasing = cdrAntiAliasingType.cdrNormalAntiAliasing
srcFile1 = srcFile1.Replace(".cdr", ".png")
'// 4) 导出 JPG
Dim Ef As ExportFilter = destDoc1.ExportBitmap(srcFile1, VGCore.cdrFilter.cdrPNG)
Ef.Finish()
'destDoc1.Close()
Catch ex As Exception
If srcDoc IsNot Nothing Then srcDoc.Close()
If destDoc IsNot Nothing Then destDoc.Close()
If destDoc1 IsNot Nothing Then destDoc1.Close()
'''Console.WriteLine(ex.Message)
End Try
End Sub
End Class
Reference in New Issue Copy Permalink