'''' This code is part of Document Solutions for Word demos.'' Copyright (c) MESCIUS inc. All rights reserved.''ImportsSystem.DrawingImportsSystem.CollectionsImportsSystem.Collections.GenericImportsSystem.LinqImportsGrapeCity.Documents.Word '' This sample demonstrates all available shape presets'' that specify a shape's fill and outline.PublicClassShapePresetsFunctionCreateDocx() AsGcWordDocument Dim presets = GetType(ShapePreset).GetFields(System.Reflection.BindingFlags.PublicOrSystem.Reflection.BindingFlags.Static).Where(Function(p_) p_.FieldType = GetType(ShapePreset))Dim presetsCount = presets.Count()Dim doc = NewGcWordDocument() '' We will apply each preset to 2 consecutive shapes:Dim shapes = AddGeometryTypes(doc, NewSizeF(100, 100), presetsCount * 2, True) doc.Body.Paragraphs.Insert($"Shape presets ({presetsCount})", doc.Styles(BuiltInStyleId.Title), InsertLocation.Start) If (shapes.Count() > presetsCount * 2) Then shapes.Skip(presetsCount).ToList().ForEach(Sub(s_) s_.Delete())EndIf Dim presetIdx = 0Dim flop = 0ForEach s In shapesDim shape AsShape = s.GetRange().CopyTo(s.GetRange(), InsertLocation.After).ParentObjectDim preset = presets.ElementAt(presetIdx)If (flop Mod2) <> 0Then presetIdx += 1EndIf flop += 1 shape.ApplyPreset(CType(preset.GetValue(Nothing), ShapePreset)) shape.GetRange().Runs.Insert($"{preset.Name}:", InsertLocation.Before) shape.GetRange().Runs.Insert(vbCrLf, InsertLocation.After)''shape.GetRange().Texts.AddBreak(BreakType.TextWrapping)Next Return docEndFunction ''' <summary>''' Adds a paragraph with a single empty run, and adds a shape for each available GeometryType.''' The fill and line colors of the shapes are varied.''' </summary>''' <param name="doc">The target document.</param>''' <param name="size">The size of shapes to create.</param>''' <param name="count">The maximum number of shapes to create (-1 for no limit).</param>''' <param name="skipUnfillable">Add only shapes that support fills.</param>''' <param name="noNames">Do not add geometry names as shape text frames.</param>''' <returns>The list of shapes added to the document.</returns>PrivateSharedFunctionAddGeometryTypes(doc AsGcWordDocument, size AsSizeF, Optional count AsInteger = -1, Optional skipUnfillable AsBoolean = False, Optional noNames AsBoolean = False) AsList(OfShape) '' Line and fill colors:Dim lines = NewColor() {Color.Blue, Color.SlateBlue, Color.Navy, Color.Indigo, Color.BlueViolet, Color.CadetBlue}Dim line = 0Dim fills = NewColor() {Color.MistyRose, Color.BurlyWood, Color.Coral, Color.Goldenrod, Color.Orchid, Color.Orange, Color.PaleVioletRed}Dim fill = 0 '' The supported geometry types:Dim geoms AsGeometryType() = [Enum].GetValues(GetType(GeometryType)) '' Add a paragraph and a run where the shapes will live: doc.Body.Paragraphs.Add("")Dim run = doc.Body.Runs.Last Dim shapes = NewList(OfShape)ForEach g In geoms'' Line geometries do not support fills:If skipUnfillable AndAlso g.IsLineGeometry() ThenContinueForEndIfIf count = 0ThenExitForEndIf count -= 1 Dim w = size.Width, h = size.HeightDim shape = run.GetRange().Shapes.Add(w, h, g)IfNot g.IsLineGeometry() Then shape.Fill.Type = FillType.SolidIf fill < fills.Length - 1Then fill += 1Else fill = 0EndIf shape.Fill.SolidFill.RGB = fills(fill)EndIf shape.Line.Width = 3If line < lines.Length - 1Then line += 1Else line = 0EndIf shape.Line.Fill.SolidFill.RGB = lines(line)IfNot noNames AndAlso g.TextFrameSupported() Then shape.AddTextFrame(g.ToString())EndIf shape.AlternativeText = $"This is shape {g}" shape.Size.EffectExtent.AllEdges = 8 shapes.Add(shape)NextReturn shapesEndFunctionEndClass