ThemedShapeStyles.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 the available predefined themed shape styles
- '' that are supported by DsWord.
- '' We first generate a number of different shapes with varying fill
- '' and line colors, then duplicate that shape, and apply a themed style
- '' to the copy.
- Public Class ThemedShapeStyles
- Function CreateDocx() As GcWordDocument
-
- Dim styles = GetType(ThemedShapeStyle).GetFields(System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static).Where(Function(p_) p_.FieldType = GetType(ThemedShapeStyle))
- Dim stylesCount = styles.Count()
- Dim doc = New GcWordDocument()
-
- '' We will apply each preset to 2 consecutive shapes:
- Dim shapes = AddGeometryTypes(doc, New SizeF(100, 100), stylesCount * 2, True, True)
-
- doc.Body.Paragraphs.Insert($"Themed Shape Styles ({stylesCount})", doc.Styles(BuiltInStyleId.Title), InsertLocation.Start)
-
- If (shapes.Count() > stylesCount * 2) Then
- shapes.Skip(stylesCount).ToList().ForEach(Sub(s_) s_.Delete())
- End If
-
- Dim styleIdx = 0
- Dim flop = 0
- For Each s In shapes
- Dim shape As Shape = s.GetRange().CopyTo(s.GetRange(), InsertLocation.After).ParentObject
-
- Dim style = styles.ElementAt(styleIdx)
- If (flop Mod 2) <> 0 Then
- styleIdx += 1
- End If
- flop += 1
- '' Apply the themed style to the shape:
- shape.ApplyThemedStyle(CType(style.GetValue(Nothing), ThemedShapeStyle))
- '' Insert the style's name in front of the styled shape:
- shape.GetRange().Runs.Insert($"{style.Name}:", InsertLocation.Before)
- shape.GetRange().Runs.Insert(vbCrLf, InsertLocation.After)
- 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 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 = doc.Body.Runs.Last.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
-