ShapeFillFormats.vb
'''' This code is part of Document Solutions for Word demos.'' Copyright (c) MESCIUS inc. All rights reserved.''Imports System.IOImports System.DrawingImports System.CollectionsImports System.Collections.GenericImports System.LinqImports GrapeCity.Documents.Word
'' This sample demonstrates the various fill formats'' that can be used with shapes.Public Class ShapeFillFormats Function CreateDocx() As GcWordDocument Dim gradColors = New Color() { Color.Red, Color.Orange, Color.Yellow, Color.Green }
Dim patts As PatternFillType() = [Enum].GetValues(GetType(PatternFillType))
Dim doc = New GcWordDocument() Dim shapes = AddGeometryTypes(doc, New SizeF(100, 120), patts.Length + 12, True, True)
For Each s In shapes s.Size.Width.Value *= 2 s.Size.Height.Value *= 2 Next
doc.Body.Paragraphs.Insert("Fill formats", doc.Styles(BuiltInStyleId.Title), InsertLocation.Start)
Dim sIdx = 0
Dim shape = shapes(sIdx) sIdx += 1
shape.Fill.Type = FillType.Gradient shape.Fill.GradientFill.ApplyLinearDirection(GradientLinearDirection.BottomLeftToTopRight) shape.Fill.GradientFill.Stops(0).Color.RGB = gradColors(0) shape.Fill.GradientFill.Stops(1).Color.RGB = gradColors(3) shape.AddTextFrame("Linear grad")
shape = shapes(sIdx) sIdx += 1 shape.Fill.Type = FillType.Gradient shape.Fill.GradientFill.ApplyLinearDirection(GradientLinearDirection.BottomRightToTopLeft) shape.Fill.GradientFill.Stops(0).Color.RGB = gradColors(0) shape.Fill.GradientFill.Stops(1).Position = 30 shape.Fill.GradientFill.Stops(1).Color.RGB = gradColors(1) shape.Fill.GradientFill.Stops.Add(gradColors(2), 60) shape.Fill.GradientFill.Stops.Add(gradColors(3), 90) shape.AddTextFrame("Linear grad")
shape = shapes(sIdx) sIdx += 1 shape.Fill.Type = FillType.Gradient shape.Fill.GradientFill.Type = GradientType.Circle '' not really needed if using ApplyPathDirection() method shape.Fill.GradientFill.ApplyCircleDirection(GradientPathDirection.FromBottomRight) shape.Fill.GradientFill.Stops(0).Color.RGB = gradColors(0) shape.Fill.GradientFill.Stops(1).Position = 30 shape.Fill.GradientFill.Stops(1).Color.RGB = gradColors(1) shape.Fill.GradientFill.Stops.Add(gradColors(2), 60) shape.Fill.GradientFill.Stops.Add(gradColors(3), 90) shape.AddTextFrame("Circle grad")
shape = shapes(sIdx) sIdx += 1 shape.Fill.Type = FillType.Gradient shape.Fill.GradientFill.ApplyCircleDirection(GradientPathDirection.Center) shape.Fill.GradientFill.Stops(0).Color.RGB = gradColors(0) shape.Fill.GradientFill.Stops(1).Color.RGB = gradColors(3) shape.AddTextFrame("Circle grad")
shape = shapes(sIdx) sIdx += 1 shape.Fill.Type = FillType.Gradient shape.Fill.GradientFill.ApplyRectangleDirection(GradientPathDirection.Center) shape.Fill.GradientFill.Stops(0).Color.RGB = gradColors(0) shape.Fill.GradientFill.Stops(1).Position = 30 shape.Fill.GradientFill.Stops(1).Color.RGB = gradColors(1) shape.Fill.GradientFill.Stops.Add(gradColors(2), 60) shape.Fill.GradientFill.Stops.Add(gradColors(3), 90) shape.AddTextFrame("Rectangle grad")
shape = shapes(sIdx) sIdx += 1 shape.Fill.Type = FillType.Gradient shape.Fill.GradientFill.ApplyRectangleDirection(GradientPathDirection.FromTopRight) shape.Fill.GradientFill.Stops(0).Color.RGB = gradColors(0) shape.Fill.GradientFill.Stops(1).Color.RGB = gradColors(3) shape.AddTextFrame("Rectangle grad")
'' Image fills: shape = shapes(sIdx) sIdx += 1 shape.Fill.Type = FillType.Image Dim bytes = File.ReadAllBytes(Path.Combine("Resources", "ImagesBis", "butterfly.jpg")) shape.Fill.ImageFill.SetImage(bytes, "image/jpeg") shape = shapes(sIdx) sIdx += 1 shape.Fill.Type = FillType.Image shape.Fill.ImageFill.FillType = ImageFillType.Tile ''use tile image as flipped both vertical and horizontal shape.Fill.ImageFill.Tile.Flip = TileFlipMode.HorizontalAndVertical ''scale image down horizontally to 30% and vertically to 25% shape.Fill.ImageFill.Tile.HorizontalScale = 30 shape.Fill.ImageFill.Tile.VerticalScale = 25 bytes = File.ReadAllBytes(Path.Combine("Resources", "ImagesBis", "gcd-hex-logo-80x80.png")) shape.Fill.ImageFill.SetImage(bytes, "image/png")
Dim r = shape.GetRange().Runs.Insert($"{vbCrLf}{vbCrLf}Pattern fills:{vbCrLf}", doc.Styles(BuiltInStyleId.Strong), InsertLocation.After) r.Font.Size *= 3
'' Pattern fills: For Each p In patts shape = shapes(sIdx) sIdx += 1 shape.Size.Width.Value /= 3 shape.Size.Height.Value /= 3 shape.Fill.Type = FillType.Pattern ''type represents how it will look shape.Fill.PatternFill.Type = CType(p, PatternFillType) shape.Fill.PatternFill.ForeColor.RGB = gradColors(0) shape.Fill.PatternFill.BackColor.RGB = gradColors(gradColors.Length - 1) Next
If (sIdx < shapes.Count) Then shapes.Skip(sIdx).ToList().ForEach(Sub(s_) s_.Delete()) End If
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 FunctionEnd Class