ShippingLabels.vb
''
'' このコードは、DioDocs for Imaging のサンプルの一部として提供されています。
'' © MESCIUS inc. All rights reserved.
''
Imports System
Imports System.IO
Imports System.Collections.Generic
Imports System.Drawing
Imports System.Globalization
Imports GrapeCity.Documents.Imaging
Imports GrapeCity.Documents.Text
Imports GrapeCity.Documents.Drawing
Imports GrapeCity.Documents.Barcode
Imports GCTEXT = GrapeCity.Documents.Text
Imports GCDRAW = GrapeCity.Documents.Drawing
'' このサンプルは、いくつかのバーコードを含む出荷ラベルのセットを印刷します。
'' タブストップを使用してデータを垂直に整列させることにも注意してください。
Public Class ShippingLabels
'' クライアント情報です。このサンプルは、クライアントごとに１つの出荷ラベルを印刷します。
Class Client
Public Name As String
Public Addr As String
Public City As String
Public Country As String
Public Sub New(name As String, addr As String, city As String, country As String)
Me.Name = name
Me.Addr = addr
Me.City = city
Me.Country = country
End Sub
End Class
'' 顧客の基礎データです。
Shared ReadOnly s_clients As New List(Of Client) From {
New Client("Simons bistro", "Vinbæltet 34", "København", "Denmark"),
New Client("Richter Supermarkt", "Starenweg 5", "Genève", "Switzerland"),
New Client("Bon app'", "12, rue des Bouchers", "Marseille", "France"),
New Client("Rattlesnake Canyon Grocery", "2817 Milton Dr.", "Albuquerque", "USA"),
New Client("Lehmanns Marktstand", "Magazinweg 7", "Frankfurt a.M.", "Germany"),
New Client("LILA-Supermercado", "Carrera 52 con Ave. Bolívar #65-98 Llano Largo", "Barquisimeto", "Venezuela"),
New Client("Ernst Handel", "Kirchgasse 6", "Graz", "Austria"),
New Client("Pericles Comidas clásicas", "Calle Dr. Jorge Cash 321", "México D.F.", "Mexico"),
New Client("Drachenblut Delikatessen", "Walserweg 21", "Aachen", "Germany"),
New Client("Queen Cozinha", "Alameda dos Canàrios, 891", "São Paulo", "Brazil"),
New Client("Tortuga Restaurante", "Avda. Azteca 123", "México D.F.", "Mexico"),
New Client("Save-a-lot Markets", "187 Suffolk Ln.", "Boise", "USA"),
New Client("Franchi S.p.A.", "Via Monte Bianco 34", "Torino", "Italy")
}
'' メインのサンプルドライバーです。
Public Function GenerateImageStream(targetMime As String, pixelSize As Size, dpi As Single, opaque As Boolean, Optional sampleParams As String() = Nothing) As Stream
Dim bmp = New GcBitmap(pixelSize.Width, pixelSize.Height, opaque, dpi, dpi)
Dim g = bmp.CreateGraphics(Color.White)
Dim ms = New MemoryStream()
Dim tw As GcTiffWriter = Nothing
If targetMime = Util.MimeTypes.TIFF Then
tw = New GcTiffWriter(ms)
End If
Init(pixelSize)
'' 顧客ごとにループし、1ページにつき最大4枚のラベルを印刷します。
Dim i As Integer = 0
For pg = 0 To (s_clients.Count + 3) \ 4 - 1
PrintLabel(s_clients(i), g, New RectangleF(hmargin, vmargin, _labelWidth, _labelHeight)) : i += 1
If i < s_clients.Count Then
PrintLabel(s_clients(i), g, New RectangleF(hmargin + _labelWidth, vmargin, _labelWidth, _labelHeight)) : i += 1
End If
If i < s_clients.Count Then
PrintLabel(s_clients(i), g, New RectangleF(hmargin, vmargin + _labelHeight, _labelWidth, _labelHeight)) : i += 1
End If
If i < s_clients.Count Then
PrintLabel(s_clients(i), g, New RectangleF(hmargin + _labelWidth, vmargin + _labelHeight, _labelWidth, _labelHeight)) : i += 1
End If
'' TIFF以外の形式の場合は1ページだけ印刷します。
If tw Is Nothing Then Exit For
If i < s_clients.Count Then
tw.AppendFrame(bmp)
bmp.Clear(Color.White)
End If
Next
Select Case targetMime
Case Util.MimeTypes.TIFF
tw.AppendFrame(bmp)
tw.Dispose()
Case Util.MimeTypes.JPEG
bmp.SaveAsJpeg(ms)
Case Util.MimeTypes.PNG
bmp.SaveAsPng(ms)
Case Util.MimeTypes.BMP
bmp.SaveAsBmp(ms)
Case Util.MimeTypes.GIF
bmp.SaveAsGif(ms)
Case Util.MimeTypes.WEBP
bmp.SaveAsWebp(ms)
Case Util.MimeTypes.ICO
bmp.SaveAsIco(ms, Nothing, IcoFrameEncoding.Png)
Case Else
Throw New Exception($"Encoding {targetMime} is not supported.")
End Select
bmp.Dispose()
g.Dispose()
Term()
Return ms
End Function
'' ラベルをレンダリングするために使用される定数と変数です。
Const hmargin As Single = 24, vmargin As Single = 36
Dim _labelWidth As Single, _labelHeight As Single
Dim _pBold As GCDRAW.Pen, _pNorm As GCDRAW.Pen
Dim _fontReg As GCTEXT.Font, _fontBold As GCTEXT.Font
Dim _tfSmall As TextFormat, _tfSmallB As TextFormat, _tfLarge As TextFormat
Dim _tsHeader As List(Of TabStop), _tsFrom As List(Of TabStop), _tsCodes As List(Of TabStop)
Dim _logo As GCDRAW.Image
Dim _ia As ImageAlign
Dim bcTop As GcBarcode, bcBottom As GcBarcode
'' ラベルの描画に使用される変数を初期化します。
Sub Init(pixelSize As Size)
_labelWidth = (pixelSize.Width - hmargin * 2) / 2
_labelHeight = _labelWidth
_pBold = New GCDRAW.Pen(Color.Black, 2)
_pNorm = New GCDRAW.Pen(Color.Black, 0.5F)
_logo = GCDRAW.Image.FromFile(Path.Combine("Resources", "ImagesBis", "AcmeLogo-vertical-250px.png"))
_fontReg = GCTEXT.Font.FromFile(Path.Combine("Resources", "Fonts", "NotoSans-Regular.ttf"))
_fontBold = GCTEXT.Font.FromFile(Path.Combine("Resources", "Fonts", "NotoSans-Bold.ttf"))
_tfSmall = New TextFormat() With {.Font = _fontReg, .FontSize = 9}
_tfSmallB = New TextFormat() With {.Font = _fontBold, .FontSize = 10}
_tfLarge = New TextFormat() With {.Font = _fontBold, .FontSize = 17}
_ia = New ImageAlign(ImageAlignHorz.Right, ImageAlignVert.Center, True, True, True, False, False)
_tsHeader = New List(Of TabStop) From {New TabStop(24, TabStopAlignment.Leading), New TabStop(108, TabStopAlignment.Leading)}
_tsFrom = New List(Of TabStop) From {New TabStop(12, TabStopAlignment.Leading), New TabStop(72, TabStopAlignment.Leading)}
_tsCodes = New List(Of TabStop) From {New TabStop(_labelWidth / 8, TabStopAlignment.Center)}
bcTop = New GcBarcode() With {
.TextFormat = _tfSmall,
.CodeType = CodeType.Code_128_B,
.HorizontalAlignment = ImageAlignHorz.Center,
.VerticalAlignment = ImageAlignVert.Center,
.ScaleFactor = 2
}
bcTop.Options.CaptionPosition = BarCodeCaptionPosition.Below
bcBottom = New GcBarcode() With {
.TextFormat = _tfSmall,
.CodeType = CodeType.Code_128auto,
.HorizontalAlignment = ImageAlignHorz.Center,
.VerticalAlignment = ImageAlignVert.Center,
.ScaleFactor = 2
}
bcBottom.Options.CaptionPosition = BarCodeCaptionPosition.Below
End Sub
Sub Term()
If _logo IsNot Nothing Then _logo.Dispose()
_logo = Nothing
End Sub
Sub PrintLabel(client As Client, g As GcGraphics, bounds As RectangleF)
'' いくつかのサンプルデータをランダム化するために使用します。
Dim rnd = Util.NewRandom()
'' サンプルの荷送人/送付先データです。
Dim shipper = If(rnd.Next(2) = 0, "United Package", "Speedy Express")
Dim sender = (name:="ACME Inc.", addr:="1 Main Street", city:="Metropolis", country:="USA", zip:="34567")
Dim shuttle = rnd.Next(10000, 15000).ToString()
Dim area = rnd.Next(1, 12).ToString()
Dim tour = rnd.Next(0, 20).ToString()
Dim tl = g.CreateTextLayout()
tl.DefaultFormat.Font = _tfSmall.Font
tl.DefaultFormat.FontSize = _tfSmall.FontSize
tl.LineSpacingScaleFactor = 0.75F
tl.ParagraphAlignment = ParagraphAlignment.Center
'' ヘッダー
Dim hHeader = bounds.Height / 2 / 5
Dim rHeader = New RectangleF(bounds.X, bounds.Y, bounds.Width, hHeader)
tl.TabStops = _tsHeader
tl.Append(vbTab & shipper)
tl.Append(vbTab & "CMR", _tfSmallB)
tl.Append(vbLf & vbTab & vbTab & Util.TimeNow().ToString("dd-MMM-yy", CultureInfo.InvariantCulture))
tl.MaxHeight = rHeader.Height
tl.MaxWidth = rHeader.Width
tl.PerformLayout(True)
g.DrawTextLayout(tl, rHeader.Location)
Dim rLogo = rHeader
rLogo.Inflate(-5, -5)
g.DrawImage(_logo, rLogo, Nothing, _ia)
'' 差出人
Dim hFrom = hHeader
Dim rFrom = New RectangleF(bounds.X, rHeader.Bottom, bounds.Width, hFrom)
tl.Clear()
tl.TabStops = _tsFrom
tl.Append(vbTab & "From:" & vbTab & sender.name & vbLf &
vbTab & vbTab & sender.addr & vbLf &
vbTab & vbTab & $"{sender.city}, {sender.country} {sender.zip}")
tl.MaxHeight = rFrom.Height
tl.MaxWidth = rFrom.Width
tl.PerformLayout(True)
g.DrawTextLayout(tl, rFrom.Location)
'' 宛先
Dim hTo = bounds.Height / 2 / 3
Dim rTo = New RectangleF(bounds.X, rFrom.Bottom, bounds.Width, hTo)
tl.Clear()
tl.TabStops = _tsFrom
tl.Append(vbTab & "To:" & vbTab & client.Name & vbLf &
vbTab & vbTab & client.Addr & vbLf &
vbTab & vbTab & client.City & vbLf &
vbTab & vbTab & client.Country)
tl.MaxHeight = rTo.Height
tl.MaxWidth = rTo.Width
tl.PerformLayout(True)
g.DrawTextLayout(tl, rTo.Location)
'' コード
Dim hCodes = bounds.Height / 2 / (15.0F / 4.0F)
Dim rCodes = New RectangleF(bounds.X, rTo.Bottom, bounds.Width, hCodes)
tl.TabStops = _tsCodes
tl.Clear()
tl.AppendLine(vbTab & "Shuttle")
tl.Append(vbTab & shuttle, _tfLarge)
tl.MaxHeight = rCodes.Height
tl.MaxWidth = rCodes.Width / 4.0F
tl.PerformLayout(True)
g.DrawTextLayout(tl, rCodes.Location)
tl.Clear()
tl.AppendLine(vbTab & "Area")
tl.Append(vbTab & area, _tfLarge)
tl.PerformLayout(True)
g.DrawTextLayout(tl, New PointF(rCodes.X + rCodes.Width / 4.0F, rCodes.Y))
tl.Clear()
tl.AppendLine(vbTab & "Exception")
tl.Append(vbTab & " ", _tfLarge)
tl.PerformLayout(True)
g.DrawTextLayout(tl, New PointF(rCodes.X + rCodes.Width / 4.0F * 2.0F, rCodes.Y))
tl.Clear()
tl.AppendLine(vbTab & "Tour")
tl.Append(vbTab & tour, _tfLarge)
tl.PerformLayout(True)
g.DrawTextLayout(tl, New PointF(rCodes.X + rCodes.Width / 4.0F * 3.0F, rCodes.Y))
'' バーコード
Dim hBarcodes = bounds.Height / 2.0F
Dim rBcTop = New RectangleF(bounds.X, rCodes.Bottom, bounds.Width, hBarcodes / 2.0F)
Dim rBcBottom = New RectangleF(bounds.X, rBcTop.Bottom, bounds.Width, hBarcodes / 2.0F)
bcTop.Text = client.Country
g.DrawBarcode(bcTop, rBcTop)
'' 長めの「コード」を作成します。
Dim code = $"{Char.ToUpper(client.Name(0))}{Char.ToUpper(client.Addr(0))}{Char.ToUpper(client.City(0))}{Char.ToUpper(client.Country(0))}"
bcBottom.Text = $"{code}{client.GetHashCode().ToString("X12")}"
g.DrawBarcode(bcBottom, rBcBottom)
'' 線
g.DrawLine(rHeader.Left, rHeader.Bottom, rHeader.Right, rHeader.Bottom, _pNorm)
g.DrawLine(rFrom.Left, rFrom.Bottom, rFrom.Right, rFrom.Bottom, _pNorm)
g.DrawLine(rTo.Left, rTo.Bottom, rTo.Right, rTo.Bottom, _pNorm)
g.DrawLine(rCodes.Left, rCodes.Bottom, rCodes.Right, rCodes.Bottom, _pNorm)
g.DrawLine(rCodes.Left + rCodes.Width / 4.0F, rCodes.Top, rCodes.Left + rCodes.Width / 4.0F, rCodes.Bottom, _pNorm)
g.DrawLine(rCodes.Left + rCodes.Width / 4.0F * 2.0F, rCodes.Top, rCodes.Left + rCodes.Width / 4.0F * 2.0F, rCodes.Bottom, _pNorm)
g.DrawLine(rCodes.Left + rCodes.Width / 4.0F * 3.0F, rCodes.Top, rCodes.Left + rCodes.Width / 4.0F * 3.0F, rCodes.Bottom, _pNorm)
g.DrawRectangle(bounds, _pBold)
End Sub
End Class