435,630 Members | 1,121 Online + Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,630 IT Pros & Developers. It's quick & easy.

VBA function for rounded pdf rectangles

 P: n/a 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 Nov 13 '05 #1 