The following Access VBA function creates a string that can be used in
a pdf stream to draw or fill a rectangle of a given color with rounded
corners:
'Begin code-----------
Public Function DrawRoundedRectangle(dblX As Double, dblY As Double, _
dblR As Double, dblW As Double, dblH As Double, _
dblThickness As Double, dblLineR As Double, dblLineG _
As Double, dblLineB As Double, boolFill As Boolean, dblFillR _
As Double, dblFillG As Double, dblFillB As Double) As String
Dim strTemp As String
Dim strCR As String
'C1 = 1 - 4 * (SQRT(2) - 1) / 3 (used for 1/4 circle Bezier Curves)
'As shown in http://www.tinaja.com/glib/bezcirc.pdf
Const C1 = 0.447715
'dblX = X coordinate of LL of rounded rectangle in points
'dblY = Y coordinate of LL of rounded rectangle in points
'dblR = Radius of rounded corners in points
'dblH = Height of rounded rectangle in points
'dblW = Width of rounded rectangle in points
'dblThickness = Thickness of line used to draw the rounded _
rectangle in points
'dblLineR = Red component of line color 0.0 to 1.0
'dblLineG = Green component of line color 0.0 to 1.0
'dblLineB = Blue component of line color 0.0 to 1.0
'boolFill = Fill the rectangle when True, Draw the outline when False
'dblFillR = Red component of fill color 0.0 to 1.0
'dblFillG = Green component of fill color 0.0 to 1.0
'dblFillB = Blue component of fill color 0.0 to 1.0
strCR = Chr(13)
strTemp = "%Rounded Rectangle" & strCR
strTemp = strTemp & "q" & strCR
strTemp = strTemp & CStr(dblThickness) & " w" & strCR
strTemp = strTemp & CStr(dblLineR) & " " & CStr(dblLineG) & " " _
& CStr(dblLineB) & " RG" & strCR
If boolFill Then
'h = ClosePath operator
strTemp = strTemp & "h" & strCR
strTemp = strTemp & CStr(dblFillR) & " " & CStr(dblFillG) & " " _
& CStr(dblFillB) & " rg" & strCR
End If
strTemp = strTemp & CStr(Round(dblR + dblX, 6)) & " " _
& CStr(dblY) & " m" & strCR
strTemp = strTemp & CStr(Round(dblX + dblW - dblR, 6)) _
& " " & CStr(dblY) & " l" & strCR
strTemp = strTemp & CStr(Round(dblX + dblW - C1 * dblR, 6)) & " " _
& CStr(dblY) & " " & CStr(Round(dblX + dblW, 6)) & " " _
& CStr(Round(dblY + C1 * dblR, 6)) & " " _
& CStr(Round(dblX + dblW, 6)) _
& " " & CStr(Round(dblY + dblR, 6)) & " c" & strCR
strTemp = strTemp & CStr(Round(dblX + dblW, 6)) & " " _
& CStr(Round(dblY + dblH - dblR, 6)) & " l" & strCR
strTemp = strTemp & CStr(Round(dblX + dblW, 6)) & " " _
& CStr(Round(dblY + dblH - C1 * dblR, 6)) & " " _
& CStr(Round(dblX + dblW - C1 * dblR, 6)) & " " _
& CStr(Round(dblY + dblH, 6)) & " " _
& CStr(Round(dblX + dblW - dblR, 6)) & " " _
& CStr(Round(dblY + dblH, 6)) & " c" & strCR
strTemp = strTemp & CStr(Round(dblX + dblR, 6)) & " " _
& CStr(Round(dblY + dblH, 6)) & " l" & strCR
strTemp = strTemp & CStr(Round(dblX + C1 * dblR, 6)) _
& " " & CStr(Round(dblY + dblH, 6)) & " " _
& CStr(dblX) & " " & CStr(Round(dblY + dblH - C1 * dblR, 6)) & " " _
& CStr(dblX) & " " & CStr(Round(dblY + dblH - dblR, 6)) & " c" & strCR
strTemp = strTemp & CStr(dblX) & " " _
& CStr(Round(dblY + dblR, 6)) & " l" & strCR
strTemp = strTemp & CStr(dblX) & " " _
& CStr(Round(dblY + C1 * dblR, 6)) & " " _
& CStr(Round(dblX + C1 * dblR, 6)) _
& " " & CStr(dblY) & " " & CStr(Round(dblX + dblR, 6)) _
& " " & CStr(dblY) & " c" & strCR
If boolFill Then
'f = Fill operator
strTemp = strTemp & "h f" & strCR
Else
strTemp = strTemp & "S" & strCR
End If
strTemp = strTemp & "Q" & strCR
DrawRoundedRectangle = strTemp
End Function
Function Round(varIn As Variant, intPlaces As Integer) As Variant
Round = Int(10 ^ intPlaces * varIn + 0.5) / 10 ^ intPlaces
End Function
'End code-------------
Perhaps someone will find it useful. BTW, the output from this
function can be assigned to strStream in:
http://groups-beta.google.com/group/...8ab160cf?hl=en
which would in effect make the single pdf page a canvas for any of the
pdf drawing operators. I suppose I should make some of the function's
arguments optional. This function has worked in all the situations I
have tried but use at your own risk, etc. Note: I didn't test out the
normal rounded rectangle without fill after adding in the code for
optional filling. I'll post back if the fill code broke the non-fill
case. I specified two sets of colors in case I want to put a border
with a different color around the filled rectangle someday.
James A. Fortune
