Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Module : modCCMiniChart
' Version : 1.0
' Author : Christian Coppes
' Date : 19.01.2013
' Last Change : 26.01.2013
'---------------------------------------------------------------------------------------
Private dblPercent As Double
Private intPercent As Integer
Public Function fnCCMiniChartValue(dblValue As Double, dblMax As Double, _
Optional strType As String = "Bar", _
Optional strChartChar As String = "|", _
Optional intScale As Integer = 100) As String
If dblMax = 0 Then dblMax = 1
dblPercent = (1 / dblMax) * Abs(dblValue)
Select Case strType
Case "Bar"
' Bar chart characters:
'<>(){}[]|!/\01
fnCCMiniChartValue = String(dblPercent * intScale, strChartChar)
Case "Pie"
' Pie characters are ASCII 33 to 126 and 161 to 246
intPercent = Int(dblPercent * 180)
If intPercent + 32 <= 126 Then
fnCCMiniChartValue = Chr(intPercent + 32)
Else
fnCCMiniChartValue = Chr(intPercent + 66)
End If
End Select
End Function
Public Sub CreatePieFont()
' Early binding: Create a reference in the VBA editor to the CorelDraw object library you are using
' (here it was the CorelDraw 11 object library)
Dim objCApp As CorelDRAW.Application
Dim objCDoc As CorelDRAW.Document
Dim objShape As CorelDRAW.Shape
Dim objPage As CorelDRAW.Page
Dim objLayer As CorelDRAW.Layer
Dim objColor As CorelDRAW.Color
Dim objExportOptions As CorelDRAW.StructExportOptions
Dim objDocExp As CorelDRAW.Document
Dim dblStartAngle As Double
Dim dblEndAngle As Double
Dim i As Long
Set objCApp = New CorelDRAW.Application
objCApp.Visible = True
' create a new CorelDraw document
Set objCDoc = objCApp.CreateDocument
objCDoc.Resolution = 300
' and a second one for export
Set objDocExp = objCApp.CreateDocument
objDocExp.Resolution = 300
objDocExp.ActivePage.SetSize 10, 10
' create a CorelDraw color object for black color
Set objColor = New CorelDRAW.Color
objColor.RGBAssign 0, 0, 0
Set objExportOptions = New CorelDRAW.StructExportOptions
With objExportOptions
'.ImageType = cdrBlackAndWhiteImage
.UseColorProfile = False
End With
With objCDoc
' Use the first page to create the drawing of the circle
Set objPage = .Pages(1)
With objPage
' size of the page which will be the size of one character of the font
.SetSize 10, 10
' CorelDraw uses different layers in one page, the "CreateEllipse" function is only available on a layer
Set objLayer = .Layers(1)
With objLayer
' create the circle over the complete size of the page
Set objShape = .CreateEllipse(0, 0, 10, 10, , , False)
With objShape
' create 179 pie graphics (the 180th is an empty character = space), 360° in 2° steps
For i = 1 To 180
If i > 0 Then
With .Ellipse
.Type = cdrPie
.Clockwise = True
' these start values are necessary so that the angle starts on the top
dblStartAngle = 270
dblEndAngle = dblStartAngle + i * 2
' 360° is at "3 o'clock" position, at i=90° it must be reduced by 90° to end at 270° at the top
If dblEndAngle > 360 Then
dblEndAngle = i * 2 - 90
End If
.StartAngle = dblStartAngle
.EndAngle = dblEndAngle
End With
End If
' set a flat fill in black color using the color object above
.Fill.ApplyUniformFill objColor
' the circle should have no outline
.Outline.Type = cdrNoOutline
' now copy...
.Copy
With objDocExp
.Activate
' ...the generated circle to the export document...
.ActiveLayer.Paste
' ...because the CorelDraw circle object must be converted to curves as this is the only object type
' a TTF font can use
.ActiveShape.ConvertToCurves
' export the character to the TTF font. CorelDraw exports always only one character at a time. At the first time
' it creates the font, any further export exports one character into the created font.
' The only problem is, that the export goes through export addins which cannot be programmed by VBA. So
' the automatism ends here, you must choose a character in the export dialog and click export manually, then
' the loop creates the next character and so on.
.Export "C:\CCMiniChart_Pies.ttf", cdrTTF, cdrCurrentPage, objExportOptions
.ActiveShape.Delete
' activate the original document to see the progress
objCDoc.Activate
End With
Next
End With
End With
End With
End With
Set objExportOptions = Nothing
Set objColor = Nothing
Set objShape = Nothing
Set objLayer = Nothing
Set objPage = Nothing
Set objCDoc = Nothing
Set objDocExp = Nothing
Set objCApp = Nothing
End Sub
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (2)
Author
Commented:thanks for formatting the article and your review.
The fonts are needed to show the chart graphics. The bar chart font uses an extreme small letter width and additionally a nearly zero letter spacing to be able to show a chart bar nearly pixel by pixel. You can of course use other fonts for this effect but you would always have a little spacing between two characters.
The other font is a pie chart font where 180 characters were designed as 180 steps of a pie chart, beginning with a pie of 2 degrees, then 4 degrees and so on until you have a complete filled circle. This is not possible with any other font.
In the result you can have a text field of a user defined size with a user definable scaling showing a more or less wide bar of a chosen type (for example: //// or \\\\ or ||||, but without the spacing between the characters) or you can have a single character field showing the wanted value as little pie chart. Both methods are demonstrated in the attached demo database.
I thought I wrote the details about the fonts in the article with:
and:
In opposite to Corel I only need 2 fonts (or, if you want, at least 1 for the pie chart method) for this tool to work which should be no problem for any target system...;-)
Cheers,
Christian
Author
Commented:OK, so now I implemented both into the article although I'm not sure if Access users are really interested in how to create TTF fonts with CorelDraw...;-) Because this is not really the scope of the article I created a new sub title below the article.
Cheers,
Christian