ShapePresets.vb
  1. ''
  2. '' This code is part of Document Solutions for Word demos.
  3. '' Copyright (c) MESCIUS inc. All rights reserved.
  4. ''
  5. Imports System.IO
  6. Imports System.Drawing
  7. Imports System.Collections
  8. Imports System.Collections.Generic
  9. Imports System.Linq
  10. Imports GrapeCity.Documents.Word
  11.  
  12. '' This sample demonstrates all available shape presets
  13. '' that specify a shape's fill and outline.
  14. Public Class ShapePresets
  15. Function CreateDocx() As GcWordDocument
  16.  
  17. Dim presets = GetType(ShapePreset).GetFields(System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static).Where(Function(p_) p_.FieldType = GetType(ShapePreset))
  18. Dim presetsCount = presets.Count()
  19. Dim doc = New GcWordDocument()
  20.  
  21. '' We will apply each preset to 2 consecutive shapes:
  22. Dim shapes = AddGeometryTypes(doc, New SizeF(100, 100), presetsCount * 2, True)
  23.  
  24. doc.Body.Paragraphs.Insert($"Shape presets ({presetsCount})", doc.Styles(BuiltInStyleId.Title), InsertLocation.Start)
  25.  
  26. If (shapes.Count() > presetsCount * 2) Then
  27. shapes.Skip(presetsCount).ToList().ForEach(Sub(s_) s_.Delete())
  28. End If
  29.  
  30. Dim presetIdx = 0
  31. Dim flop = 0
  32. For Each s In shapes
  33. Dim shape As Shape = s.GetRange().CopyTo(s.GetRange(), InsertLocation.After).ParentObject
  34. Dim preset = presets.ElementAt(presetIdx)
  35. If (flop Mod 2) <> 0 Then
  36. presetIdx += 1
  37. End If
  38. flop += 1
  39. shape.ApplyPreset(CType(preset.GetValue(Nothing), ShapePreset))
  40. shape.GetRange().Runs.Insert($"{preset.Name}:", InsertLocation.Before)
  41. shape.GetRange().Runs.Insert(vbCrLf, InsertLocation.After)
  42. ''shape.GetRange().Texts.AddBreak(BreakType.TextWrapping)
  43. Next
  44.  
  45. Return doc
  46. End Function
  47.  
  48. ''' <summary>
  49. ''' Adds a paragraph with a single empty run, and adds a shape for each available GeometryType.
  50. ''' The fill and line colors of the shapes are varied.
  51. ''' </summary>
  52. ''' <param name="doc">The target document.</param>
  53. ''' <param name="size">The size of shapes to create.</param>
  54. ''' <param name="count">The maximum number of shapes to create (-1 for no limit).</param>
  55. ''' <param name="skipUnfillable">Add only shapes that support fills.</param>
  56. ''' <param name="noNames">Do not add geometry names as shape text frames.</param>
  57. ''' <returns>The list of shapes added to the document.</returns>
  58. Private Shared Function AddGeometryTypes(doc As GcWordDocument, size As SizeF, Optional count As Integer = -1, Optional skipUnfillable As Boolean = False, Optional noNames As Boolean = False) As List(Of Shape)
  59.  
  60. '' Line and fill colors:
  61. Dim lines = New Color() {Color.Blue, Color.SlateBlue, Color.Navy, Color.Indigo, Color.BlueViolet, Color.CadetBlue}
  62. Dim line = 0
  63. Dim fills = New Color() {Color.MistyRose, Color.BurlyWood, Color.Coral, Color.Goldenrod, Color.Orchid, Color.Orange, Color.PaleVioletRed}
  64. Dim fill = 0
  65.  
  66. '' The supported geometry types:
  67. Dim geoms As GeometryType() = [Enum].GetValues(GetType(GeometryType))
  68.  
  69. '' Add a paragraph and a run where the shapes will live:
  70. doc.Body.Paragraphs.Add("")
  71. Dim run = doc.Body.Runs.Last
  72.  
  73. Dim shapes = New List(Of Shape)
  74. For Each g In geoms
  75. '' Line geometries do not support fills:
  76. If skipUnfillable AndAlso g.IsLineGeometry() Then
  77. Continue For
  78. End If
  79. If count = 0 Then
  80. Exit For
  81. End If
  82. count -= 1
  83.  
  84. Dim w = size.Width, h = size.Height
  85. Dim shape = run.GetRange().Shapes.Add(w, h, g)
  86. If Not g.IsLineGeometry() Then
  87. shape.Fill.Type = FillType.Solid
  88. If fill < fills.Length - 1 Then
  89. fill += 1
  90. Else
  91. fill = 0
  92. End If
  93. shape.Fill.SolidFill.RGB = fills(fill)
  94. End If
  95. shape.Line.Width = 3
  96. If line < lines.Length - 1 Then
  97. line += 1
  98. Else
  99. line = 0
  100. End If
  101. shape.Line.Fill.SolidFill.RGB = lines(line)
  102. If Not noNames AndAlso g.TextFrameSupported() Then
  103. shape.AddTextFrame(g.ToString())
  104. End If
  105. shape.AlternativeText = $"This is shape {g}"
  106. shape.Size.EffectExtent.AllEdges = 8
  107. shapes.Add(shape)
  108. Next
  109. Return shapes
  110. End Function
  111. End Class
  112.