|
|
|
|
Draw a Rounded Rectangle on an Access report using VBA. While you might draw rounded rectangles on their own, more often they would be part of another drawing. I used it to draw part of the housing for a stoplight. Access can draw complex objects using a few simple methods. The rounded rectangle is actually 4 lines and 4 arcs, so changing how big corners are can lead to some interesting shapes. |
Download zipped BAS file you can import into your Access projects: mod_Draw_RoundRectangle_s4p__BAS.zip
Download zipped ACCDB file with a sample report, and module: Draw_RoundedRectangle_s4p__ACCDB.zip
Remember to UNBLOCK files you download to remove the Mark of the Web. Here are steps to do that: https://msaccessgurus.com/MOTW_Unblock.htm
Specify the report object and the XY coordinates of the Top Left and Lower Right corners. Optionally specify a width for the line, color, and corner size.
'module: mod_Draw_RoundRectangle_s4p '*************** Code Start *********************************************** ' Purpose : Draw a Rounded Rectangle ' Author : crystal (strive4peace) ' Code List: www.msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/Draw_RoundRectangle.htm ' LICENSE : ' You may freely use and share this code, but not sell it. ' Keep attribution. Mark your changes. Use at your own risk. '------------------------------------------------------------------------------- ' global variables '------------------------------------------------------------------------------- 'comment if defined elsewhere Public Const PI As Double = 3.14159 Public Const TWIPperINCH As Long = 1440 '------------------------------------------------------------------------------- ' Draw_RoundRectangle_s4p '------------------------------------------------------------------------------- Sub Draw_RoundRectangle_s4p(oReport As Report _ ,xLeft As Single _ ,yTop As Single _ ,xRight As Single _ ,yBottom As Single _ ,Optional piDrawWidth As Integer = 1 _ ,Optional pnColor As Long = 9868950 _ ,Optional pdbRadiusCorner As Double = 80 _ ) 'use Line to draw lines 'Circle to draw arcs for corners Dim x1 As Single,y1 As Single _ ,x2 As Single,y2 As Single x1 = xLeft x2 = xRight y1 = yTop + pdbRadiusCorner y2 = yBottom - pdbRadiusCorner oReport.DrawWidth = piDrawWidth '--- sides 'left side oReport.Line (x1,y1)-(x1,y2),pnColor 'right side oReport.Line (x2,y1)-(x2,y2),pnColor x1 = xLeft + pdbRadiusCorner x2 = xRight - pdbRadiusCorner y1 = yTop y2 = yBottom 'top oReport.Line (x1,y1)-(x2,y1),pnColor 'bottom oReport.Line (x1,y2)-(x2,y2),pnColor '--- corners x1 = xLeft + pdbRadiusCorner y1 = yTop + pdbRadiusCorner '--------------------------------- 'todo: test for big dimensions 'adjust centers for line width x2 = xRight - pdbRadiusCorner _ '+ piDrawWidth * 2 y2 = yBottom - pdbRadiusCorner _ '+ piDrawWidth * 2 'top left corner oReport.Circle (x1,y1),pdbRadiusCorner _ ,pnColor,PI / 2,PI 'top right corner oReport.Circle (x2,y1),pdbRadiusCorner _ ,pnColor,0,PI / 2 'bottom left corner oReport.Circle (x1,y2 ),pdbRadiusCorner _ ,pnColor,PI,3 / 2 * PI 'bottom right corner oReport.Circle (x2,y2),pdbRadiusCorner _ ,pnColor,3 / 2 * PI,2 * PI End Sub '*************** Code End *****************************************************
Uses a table with numbers (Numberz) to get values to change the corner size. You can get shapes that don't look anything like a rounded rectangle!
'*************** Code Start CBR *********************************************** ' Purpose : code behind r_RoundRectangles_Corner ' calls Draw_RoundRectangle_s4p ' report is 2 columns ' Author : crystal (strive4peace) ' Code List: www.msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/Draw_RoundRectangle.htm ' LICENSE : ' You may freely use and share this code, but not sell it. ' Keep attribution. Mark your changes. Use at your own risk. '------------------------------------------------------------------------------ ' Detail_Format '------------------------------------------------------------------------------ Private Sub Detail_Format(Cancel As Integer,FormatCount As Integer) '230212 s4p Dim xCenter As Double,yCenter As Double _ ,sgRadius As Double xCenter = 2.2 * TWIPperINCH yCenter = 1.1 * TWIPperINCH sgRadius = 1 * TWIPperINCH Dim x1 As Single,y1 As Single _ ,x2 As Single,y2 As Single _ ,sgWidth As Single Dim nColor As Long _ ,dbRadiusCorner As Double _ ,iDrawWidth As Integer With Me sgWidth = .Width_ x1 = TWIPperINCH * 0.5 x2 = x1 + sgWidth y1 = TWIPperINCH * 0.3 y2 = y1 + sgWidth dbRadiusCorner = .Corner iDrawWidth = 4 nColor = vbBlue End With 'Draw_RoundRectangle_s4p Call Draw_RoundRectangle_s4p(Me _ ,x1,y1,x2,y2 _ ,iDrawWidth,nColor,dbRadiusCorner _ ) End Sub '*************** Code End *****************************************************Code was generated with colors using the free Color Code add-in for Access
Report Draw Reference for VBA syntax and help for drawing on Access reports.
Its good to draw shapes such as this that you can use when you're drawing more complex objects.
Report Draw Reference and VBA Syntax
Help this site grow. Donations are appreciated, large and small. Access is only limited by your imagination.
Here's the link for this page in case you want to copy it and share it with someone:
https://msaccessgurus.com/VBA/Draw_RoundRectangle.htm
or in old browsers:
http://www.msaccessgurus.com/VBA/Draw_RoundRectangle.htm
Let's connect and team-develop your application together. I teach you how to do it yourself. My goal is to empower you.
While we build something great together, I'll pull in code and features from my vast libraries as needed, cutting out lots of development time. And you'll get links to great resources.
Do you want your reports to be more creative and visual?
I'd love to help you.
Email me at training@msAccessGurus
~ crystal
the simplest way is best, but usually the hardest to see