From bbe0821f6851a6145e7c9433b677dd4b58ea928d Mon Sep 17 00:00:00 2001 From: csh Date: Mon, 15 Dec 2025 13:28:02 +0800 Subject: [PATCH] v1.8.5 --- funcext/TSOffice/TOfficeObj.tsf | 2 +- funcext/TSOffice/TSDocxFile.tsf | 2 +- funcext/TSOffice/TSXlsxFile.tsf | 2 +- funcext/TSOffice/document/TDocxCopy.tsf | 1201 ++++++++++--------- funcext/TSOffice/worksheet/xlsxWorkBook.tsf | 2 +- 更新日志.md | 10 + 6 files changed, 617 insertions(+), 602 deletions(-) diff --git a/funcext/TSOffice/TOfficeObj.tsf b/funcext/TSOffice/TOfficeObj.tsf index c182692..b06767f 100644 --- a/funcext/TSOffice/TOfficeObj.tsf +++ b/funcext/TSOffice/TOfficeObj.tsf @@ -1,4 +1,4 @@ -// Version 1.8.4 +// Version 1.8.5 Function TOfficeObj(n); Begin case lowercase(n) of diff --git a/funcext/TSOffice/TSDocxFile.tsf b/funcext/TSOffice/TSDocxFile.tsf index 2d41adf..2fb6d9d 100644 --- a/funcext/TSOffice/TSDocxFile.tsf +++ b/funcext/TSOffice/TSDocxFile.tsf @@ -1,4 +1,4 @@ -// Version 1.8.4 +// Version 1.8.5 Type TSDocxFile = Class ///Version: V1.0 2022-09-20 ///适用于 Microsoft Word docx格式文件 diff --git a/funcext/TSOffice/TSXlsxFile.tsf b/funcext/TSOffice/TSXlsxFile.tsf index 713b8a8..e7d9566 100644 --- a/funcext/TSOffice/TSXlsxFile.tsf +++ b/funcext/TSOffice/TSXlsxFile.tsf @@ -1,4 +1,4 @@ -// Version 1.8.4 +// Version 1.8.5 Type TSXlsxFile = Class ///Version: V1.0 2022-08-08 ///适用于 Microsoft Excel? 2007 及以上版本创建的电子表格文档。支持 XLSX / XLSM / XLTM / XLTX 等多种文档格式。 diff --git a/funcext/TSOffice/document/TDocxCopy.tsf b/funcext/TSOffice/document/TDocxCopy.tsf index 2c7c0f9..21c7555 100644 --- a/funcext/TSOffice/document/TDocxCopy.tsf +++ b/funcext/TSOffice/document/TDocxCopy.tsf @@ -1,598 +1,603 @@ -Type TDocxCopy = class - - Function Create(oldObj, newObj) - Begin - old_docx_obj_ := oldObj; - new_docx_obj_ := newObj; - copy_table_ := array(); - copy_paragraph_ := array(); - copy_drawing_ := array(); - style_copy_obj_ := new TDocxStyleCopy(oldObj.StyleObject(), newObj.StyleObject()); - number_copy_obj_ := new TDocxNumberCopy(oldObj, newObj); - footnote_copy_obj_ := new TDocxFootnoteCopy(oldObj, newObj); - End; - - Function Init(); - Begin - style_copy_obj_.Init(); - End; - - ///从posOpt位置开始复制word - ///posOpt: 段落位置，0 在DOCX文件开头；-1 文件尾；N 在第N段之后；XmlNode节点对象或DocObject对象 在posOpt之后新添加图片 - Function Copy(posOpt); - Begin - // 复制所有的样式 - style_copy_obj_.CopyStyle(number_copy_obj_); - - parts := new_docx_obj_.Body().Parts(); - pos := old_docx_obj_.GetPosNode(posOpt); - for i:=0 to length(parts)-1 do - begin - case GetPartType(parts[i]) of - 0: pos := CopyParagraph(parts[i], pos); - 1: pos := CopyDrawing(parts[i], pos); - 2: pos := CopyTable(parts[i], pos); - end; - end - End; - - Function CopyParagraph(obj, pos); - Begin - paragraph := old_docx_obj_.Body().CopyWp(obj, pos); - SetParagraphInfo(paragraph); - copy_paragraph_[length(copy_paragraph_)] := paragraph; - return paragraph; - End; - - Function CopyDrawing(obj, pos); - Begin - paragraph := old_docx_obj_.Body().CopyWp(obj, pos); - SetDrawingInfo(paragraph); - copy_drawing_[length(copy_drawing_)] := paragraph; - return paragraph; - End; - - Function CopyTable(obj, pos); - Begin - table := old_docx_obj_.Body().CopyWtbl(obj, pos); - SetTableInfo(table); - copy_table_[length(copy_table_)] := table; - return table; - End; - - Function GetCopiedTable(); - Begin - return copy_table_; - End; - - Function GetCopiedParagraph(); - Begin - return copy_paragraph_; - End; - - Function GetCopiedDrawing(); - Begin - return copy_drawing_; - End; - -private - - Function DeleteComment(paragraph); - Begin - node := paragraph.node_.FirstChildElement('w:commentRangeStart'); - while ifObj(node) do - begin - name := node.GetName(); - if name = "w:commentRangeStart" or name = "w:commentRangeEnd" then - begin - delete_node := node; - node := node.NextElement(); - paragraph.node_.DeleteChild(delete_node); - if node.FirstChildElement('w:commentReference') then - begin - delete_node := node; - node := node.NextElement(); - paragraph.node_.DeleteChild(delete_node); - end - end - else begin - node := node.NextElement(); - end - end - End; - - Function SetRObject(node); - Begin - image_data_node := class(TSXml).GetNode(node, 'v:shape/v:imagedata'); - if not ifObj(node) then return; - rid := image_data_node.GetAttribute('r:id'); - id := CopyRidContent(rid, 'media/image', 'image'); - if id then image_data_node.SetAttribute('r:id', 'rId' $ id); - ole_node := class(TSXml).GetNode(node, 'o:OLEObject'); - if not ifObj(node) then return; - rid := ole_node.GetAttribute('r:id'); - id := CopyRidContent(rid, 'embeddings/oleObject', 'oleObject'); - if id then ole_node.SetAttribute('r:id', 'rId' $ id); - End; - - function CopyRidContent(id, tar_prefix, type_postfix); - begin - rels := new_docx_obj_.Zip().Get('word/_rels/document.xml.rels'); - target := class(TSXml).FindRelationshipTarget(rels, id); - image_file := new_docx_obj_.Zip().Get('word/' $ target).Data(); - - // 比较新文件的图片在旧文件中是否存在 - zip := old_docx_obj_.Zip(); - xml := zip.Get('word/_rels/document.xml.rels'); - files := sselect ['FileName'] from zip.Files() where AnsiStartsText('word/' $ tar_prefix, ['FileName']) end; - for i:=0 to length(files)-1 do Begin - if zip.Diff(files[i], image_file) = 0 then Begin - prefix := ReplaceStr(files[i], 'word/', ''); - [maxRid, imageFile, rid] := class(TSXml).FindRelationshipRid(xml, prefix); - End; - End; - if rid = 0 then - begin - image_cnt := length(files) + 1; - if ParseRegExpr("\\w+$", target, "", result, Mpos, Mlen) then - begin - postfix := result[0][0]; - image_path := tar_prefix $ image_cnt $ '.' $ postfix; - [rid, tar] := class(TSXml).FindRelationshipRid(xml, ''); - rid ++; - class(TSXml).AddRelationshipRid(xml, image_path, 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/' $ type_postfix, 'rId' $ rid); - zip.Add('word/' + image_path, image_file); - contentXml := zip.Get('[Content_Types].xml'); - if postfix = 'wmf' then content_type := 'image/x-wmf'; - else if postfix = 'bin' then content_type := 'application/vnd.openxmlformats-officedocument.oleObject'; - class(TSXml).AddDefaultContentType(contentXml, postfix, content_type); - end - end - return rid; - end; - - Function SetPic(node); - Begin - // 获取新文件的图片 - rembed := node.GetAttribute('r:embed'); - rels := new_docx_obj_.Zip().Get('word/_rels/document.xml.rels'); - target := class(TSXml).FindRelationshipTarget(rels, rembed); - image_file := new_docx_obj_.Zip().Get('word/' $ target).Data(); - - // 比较新文件的图片在旧文件中是否存在 - zip := old_docx_obj_.Zip(); - xml := zip.Get('word/_rels/document.xml.rels'); - files := sselect ['FileName'] from zip.Files() where AnsiStartsText('word/media/image', ['FileName']) end; - for i:=0 to length(files)-1 do Begin - if zip.Diff(files[i], image_file) = 0 then Begin - prefix := ReplaceStr(files[i], 'word/', ''); - [maxRid, imageFile, rid] := class(TSXml).FindRelationshipRid(xml, prefix); - End; - End; - if rid = 0 then - begin - image_cnt := length(files) + 1; - if ParseRegExpr("\\w+$", target, "", result, Mpos, Mlen) then - begin - postfix := result[0][0]; - image_path := "media/image" $ image_cnt $ '.' $ postfix; - [rid, tar] := class(TSXml).FindRelationshipRid(xml, ''); - rid ++; - class(TSXml).AddRelationshipRid(xml, image_path, 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/image', 'rId' $ rid); - zip.Add('word/' + image_path, image_file); - contentXml := zip.Get('[Content_Types].xml'); - class(TSXml).AddDefaultContentType(contentXml, postfix, 'image/' $ postfix); - end - end - node.SetAttribute('r:embed', 'rId' $ rid); - End; - - Function SetChart(node); - Begin - rid := node.GetAttribute('r:id'); - rels := new_docx_obj_.Zip().Get('word/_rels/document.xml.rels'); - target := class(TSXml).FindRelationshipTarget(rels, rid); - new_zip := new_docx_obj_.Zip(); - chart_file := new_zip.Get('word/' $ target); - - // 复制charN.xml - zip := old_docx_obj_.Zip(); - files := sselect ['FileName'] from zip.Files() where AnsiStartsText('word/charts/chart', ['FileName']) end; - new_chart_file := "charts/chart" $ (length(files) + 1) $ ".xml"; - xml := zip.Get('word/_rels/document.xml.rels'); - [new_rid, tar] := class(TSXml).FindRelationshipRid(xml, ''); - new_rid++; - class(TSXml).AddRelationshipRid(xml, new_chart_file, "http://schemas.openxmlformats.org/officeDocument/2006/relationships/chart", 'rId' $ new_rid); - zip.Add('word/' + new_chart_file, chart_file.Data()); - contentXml := zip.Get('[Content_Types].xml'); - class(TSXml).AddOverrideContentType(contentXml, '/word/' + new_chart_file, 'application/vnd.openxmlformats-officedocument.drawingml.chart+xml'); - node.SetAttribute('r:id', 'rId' $ new_rid); - - // 复制charN.xml.rels - chart_rels := "word/charts/_rels" + target[pos('/', target):] $ ".rels"; - chart_rels_xml := new_zip.Get(chart_rels); - if ifObj(chart_rels_xml) then - begin - zip.Add('word/charts/_rels/chart' $ (length(files) + 1) $ ".xml.rels", chart_rels_xml.Data()); - relationship := chart_rels_xml.FirstChildElement('Relationships').FirstChildElement('Relationship'); - while ifObj(relationship) do - begin - target := relationship.GetAttribute('Target'); - target_path := AnsiReplaceText(target, '..', 'word'); - file := new_zip.Get(target_path); - if ifObj(file) then - begin - [new_file, filetype] := GetNewTargetFileName(zip, target_path); - zip.Add(new_file, file.Data()); - if filetype then Class(TSXml).AddDefaultContentType(contentXml, filetype[2:], 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'); - end - relationship := relationship.NextElement(); - end; - end - End; - - Function GetNewTargetFileName(zip, fileName); - Begin - files := zip.Files()[:, 'FileName']; - ret := ParseRegExpr("(.*/)(\\w+)(\.\\w+)$", fileName, "", result, Mpos, Mlen); - count := 0; - while fileName in files do - begin - if ret then - fileName := result[0][1] $ result[0][2] $ "tinysoft" $ count $ result[0][3]; - else fileName := fileName $ "tinysoft" $ count; - count++; - end - if ret then filetype := result[0][3]; - return array(fileName, filetype); - End; - - Function SetDrawingInfo(drawing); - Begin - graphic_node := class(TSXml).GetNode(drawing.node_,'w:r/w:drawing/wp:inline/a:graphic/a:graphicData'); - if ifObj(graphic_node) then - begin - node := class(TSXml).GetNode(graphic_node,'pic:pic/pic:blipFill/a:blip'); - if ifObj(node) then SetPic(node); - node := class(TSXml).GetNode(graphic_node, 'c:chart'); - if ifObj(node) then SetChart(node); - end; - End; - - Function SetParagraphInfo(paragraph); - Begin - CopyStyle(paragraph.node_, 'w:pPr/w:pStyle'); - CopyNumber(paragraph.node_, 'w:pPr/w:numPr/w:numId'); - SetRunsInfo(paragraph.node_); - DeleteComment(paragraph); // 删除批注 - End; - - Function SetRunsInfo(node); - Begin - run := node.FirstChildElement('w:r'); - while ifObj(run) do - begin - CopyFootnote(run); - CopyStyle(run, 'w:rPr/w:rStyle'); - obj_node := class(TSXml).GetNode(run, 'w:object'); - if ifObj(obj_node) then - SetRObject(obj_node); - run := run.NextElement(); - end - End; - - Function CopyStyle(node, path); - Begin - style := class(TSXml).GetNode(node, path); - if ifObj(style) then - begin - styleid := style.GetAttribute('w:val'); - new_id := style_copy_obj_.GetStyleNewId(styleid); - if new_id then style.SetAttribute('w:val', new_id); - end - End; - - Function CopyNumber(node, path); - Begin - numpr := class(TSXml).GetNode(node, path); - if ifObj(numpr) then - begin - id := numpr.GetAttribute('w:val'); - numberid := number_copy_obj_.CopyNumbering(id); - numpr.SetAttribute('w:val', numberid); - end - End; - - Function CopyFootnote(node); - Begin - footnote := node.FirstChildElement('w:footnoteReference'); - if not ifObj(footnote) then return; - id := footnote.GetAttribute('w:id'); - if id then - begin - obj := footnote_copy_obj_.CopyFootnote(id); - footnote.SetAttribute('w:id', obj.Id); - parts := obj.Parts(); - for i:=0 to length(parts)-1 do - begin - case GetPartType(parts[i]) of - 0: SetParagraphInfo(parts[i]); - 1: SetDrawingInfo(parts[i]); - 2: SetTableInfo(parts[i]); - end; - end - end - End; - - Function SetTableInfo(table); - Begin - style := class(TSXml).GetNode(table.node_, 'w:tblPr/w:tblStyle'); - if ifObj(style) then - begin - id := style.GetAttribute('w:val'); - new_id := style_copy_obj_.GetStyleNewId(id); - if new_id then style.SetAttribute('w:val', new_id); - end - col := table.Cols(); - row := table.Rows(); - for r:=1 to row do - begin - for c:=1 to col do - begin - cell := table.Cell(r, c); - if not cell then continue; - node := cell.node_; - if (tbl := node.FirstChildElement('w:tbl')) then - begin - obj := TOfficeObj('TTable'); - obj.Init(tbl); - SetTableInfo(obj); - end - else if (p := node.FirstChildElement('w:p')) then - begin - draw := class(TSXml).GetNode(p, 'w:r/w:drawing'); - if ifObj(draw) then - begin - obj := TOfficeObj('TPicture'); - obj.Init(p); - SetDrawingInfo(obj); - end - else begin - obj := TOfficeObj('TParagraph'); - obj.Init(p); - SetParagraphInfo(obj); - end - end - end - end - End; - - /// 普通段落: 0 - /// 图片段落: 1 - /// 表格: 2 - /// 其他类型暂不复制 - Function GetPartType(part); - Begin - name := part.name_; - case name of - 'w:p': - begin - if class(TSXml).GetNode(part.node_, 'w:r/w:drawing') then return 1; - return 0; - end - 'w:tbl': - return 2; - else - return -1; - end - End; - -private - old_docx_obj_; - new_docx_obj_; - style_copy_obj_; - number_copy_obj_; - footnote_copy_obj_; - - copy_table_; - copy_paragraph_; - copy_drawing_; -End; - -Type TDocxStyleCopy = class - - Function Create(oldObj, newObj); - Begin - old_style_obj_ := oldObj; - new_style_obj_ := newObj; - style_id_map_ := array(); - style_name_map_ := array(); - style_id_map2_ := array(); - style_name_map2_ := array(); - id_map_ := array(); - End; - - Function Init(); - Begin - id_styles := new_style_obj_.Styles(); - for id, obj in id_styles do - begin - new_obj := obj; - id_map_[id] := new_obj; - SetId(new_obj, id); - SetName(new_obj); - end - End; - - Function CopyStyle(numberobj); - Begin - for id, obj in id_map_ do - begin - SetBasedOn(obj); - SetNumId(obj, numberobj); - SetLink(obj); - old_style_obj_.CopyStyle(obj); - end; - End; - - Function GetStyleNewId(oldId) - Begin - if ifnumber(oldId) then oldId := tostring(oldId); - return style_id_map_[oldId]; - End; - -private - - Function SetId(obj, id); - Begin - new_id := GetNewId(id); - obj.node_.SetAttribute('w:styleId', new_id); - style_id_map_[id] := new_id; - style_id_map2_[new_id] := id; - End; - - Function SetName(obj); - Begin - name_node := obj.node_.FirstChildElement('w:name'); - name := name_node.GetAttribute('w:val'); - new_name := GetNewName(name); - name_node.SetAttribute('w:val', new_name); - style_name_map_[name] := new_name; - style_name_map2_[new_name] := name; - End; - - Function SetBasedOn(obj); - Begin - basedon := obj.node_.FirstChildElement('w:basedOn'); - if ifObj(basedon) then - begin - val := basedon.GetAttribute('w:val'); - if style_id_map_[val] then basedOn.SetAttribute('w:val', style_id_map_[val]); - end - End; - - Function SetLink(obj); - Begin - link := obj.node_.FirstChildElement('w:link'); - if ifObj(link) then - begin - val := link.GetAttribute('w:val'); - if style_id_map_[val] then link.SetAttribute('w:val', style_id_map_[val]); - end - End; - - Function SetNumId(obj, numberobj); - Begin - if not ifObj(numberobj) then return; - numPr := class(TSXml).GetNode(obj.node_, 'w:pPr/w:numPr/w:numId'); - if ifObj(numPr) then - begin - id := numpr.GetAttribute('w:val'); - numberid := numberobj.CopyNumbering(id); - numpr.SetAttribute('w:val', numberid); - end - End; - - Function GetNewName(name); - Begin - new_name := name; - count := 0; - while ifObj(old_style_obj_.GetStyle(class(TSXml).Utf8ToCurCodePage(new_name))) or style_name_map2_[new_name] do - new_name := new_name $ count++; - return new_name; - End; - - Function GetNewId(id); - Begin - new_id := id; - count := 0; - while ifObj(old_style_obj_.GetStyleById(new_id)) or style_id_map2_[new_id] do - new_id := new_id $ count++; - return new_id; - End; - -private - old_style_obj_; - new_style_obj_; - - style_id_map_; // [old_id: new_id]; - style_name_map_; // [old_name: new_name]; - style_id_map2_; // [new_id: old_id]; - style_name_map2_; // [old_name: new_name]; - - id_map_; // [id: styleobj] -End; - -Type TDocxNumberCopy = class - - Function Create(oldObj, newObj); - Begin - numberingxml := newObj.Zip().Get('word/numbering.xml'); - if ifObj(numberingxml) then - begin - old_number_obj_ := oldObj.NumberingObject(); - new_number_obj_ := newObj.NumberingObject(); - end - else begin - old_number_obj_ := nil; - new_number_obj_ := nil; - end - id_map_ := array(); - End; - - Function CopyNumbering(number); - Begin - if ifObj(old_number_obj_) and ifObj(new_number_obj_) then - begin - if (obj := new_number_obj_.NumberStyle(number)) and not id_map_[number] then - begin - number_obj := old_number_obj_.CopyNumber(obj); - id_map_[number] := number_obj; - end - return id_map_[number]; - end - End; - -private - old_number_obj_; - new_number_obj_; - - id_map_; // [id: styleobj] -End; - -Type TDocxFootnoteCopy = class - - Function Create(oldObj, newObj); - Begin - footnotexml := newObj.Zip().Get('word/footnotes.xml'); - if ifObj(footnotexml) then - begin - old_footnote_obj_ := oldObj.FootNotesObject(); - new_footnote_obj_ := newObj.FootNotesObject(); - end - else begin - old_footnote_obj_ := nil; - new_footnote_obj_ := nil; - end - id_map_ := array(); - End; - - Function CopyFootnote(id); - Begin - if ifObj(old_footnote_obj_) and ifObj(new_footnote_obj_) then - begin - if (obj := new_footnote_obj_.GetFootnote(id)) and not id_map_[id] then - begin - footnote_obj := old_footnote_obj_.CopyFootnote(obj); - id_map_[id] := footnote_obj; - end - return id_map_[id]; - end - End; - -private - [weakref]old_footnote_obj_; - new_footnote_obj_; - - id_map_; // [id: footnote] -End; +Type TDocxCopy = class + + Function Create(oldObj, newObj) + Begin + old_docx_obj_ := oldObj; + new_docx_obj_ := newObj; + copy_table_ := array(); + copy_paragraph_ := array(); + copy_drawing_ := array(); + style_copy_obj_ := new TDocxStyleCopy(oldObj.StyleObject(), newObj.StyleObject()); + number_copy_obj_ := new TDocxNumberCopy(oldObj, newObj); + footnote_copy_obj_ := new TDocxFootnoteCopy(oldObj, newObj); + End; + + Function Init(); + Begin + style_copy_obj_.Init(); + End; + + ///从posOpt位置开始复制word + ///posOpt: 段落位置，0 在DOCX文件开头；-1 文件尾；N 在第N段之后；XmlNode节点对象或DocObject对象 在posOpt之后新添加图片 + Function Copy(posOpt); + Begin + // 复制所有的样式 + style_copy_obj_.CopyStyle(number_copy_obj_); + + parts := new_docx_obj_.Body().Parts(); + pos := old_docx_obj_.GetPosNode(posOpt); + for i:=0 to length(parts)-1 do + begin + case GetPartType(parts[i]) of + 0: pos := CopyParagraph(parts[i], pos); + 1: pos := CopyDrawing(parts[i], pos); + 2: pos := CopyTable(parts[i], pos); + end; + end + End; + + Function CopyParagraph(obj, pos); + Begin + paragraph := old_docx_obj_.Body().CopyWp(obj, pos); + SetParagraphInfo(paragraph); + copy_paragraph_[length(copy_paragraph_)] := paragraph; + return paragraph; + End; + + Function CopyDrawing(obj, pos); + Begin + paragraph := old_docx_obj_.Body().CopyWp(obj, pos); + SetDrawingInfo(paragraph); + copy_drawing_[length(copy_drawing_)] := paragraph; + return paragraph; + End; + + Function CopyTable(obj, pos); + Begin + table := old_docx_obj_.Body().CopyWtbl(obj, pos); + SetTableInfo(table); + copy_table_[length(copy_table_)] := table; + return table; + End; + + Function GetCopiedTable(); + Begin + return copy_table_; + End; + + Function GetCopiedParagraph(); + Begin + return copy_paragraph_; + End; + + Function GetCopiedDrawing(); + Begin + return copy_drawing_; + End; + +private + + Function DeleteComment(paragraph); + Begin + node := paragraph.node_.FirstChildElement('w:commentRangeStart'); + while ifObj(node) do + begin + name := node.GetName(); + if name = "w:commentRangeStart" or name = "w:commentRangeEnd" then + begin + delete_node := node; + node := node.NextElement(); + paragraph.node_.DeleteChild(delete_node); + if node.FirstChildElement('w:commentReference') then + begin + delete_node := node; + node := node.NextElement(); + paragraph.node_.DeleteChild(delete_node); + end + end + else begin + node := node.NextElement(); + end + end + End; + + Function SetRObject(node); + Begin + image_data_node := class(TSXml).GetNode(node, 'v:shape/v:imagedata'); + if not ifObj(node) then return; + rid := image_data_node.GetAttribute('r:id'); + id := CopyRidContent(rid, 'media/image', 'image'); + if id then image_data_node.SetAttribute('r:id', 'rId' $ id); + ole_node := class(TSXml).GetNode(node, 'o:OLEObject'); + if not ifObj(node) then return; + rid := ole_node.GetAttribute('r:id'); + id := CopyRidContent(rid, 'embeddings/oleObject', 'oleObject'); + if id then ole_node.SetAttribute('r:id', 'rId' $ id); + End; + + function CopyRidContent(id, tar_prefix, type_postfix); + begin + rels := new_docx_obj_.Zip().Get('word/_rels/document.xml.rels'); + target := class(TSXml).FindRelationshipTarget(rels, id); + image_file := new_docx_obj_.Zip().Get('word/' $ target).Data(); + + // 比较新文件的图片在旧文件中是否存在 + zip := old_docx_obj_.Zip(); + xml := zip.Get('word/_rels/document.xml.rels'); + files := sselect ['FileName'] from zip.Files() where AnsiStartsText('word/' $ tar_prefix, ['FileName']) end; + for i:=0 to length(files)-1 do Begin + if zip.Diff(files[i], image_file) = 0 then Begin + prefix := ReplaceStr(files[i], 'word/', ''); + [maxRid, imageFile, rid] := class(TSXml).FindRelationshipRid(xml, prefix); + End; + End; + if rid = 0 then + begin + image_cnt := length(files) + 1; + if ParseRegExpr("\\w+$", target, "", result, Mpos, Mlen) then + begin + postfix := result[0][0]; + image_path := tar_prefix $ image_cnt $ '.' $ postfix; + [rid, tar] := class(TSXml).FindRelationshipRid(xml, ''); + rid ++; + class(TSXml).AddRelationshipRid(xml, image_path, 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/' $ type_postfix, 'rId' $ rid); + zip.Add('word/' + image_path, image_file); + contentXml := zip.Get('[Content_Types].xml'); + if postfix = 'wmf' then content_type := 'image/x-wmf'; + else if postfix = 'bin' then content_type := 'application/vnd.openxmlformats-officedocument.oleObject'; + class(TSXml).AddDefaultContentType(contentXml, postfix, content_type); + end + end + return rid; + end; + + Function SetPic(node); + Begin + // 获取新文件的图片 + rembed := node.GetAttribute('r:embed'); + rels := new_docx_obj_.Zip().Get('word/_rels/document.xml.rels'); + target := class(TSXml).FindRelationshipTarget(rels, rembed); + image_file := new_docx_obj_.Zip().Get('word/' $ target).Data(); + + // 比较新文件的图片在旧文件中是否存在 + zip := old_docx_obj_.Zip(); + xml := zip.Get('word/_rels/document.xml.rels'); + files := sselect ['FileName'] from zip.Files() where AnsiStartsText('word/media/image', ['FileName']) end; + for i:=0 to length(files)-1 do Begin + if zip.Diff(files[i], image_file) = 0 then Begin + prefix := ReplaceStr(files[i], 'word/', ''); + [maxRid, imageFile, rid] := class(TSXml).FindRelationshipRid(xml, prefix); + End; + End; + if rid = 0 then + begin + image_cnt := length(files) + 1; + if ParseRegExpr("\\w+$", target, "", result, Mpos, Mlen) then + begin + postfix := result[0][0]; + image_path := "media/image" $ image_cnt $ '.' $ postfix; + [rid, tar] := class(TSXml).FindRelationshipRid(xml, ''); + rid ++; + class(TSXml).AddRelationshipRid(xml, image_path, 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/image', 'rId' $ rid); + zip.Add('word/' + image_path, image_file); + contentXml := zip.Get('[Content_Types].xml'); + class(TSXml).AddDefaultContentType(contentXml, postfix, 'image/' $ postfix); + end + end + node.SetAttribute('r:embed', 'rId' $ rid); + End; + + Function SetChart(node); + Begin + rid := node.GetAttribute('r:id'); + rels := new_docx_obj_.Zip().Get('word/_rels/document.xml.rels'); + target := class(TSXml).FindRelationshipTarget(rels, rid); + new_zip := new_docx_obj_.Zip(); + chart_file := new_zip.Get('word/' $ target); + + // 复制charN.xml + zip := old_docx_obj_.Zip(); + files := sselect ['FileName'] from zip.Files() where AnsiStartsText('word/charts/chart', ['FileName']) end; + new_chart_file := "charts/chart" $ (length(files) + 1) $ ".xml"; + xml := zip.Get('word/_rels/document.xml.rels'); + [new_rid, tar] := class(TSXml).FindRelationshipRid(xml, ''); + new_rid++; + class(TSXml).AddRelationshipRid(xml, new_chart_file, "http://schemas.openxmlformats.org/officeDocument/2006/relationships/chart", 'rId' $ new_rid); + zip.Add('word/' + new_chart_file, chart_file.Data()); + contentXml := zip.Get('[Content_Types].xml'); + class(TSXml).AddOverrideContentType(contentXml, '/word/' + new_chart_file, 'application/vnd.openxmlformats-officedocument.drawingml.chart+xml'); + node.SetAttribute('r:id', 'rId' $ new_rid); + + // 复制charN.xml.rels + chart_rels := "word/charts/_rels" + target[pos('/', target):] $ ".rels"; + chart_rels_xml := new_zip.Get(chart_rels); + if ifObj(chart_rels_xml) then + begin + zip.Add('word/charts/_rels/chart' $ (length(files) + 1) $ ".xml.rels", chart_rels_xml.Data()); + relationship := chart_rels_xml.FirstChildElement('Relationships').FirstChildElement('Relationship'); + while ifObj(relationship) do + begin + target := relationship.GetAttribute('Target'); + target_path := AnsiReplaceText(target, '..', 'word'); + file := new_zip.Get(target_path); + if ifObj(file) then + begin + [new_file, filetype] := GetNewTargetFileName(zip, target_path); + zip.Add(new_file, file.Data()); + if filetype then Class(TSXml).AddDefaultContentType(contentXml, filetype[2:], 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'); + end + relationship := relationship.NextElement(); + end; + end + End; + + Function GetNewTargetFileName(zip, fileName); + Begin + files := zip.Files()[:, 'FileName']; + ret := ParseRegExpr("(.*/)(\\w+)(\.\\w+)$", fileName, "", result, Mpos, Mlen); + count := 0; + while fileName in files do + begin + if ret then + fileName := result[0][1] $ result[0][2] $ "tinysoft" $ count $ result[0][3]; + else fileName := fileName $ "tinysoft" $ count; + count++; + end + if ret then filetype := result[0][3]; + return array(fileName, filetype); + End; + + Function SetDrawingInfo(drawing); + Begin + graphic_node := class(TSXml).GetNode(drawing.node_,'w:r/w:drawing/wp:inline/a:graphic/a:graphicData'); + if ifObj(graphic_node) then + begin + node := class(TSXml).GetNode(graphic_node,'pic:pic/pic:blipFill/a:blip'); + if ifObj(node) then SetPic(node); + node := class(TSXml).GetNode(graphic_node, 'c:chart'); + if ifObj(node) then SetChart(node); + end; + End; + + Function SetParagraphInfo(paragraph); + Begin + CopyStyle(paragraph.node_, 'w:pPr/w:pStyle'); + CopyNumber(paragraph.node_, 'w:pPr/w:numPr/w:numId'); + SetRunsInfo(paragraph.node_); + DeleteComment(paragraph); // 删除批注 + End; + + Function SetRunsInfo(node); + Begin + run := node.FirstChildElement('w:r'); + while ifObj(run) do + begin + CopyFootnote(run); + CopyStyle(run, 'w:rPr/w:rStyle'); + obj_node := class(TSXml).GetNode(run, 'w:object'); + if ifObj(obj_node) then + SetRObject(obj_node); + run := run.NextElement(); + end + End; + + Function CopyStyle(node, path); + Begin + style := class(TSXml).GetNode(node, path); + if ifObj(style) then + begin + styleid := style.GetAttribute('w:val'); + new_id := style_copy_obj_.GetStyleNewId(styleid); + if new_id then style.SetAttribute('w:val', new_id); + end + End; + + Function CopyNumber(node, path); + Begin + numpr := class(TSXml).GetNode(node, path); + if ifObj(numpr) then + begin + id := numpr.GetAttribute('w:val'); + numberid := number_copy_obj_.CopyNumbering(id); + numpr.SetAttribute('w:val', numberid); + end + End; + + Function CopyFootnote(node); + Begin + footnote := node.FirstChildElement('w:footnoteReference'); + if not ifObj(footnote) then return; + id := footnote.GetAttribute('w:id'); + if id then + begin + obj := footnote_copy_obj_.CopyFootnote(id); + footnote.SetAttribute('w:id', obj.Id); + parts := obj.Parts(); + for i:=0 to length(parts)-1 do + begin + case GetPartType(parts[i]) of + 0: SetParagraphInfo(parts[i]); + 1: SetDrawingInfo(parts[i]); + 2: SetTableInfo(parts[i]); + end; + end + end + End; + + Function SetTableInfo(table); + Begin + style := class(TSXml).GetNode(table.node_, 'w:tblPr/w:tblStyle'); + if ifObj(style) then + begin + id := style.GetAttribute('w:val'); + new_id := style_copy_obj_.GetStyleNewId(id); + if new_id then style.SetAttribute('w:val', new_id); + end + col := table.Cols(); + row := table.Rows(); + for r:=1 to row do + begin + for c:=1 to col do + begin + cell := table.Cell(r, c); + if not cell then continue; + node := cell.node_.FirstChildElement(); + while ifObj(node) do + begin + name := node.GetName(); + if name = 'w:tbl' then + begin + obj := TOfficeObj('TTable'); + obj.Init(node); + SetTableInfo(obj); + end + else if name = "w:p" then + begin + draw := class(TSXml).GetNode(node, 'w:r/w:drawing'); + if ifObj(draw) then + begin + obj := TOfficeObj('TPicture'); + obj.Init(node); + SetDrawingInfo(obj); + end + else begin + obj := TOfficeObj('TParagraph'); + obj.Init(node); + SetParagraphInfo(obj); + end + end + node := node.NextElement(); + end + end + end + End; + + /// 普通段落: 0 + /// 图片段落: 1 + /// 表格: 2 + /// 其他类型暂不复制 + Function GetPartType(part); + Begin + name := part.name_; + case name of + 'w:p': + begin + if class(TSXml).GetNode(part.node_, 'w:r/w:drawing') then return 1; + return 0; + end + 'w:tbl': + return 2; + else + return -1; + end + End; + +private + old_docx_obj_; + new_docx_obj_; + style_copy_obj_; + number_copy_obj_; + footnote_copy_obj_; + + copy_table_; + copy_paragraph_; + copy_drawing_; +End; + +Type TDocxStyleCopy = class + + Function Create(oldObj, newObj); + Begin + old_style_obj_ := oldObj; + new_style_obj_ := newObj; + style_id_map_ := array(); + style_name_map_ := array(); + style_id_map2_ := array(); + style_name_map2_ := array(); + id_map_ := array(); + End; + + Function Init(); + Begin + id_styles := new_style_obj_.Styles(); + for id, obj in id_styles do + begin + new_obj := obj; + id_map_[id] := new_obj; + SetId(new_obj, id); + SetName(new_obj); + end + End; + + Function CopyStyle(numberobj); + Begin + for id, obj in id_map_ do + begin + SetBasedOn(obj); + SetNumId(obj, numberobj); + SetLink(obj); + old_style_obj_.CopyStyle(obj); + end; + End; + + Function GetStyleNewId(oldId) + Begin + if ifnumber(oldId) then oldId := tostring(oldId); + return style_id_map_[oldId]; + End; + +private + + Function SetId(obj, id); + Begin + new_id := GetNewId(id); + obj.node_.SetAttribute('w:styleId', new_id); + style_id_map_[id] := new_id; + style_id_map2_[new_id] := id; + End; + + Function SetName(obj); + Begin + name_node := obj.node_.FirstChildElement('w:name'); + name := name_node.GetAttribute('w:val'); + new_name := GetNewName(name); + name_node.SetAttribute('w:val', new_name); + style_name_map_[name] := new_name; + style_name_map2_[new_name] := name; + End; + + Function SetBasedOn(obj); + Begin + basedon := obj.node_.FirstChildElement('w:basedOn'); + if ifObj(basedon) then + begin + val := basedon.GetAttribute('w:val'); + if style_id_map_[val] then basedOn.SetAttribute('w:val', style_id_map_[val]); + end + End; + + Function SetLink(obj); + Begin + link := obj.node_.FirstChildElement('w:link'); + if ifObj(link) then + begin + val := link.GetAttribute('w:val'); + if style_id_map_[val] then link.SetAttribute('w:val', style_id_map_[val]); + end + End; + + Function SetNumId(obj, numberobj); + Begin + if not ifObj(numberobj) then return; + numPr := class(TSXml).GetNode(obj.node_, 'w:pPr/w:numPr/w:numId'); + if ifObj(numPr) then + begin + id := numpr.GetAttribute('w:val'); + numberid := numberobj.CopyNumbering(id); + numpr.SetAttribute('w:val', numberid); + end + End; + + Function GetNewName(name); + Begin + new_name := name; + count := 0; + while ifObj(old_style_obj_.GetStyle(class(TSXml).Utf8ToCurCodePage(new_name))) or style_name_map2_[new_name] do + new_name := new_name $ count++; + return new_name; + End; + + Function GetNewId(id); + Begin + new_id := id; + count := 0; + while ifObj(old_style_obj_.GetStyleById(new_id)) or style_id_map2_[new_id] do + new_id := new_id $ count++; + return new_id; + End; + +private + old_style_obj_; + new_style_obj_; + + style_id_map_; // [old_id: new_id]; + style_name_map_; // [old_name: new_name]; + style_id_map2_; // [new_id: old_id]; + style_name_map2_; // [old_name: new_name]; + + id_map_; // [id: styleobj] +End; + +Type TDocxNumberCopy = class + + Function Create(oldObj, newObj); + Begin + numberingxml := newObj.Zip().Get('word/numbering.xml'); + if ifObj(numberingxml) then + begin + old_number_obj_ := oldObj.NumberingObject(); + new_number_obj_ := newObj.NumberingObject(); + end + else begin + old_number_obj_ := nil; + new_number_obj_ := nil; + end + id_map_ := array(); + End; + + Function CopyNumbering(number); + Begin + if ifObj(old_number_obj_) and ifObj(new_number_obj_) then + begin + if (obj := new_number_obj_.NumberStyle(number)) and not id_map_[number] then + begin + number_obj := old_number_obj_.CopyNumber(obj); + id_map_[number] := number_obj; + end + return id_map_[number]; + end + End; + +private + old_number_obj_; + new_number_obj_; + + id_map_; // [id: styleobj] +End; + +Type TDocxFootnoteCopy = class + + Function Create(oldObj, newObj); + Begin + footnotexml := newObj.Zip().Get('word/footnotes.xml'); + if ifObj(footnotexml) then + begin + old_footnote_obj_ := oldObj.FootNotesObject(); + new_footnote_obj_ := newObj.FootNotesObject(); + end + else begin + old_footnote_obj_ := nil; + new_footnote_obj_ := nil; + end + id_map_ := array(); + End; + + Function CopyFootnote(id); + Begin + if ifObj(old_footnote_obj_) and ifObj(new_footnote_obj_) then + begin + if (obj := new_footnote_obj_.GetFootnote(id)) and not id_map_[id] then + begin + footnote_obj := old_footnote_obj_.CopyFootnote(obj); + id_map_[id] := footnote_obj; + end + return id_map_[id]; + end + End; + +private + [weakref]old_footnote_obj_; + new_footnote_obj_; + + id_map_; // [id: footnote] +End; diff --git a/funcext/TSOffice/worksheet/xlsxWorkBook.tsf b/funcext/TSOffice/worksheet/xlsxWorkBook.tsf index d65d40b..9831df8 100644 --- a/funcext/TSOffice/worksheet/xlsxWorkBook.tsf +++ b/funcext/TSOffice/worksheet/xlsxWorkBook.tsf @@ -994,7 +994,7 @@ Type xlsxWorkBook = Class col_node := work_node.FirstChildElement('cols'); default_width := work_node.FirstChildElement('sheetFormatPr').GetAttribute('defaultColWidth'); default_width := trystrtofloat(default_width, r) ? r: -1; - if not ifObj(col_node) then return array(0, default_width); + if not ifObj(col_node) then return nil; col_number := ColumnNameToNumber(col)[1]; node := col_node.FirstChildElement('col'); diff --git a/更新日志.md b/更新日志.md index 34336d0..58ebb61 100644 --- a/更新日志.md +++ b/更新日志.md @@ -1,5 +1,15 @@ # 更新日志 +## 2025-12-15 + +#### word + +1. 修复插入word时，单元格内容不完整问题 + +#### excel + +1. 修复`GetColWithd`返回值出现数组问题，没有设置宽度返回`nil` + ## 2025-11-07 ### V1.8.4