ShapePresets.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.Collections
- Imports System.Collections.Generic
- Imports System.Linq
- Imports GrapeCity.Documents.Word
-
- '' This sample demonstrates all available shape presets
- '' that specify a shape's fill and outline.
- Public Class ShapePresets
- Function CreateDocx() As GcWordDocument
-
- Dim presets = GetType(ShapePreset).GetFields(System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static).Where(Function(p_) p_.FieldType = GetType(ShapePreset))
- Dim presetsCount = presets.Count()
- Dim doc = New GcWordDocument()
-
- '' We will apply each preset to 2 consecutive shapes:
- Dim shapes = AddGeometryTypes(doc, New SizeF(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())
- End If
-
- Dim presetIdx = 0
- Dim flop = 0
- For Each s In shapes
- Dim shape As Shape = s.GetRange().CopyTo(s.GetRange(), InsertLocation.After).ParentObject
- Dim preset = presets.ElementAt(presetIdx)
- If (flop Mod 2) <> 0 Then
- presetIdx += 1
- End If
- 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 doc
- End Function
-
- ''' <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>
- 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)
-
- '' Line and fill colors:
- Dim lines = New Color() {Color.Blue, Color.SlateBlue, Color.Navy, Color.Indigo, Color.BlueViolet, Color.CadetBlue}
- Dim line = 0
- Dim fills = New Color() {Color.MistyRose, Color.BurlyWood, Color.Coral, Color.Goldenrod, Color.Orchid, Color.Orange, Color.PaleVioletRed}
- Dim fill = 0
-
- '' The supported geometry types:
- Dim geoms As GeometryType() = [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 = New List(Of Shape)
- For Each g In geoms
- '' Line geometries do not support fills:
- If skipUnfillable AndAlso g.IsLineGeometry() Then
- Continue For
- End If
- If count = 0 Then
- Exit For
- End If
- count -= 1
-
- Dim w = size.Width, h = size.Height
- Dim shape = run.GetRange().Shapes.Add(w, h, g)
- If Not g.IsLineGeometry() Then
- shape.Fill.Type = FillType.Solid
- If fill < fills.Length - 1 Then
- fill += 1
- Else
- fill = 0
- End If
- shape.Fill.SolidFill.RGB = fills(fill)
- End If
- shape.Line.Width = 3
- If line < lines.Length - 1 Then
- line += 1
- Else
- line = 0
- End If
- shape.Line.Fill.SolidFill.RGB = lines(line)
- If Not noNames AndAlso g.TextFrameSupported() Then
- shape.AddTextFrame(g.ToString())
- End If
- shape.AlternativeText = $"This is shape {g}"
- shape.Size.EffectExtent.AllEdges = 8
- shapes.Add(shape)
- Next
- Return shapes
- End Function
- End Class
-