CopyParagraphs.vb
'' '' This code is part of Document Solutions for Word demos . '' Copyright (c) MESCIUS inc. All rights reserved. '' Imports System . IO Imports System . Drawing Imports System . Linq Imports GrapeCity . Documents . Word Imports GcFont = GrapeCity . Documents . Word . Font '' Starting with the v3 release (fall of 2019), DsWord provides built-in '' support for copying and moving of content using the RangeBase.CopyTo() '' and RangeBase.MoveTo() methods, so this sample is now obsolete. '' '' The original SampleParagraphs.docx used in this sample can be '' seen by running the SampleParagraphs sample. Public Class CopyParagraphs Function CreateDocx () As GcWordDocument Const p1start = "This is the first paragraph of the original document" Const p2start = "This is the second paragraph of the original document" Const p3start = "This is the third paragraph of the original document" Const p4start = "This is the fourth paragraph of the original document" Dim doc = New GcWordDocument () '' Load an existing DOCX file: doc . Load ( Path . Combine ( "Resources" , "WordDocs" , "SampleParagraphs.docx" )) Dim p1 = Nothing , p2 = Nothing , p3 = Nothing , p4 = Nothing For Each p In doc . Body . Paragraphs Dim t = p . GetRange (). Text If ( t . StartsWith ( p1start )) Then p1 = p ElseIf ( t . StartsWith ( p2start )) Then p2 = p ElseIf ( t . StartsWith ( p3start )) Then p3 = p ElseIf ( t . StartsWith ( p4start )) Then p4 = p End If Next If p1 Is Nothing OrElse p2 Is Nothing OrElse p3 Is Nothing OrElse p4 Is Nothing Then Throw New Exception ( "Unexpected: could not find paragraphs." ) End If Dim swapResult = Helper . SwapParagraphs ( p1 , p3 ) swapResult . Item1 . GetRange (). Runs . Insert ( "Second swapped paragraph (paragraph 3): " , InsertLocation . Start ) swapResult . Item2 . GetRange (). Runs . Insert ( "First swapped paragraph (paragraph 1): " , InsertLocation . Start ) Dim joinResult = Helper . JoinParagraphs ( doc . Body . Paragraphs . Add (), swapResult . Item1 , swapResult . Item2 ) joinResult . GetRange (). Runs . Insert ( "Jointed first and 3rd paragraphs: " , InsertLocation . Start ) '' Add a note at the end of the document: doc . Body . Paragraphs . Add ($ "Created by DsWord on {Util.TimeNow():R}." ) '' Done: Return doc End Function '' A static helper class that provides methods to copy or move '' DsWord content objects such as paragraphs and runs. '' '' AddRun, AddPicture, AddField, AddText, AddParagraph methods accept parameter '' "withFormatting" which determines whether to copy just the content, '' or content and formatting. Note that if this parameter is true, '' direct formatting is applied to the newly created objects, '' so the connection to the original document style is broken '' (updating the style will not affect the new objects). Public Class Helper '' Swaps two paragraphs by inserting a new paragraph before each one, '' copying the content (and optionally formatting) from the other paragraph, '' and the removing the old paragraphs. Public Shared Function SwapParagraphs ( ByRef p1 As Paragraph , ByRef p2 As Paragraph , Optional ByVal withFormatting As Boolean = True ) As ( Paragraph , Paragraph ) If p1 . ParentBody IsNot p2 . ParentBody Then Throw New Exception ( "Both paragraphs must belong the same parent body." ) End If Dim newP2 = p1 . GetRange (). Paragraphs . Insert ( InsertLocation . Before ) CopyParagraph ( newP2 , p2 , withFormatting ) Dim newP1 = p2 . GetRange (). Paragraphs . Insert ( InsertLocation . Before ) CopyParagraph ( newP1 , p1 , withFormatting ) p1 . Delete () p2 . Delete () Return ( newP1 , newP2 ) End Function '' Copies the contents (and optionally formatting) of two paragraphs into a third one. Public Shared Function JoinParagraphs ( ByRef target As Paragraph , ByRef p1 As Paragraph , ByRef p2 As Paragraph , Optional ByVal withFormatting As Boolean = True ) As Paragraph If p1 . ParentBody IsNot p2 . ParentBody Then Throw New Exception ( "Both paragraphs must belong the same parent body." ) End If CopyParagraph ( target , p1 , withFormatting ) CopyParagraph ( target , p2 , withFormatting ) Return target End Function '' Copy child objects from one content object to another. Private Shared Sub CopyChildren ( ByRef target As ContentObject , ByRef source As ContentObject , ByVal withFormatting As Boolean ) For Each child In source . Children Select Case child . GetType () Case GetType ( Run ) AddRun ( target , child , withFormatting ) Case GetType ( SimpleField ) AddField ( target , child , withFormatting ) Case GetType ( Picture ) AddPicture ( target , child , withFormatting ) Case GetType ( Paragraph ) AddParagraph ( target , child , withFormatting ) Case GetType ( Text ) AddText ( target , child , withFormatting ) Case Else Debug . Assert ( False , "Unexpected: unknown content object type." ) End Select Next End Sub '' Joins two paragraphs. Private Shared Function JoinParagraphs ( ByRef first As Paragraph , ByRef second As Paragraph , Optional ByVal withFormatting As Boolean = False ) As Paragraph If first . ParentBody IsNot second . ParentBody Then Throw New Exception ( "Left and right paragraphs must belong the same parent body." ) End If Dim newParagraph = first . ParentBody . Paragraphs . Add () CopyParagraph ( newParagraph , first , withFormatting ) '' Note that second paragraph formatting overrides first paragraph formatting: CopyParagraph ( newParagraph , second , withFormatting ) Return newParagraph End Function '' Adds a copy of a paragraph to a body. Private Shared Sub AddParagraph ( ByRef bod As Body , ByRef source As Paragraph , Optional ByVal withFormatting As Boolean = False ) Dim newParagraph = bod . Paragraphs . Add () CopyParagraph ( newParagraph , source , withFormatting ) End Sub '' Adds a copy of a paragraph to a content object. Private Shared Sub AddParagraph ( ByRef target As ContentObject , ByRef source As Paragraph , Optional ByVal withFormatting As Boolean = False ) Dim newParagraph = target . GetRange (). Paragraphs . Add () CopyParagraph ( newParagraph , source , withFormatting ) End Sub '' Adds a copy of a run to a content object. Private Shared Sub AddRun ( ByRef target As ContentObject , ByRef source As Run , Optional ByVal withFormatting As Boolean = False ) Dim newRun = target . GetRange (). Runs . Add () CopyRun ( newRun , source , withFormatting ) End Sub '' Copies a paragraph to another paragraph. Private Shared Sub CopyParagraph ( ByRef target As Paragraph , ByRef source As Paragraph , Optional ByVal withFormatting As Boolean = False ) CopyRevisionId ( target . RevisionId , source . RevisionId ) CopyChildren ( target , source , withFormatting ) If ( withFormatting ) Then CopyParagraphFormat ( target , source ) End If End Sub '' Adds a copy of a text to a content object. Private Shared Sub AddText ( ByRef target As ContentObject , ByRef source As Text , ByVal withFormatting As Boolean ) Dim newText = target . GetRange (). Texts . Add ( source . Value ) CopyText ( newText , source , withFormatting ) End Sub '' Copies a text to another text. Private Shared Sub CopyText ( ByRef target As Text , ByRef source As Text , ByVal withFormatting As Boolean ) target . PreserveSpace = source . PreserveSpace CopyChildren ( target , source , withFormatting ) End Sub '' Adds a copy of a field to a content object. Private Shared Sub AddField ( ByRef target As ContentObject , ByRef source As SimpleField , ByVal withFormatting As Boolean ) Dim newField = target . GetRange (). SimpleFields . Add ( source . Code ) CopySimpleField ( newField , source , withFormatting ) End Sub '' Copies a simple field to another simple field. Private Shared Sub CopySimpleField ( ByRef target As SimpleField , ByRef source As SimpleField , ByVal withFormatting As Boolean ) target . Code = source . Code target . CustomData = source . CustomData target . Locked = source . Locked ''parse children CopyChildren ( target , source , withFormatting ) End Sub '' Copies a run to another run. Private Shared Sub CopyRun ( ByRef target As Run , ByRef source As Run , ByVal withFormatting As Boolean ) CopyRevisionId ( target . RevisionId , source . RevisionId ) CopyChildren ( target , source , withFormatting ) If withFormatting Then target . Style = target . Style CopyFont ( target . Font , source . Font ) End If End Sub '' Copies a revision ID. Private Shared Sub CopyRevisionId ( ByRef target As RevisionId , ByRef source As RevisionId ) target . AdditionId = source . AdditionId target . DeletionId = source . DeletionId target . PropertiesId = source . PropertiesId End Sub '' Adds a copy of a picture to a content object. Private Shared Sub AddPicture ( ByRef target As ContentObject , ByRef source As Picture , ByVal withFormatting As Boolean ) Dim newPicture = target . GetRange (). Pictures . Add () CopyPicture ( newPicture , source , withFormatting ) End Sub '' Copies a picture to another picture. Private Shared Sub CopyPicture ( ByRef target As Picture , ByRef source As Picture , ByVal withFormatting As Boolean ) CopyImageData ( target . ImageData , source . ImageData , withFormatting ) target . Name = source . Name target . Title = source . Title CopyChildren ( target , source , withFormatting ) If Not withFormatting Then Return End If target . AlternativeText = source . AlternativeText target . Hidden = source . Hidden CopyShapeRotation ( target . Rotation , source . Rotation ) CopyShapeSize ( target . Size , source . Size ) CopyWrapFormat ( target . WrapFormat , source . WrapFormat ) End Sub '' Copies image data to another image data. Private Shared Sub CopyImageData ( ByRef target As ImageData , ByRef source As ImageData , ByVal withFormatting As Boolean ) target . Compression = source . Compression target . Source = source . Source target . SetImage ( source . ToStream (), source . ContentType ) If withFormatting Then CopyEdgeExtent ( target . Crop , source . Crop ) End If End Sub '' Copies paragraph formatting to another paragraph. Private Shared Sub CopyParagraphFormat ( ByRef target As Paragraph , ByRef source As Paragraph ) target . Style = source . Style target . Mark . Style = source . Mark . Style CopyParagraphFormatting ( target . Format , source . Format ) '' target . ListFormat . Template = source . ListFormat . Template target . ListFormat . LevelNumber = source . ListFormat . LevelNumber End Sub '' Copies a font to another font. Private Shared Sub CopyFont ( ByRef target As GcFont , ByRef source As GcFont ) target . AllCaps = source . AllCaps target . AlwaysHidden = source . AlwaysHidden target . Animation = source . Animation target . Bidi = source . Bidi target . Bold = source . Bold target . BoldBi = source . BoldBi CopyBorder ( target . Border , source . Border ) CopyWordColor ( target . Color , source . Color ) target . ContextualAlternates = source . ContextualAlternates target . DisableCharacterSpaceGrid = source . DisableCharacterSpaceGrid target . DoubleStrikeThrough = source . DoubleStrikeThrough CopyEastAsianLayout ( target . EastAsianLayout , source . EastAsianLayout ) target . Emboss = source . Emboss target . EmphasisMark = source . EmphasisMark target . Engrave = source . Engrave target . FitTextId = source . FitTextId target . FitTextWidth = source . FitTextWidth target . Hidden = source . Hidden target . HighlightColor = source . HighlightColor target . HintType = source . HintType target . Italic = source . Italic target . ItalicBi = source . ItalicBi target . Kerning = source . Kerning target . Ligatures = source . Ligatures target . LocaleName = source . LocaleName target . LocaleNameBi = source . LocaleNameBi '' target . LocaleNameFarEast = source . LocaleNameFarEast target . Name = source . Name target . NameAscii = source . NameAscii target . NameBi = source . NameBi target . NameFarEast = source . NameFarEast target . NameOther = source . NameOther target . NoProofing = source . NoProofing target . NumberForm = source . NumberForm target . NumberSpacing = source . NumberSpacing target . Outline = source . Outline target . Position = source . Position target . RightToLeft = source . RightToLeft target . Scaling = source . Scaling CopyShading ( target . Shading , source . Shading ) target . Shadow = source . Shadow target . Size = source . Size target . SizeBi = source . SizeBi target . SmallCaps = source . SmallCaps target . Spacing = source . Spacing target . StrikeThrough = source . StrikeThrough target . StylisticSets = source . StylisticSets target . ThemeAscii = source . ThemeAscii target . ThemeBi = source . ThemeBi target . ThemeFarEast = source . ThemeFarEast target . ThemeOther = source . ThemeOther target . Underline = source . Underline CopyWordColor ( target . UnderlineColor , source . UnderlineColor ) target . VerticalPosition = source . VerticalPosition target . WebHidden = source . WebHidden End Sub '' Copies East Asian layout. Private Shared Sub CopyEastAsianLayout ( ByRef target As EastAsianLayout , ByRef source As EastAsianLayout ) target . FitVerticalInLine = source . FitVerticalInLine target . HorizontalInVertical = source . HorizontalInVertical target . TwoLinesInOne = source . TwoLinesInOne target . TwoLinesInOneBrackets = source . TwoLinesInOneBrackets End Sub '' Copies paragraph formatting. Private Shared Sub CopyParagraphFormatting ( ByRef target As ParagraphFormat , ByRef source As ParagraphFormat ) target . Alignment = source . Alignment target . BaseLineAlignment = source . BaseLineAlignment target . Bidi = source . Bidi target . DisableLineHeightGrid = source . DisableLineHeightGrid target . FarEastLineBreakControl = source . FarEastLineBreakControl target . HalfWidthPunctuationOnTopOfLine = source . HalfWidthPunctuationOnTopOfLine target . HangingPunctuation = source . HangingPunctuation target . Hyphenation = source . Hyphenation target . KeepTogether = source . KeepTogether target . KeepWithNext = source . KeepWithNext target . NoLineNumber = source . NoLineNumber target . OutlineLevel = source . OutlineLevel target . PageBreakBefore = source . PageBreakBefore target . TextboxTightWrap = source . TextboxTightWrap target . TextFlowDirection = source . TextFlowDirection target . WidowControl = source . WidowControl target . WordWrap = source . WordWrap CopyShading ( target . Shading , source . Shading ) CopySpacing ( target . Spacing , source . Spacing ) CopyIndentation ( target . Indentation , source . Indentation ) ''copy TabStops For Each tabStop In source . TabStops If tabStop . Leader <> TabStopLeader . None Then target . TabStops . Add ( tabStop . Position , tabStop . Alignment ) Else target . TabStops . Add ( tabStop . Position , tabStop . Alignment , tabStop . Leader ) End If Next ''copy borders CopyBorder ( target . Borders . Inside , source . Borders . Inside ) CopyBorder ( target . Borders . Left , source . Borders . Left ) CopyBorder ( target . Borders . Top , source . Borders . Top ) CopyBorder ( target . Borders . Right , source . Borders . Right ) CopyBorder ( target . Borders . Bottom , source . Borders . Bottom ) End Sub Private Shared Sub CopyIndentation ( ByRef target As Indentation , ByRef source As Indentation ) target . AutoAdjustRightIndent = source . AutoAdjustRightIndent target . CharacterUnitFirstLineIndent = source . CharacterUnitFirstLineIndent target . CharacterUnitLeftIndent = source . CharacterUnitLeftIndent target . CharacterUnitRightIndent = source . CharacterUnitRightIndent target . FirstLineIndent = source . FirstLineIndent target . LeftIndent = source . LeftIndent target . MirrorIndents = source . MirrorIndents target . RightIndent = source . RightIndent End Sub Private Shared Sub CopySpacing ( ByRef target As Spacing , ByRef source As Spacing ) target . AddSpaceBetweenFarEastAndAlpha = source . AddSpaceBetweenFarEastAndAlpha target . AddSpaceBetweenFarEastAndDigit = source . AddSpaceBetweenFarEastAndDigit target . LineSpacing = source . LineSpacing target . LineSpacingRule = source . LineSpacingRule target . LineUnitAfter = source . LineUnitAfter target . LineUnitBefore = source . LineUnitBefore target . NoSpaceBetweenParagraphsOfSameStyle = source . NoSpaceBetweenParagraphsOfSameStyle target . SpaceAfter = source . SpaceAfter target . SpaceAfterAuto = source . SpaceAfterAuto target . SpaceBefore = source . SpaceBefore target . SpaceBeforeAuto = source . SpaceBeforeAuto End Sub Private Shared Sub CopyShading ( ByRef target As Shading , ByRef source As Shading ) CopyWordColor ( target . BackgroundPatternColor , source . BackgroundPatternColor ) CopyWordColor ( target . ForegroundPatternColor , source . ForegroundPatternColor ) target . Texture = source . Texture End Sub Private Shared Sub CopyBorder ( ByRef target As Border , ByRef source As Border ) CopyWordColor ( target . Color , source . Color ) target . FrameEffect = source . FrameEffect target . LineStyle = source . LineStyle target . LineWidth = source . LineWidth target . Shadow = source . Shadow target . Space = source . Space target . Visible = source . Visible End Sub Private Shared Sub CopyWordColor ( ByRef target As WordColor , ByRef source As WordColor ) target . RGB = source . RGB '' Note: current DsWord OM does not provide means to find where a concrete color '' comes from, so copying theme colors will overwrite RGB even if the RGB value '' should be used. So for this sample, we just ignore theme colors: '' target.ThemeColor = source.ThemeColor '' target.ThemeShade = source.ThemeShade '' target.ThemeTint = source.ThemeTint End Sub Private Shared Sub CopyWrapFormat ( ByRef target As WrapFormat , ByRef source As WrapFormat ) target . BehindText = source . BehindText target . DistanceBottom = source . DistanceBottom target . DistanceLeft = source . DistanceLeft target . DistanceRight = source . DistanceRight target . DistanceTop = source . DistanceTop target . Side = source . Side target . Type = source . Type ''clone list If source . WrapPolygon IsNot Nothing Then target . WrapPolygon = source . WrapPolygon . ToList () End If End Sub Private Shared Sub CopyShapeRotation ( ByRef target As ShapeRotation , ByRef source As ShapeRotation ) target . Angle = source . Angle target . HorizontalFlip = source . HorizontalFlip target . VerticalFlip = source . VerticalFlip End Sub Private Shared Sub CopyShapeSize ( ByRef target As ShapeSize , ByRef source As ShapeSize ) CopyEdgeExtent ( target . EffectExtent , source . EffectExtent ) CopyShapeWidth ( target . Width , source . Width ) CopyShapeHeight ( target . Height , source . Height ) End Sub Private Shared Sub CopyShapeWidth ( ByRef target As ShapeWidth , ByRef source As ShapeWidth ) target . Relative = source . Relative target . RelativeTo = source . RelativeTo target . Value = source . Value End Sub Private Shared Sub CopyShapeHeight ( ByRef target As ShapeHeight , ByRef source As ShapeHeight ) target . Relative = source . Relative target . RelativeTo = source . RelativeTo target . Value = source . Value End Sub Private Shared Sub CopyEdgeExtent ( ByRef target As EdgeExtent , ByRef source As EdgeExtent ) target . AllEdges = source . AllEdges target . BottomEdge = source . BottomEdge target . LeftEdge = source . LeftEdge target . RightEdge = source . RightEdge target . TopEdge = source . TopEdge End Sub End Class End Class