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 ''' ''' 计算缩放因子 ''' ''' 图像原始宽度 ''' 图像原始高度 ''' 槽位宽度 ''' 槽位高度 ''' 0=填满 1=完整 2=拉伸 ''' （scaleX, scaleY） 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 ''' ''' ''' ''' 被替换的图像 ''' 用来替换的图像名 ''' ''' '替换对应图像 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 ''' ''' 查找图像并拷贝到目标图层 中 ''' ''' ''' ''' ''' 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