In the previous post I shows how to draw the stars and stripes in SVG, an HTML5 technology. But actually, I originally wanted an example of GDI code for this blog. GDI stands for Graphics Device Interface and is a venerable Windows technology for drawing.
SVG and GDI share similar approaches in that they are not pixel based images but instead a series of instructions as to how to draw the graphic. That is why I found it easy to ship a SVG version of the stars and stripes after I has originally specified the flag for GDI use. Below is a picture of the stars and stripes drawn onto a VBA form.
So the code in this blog shares the module modUSAFlagSpecification from the previous post. But you will need a userform and the gdi implementation module, modUSAFlagGDI given below.
There are plenty of GDI tutorials on the web so I won't replicate them here. This sample code should get you going and show you basic principles. Essentially, you need a "device context" which is an abstraction of a file, a printer, or a meta file. Then, given a device context, one creates pens and brushes and the draws standard shapes such as rectangles and ellipses. For non-standard shapes such as a 5 pointed star as found on USA flag one specifies an array of points and calls the Polygon() GDI function.
One pattern of note, when selecting a pen or a brush it is necessary to save the handle to the previous pen or brush and then restore them once your drawing is complete. Equally, device contexts have to be restored. So ensure you have the right tidy up code.
Also noteworthy, to get a VBA UserForm's device context it is necessary to use the Windows API FindWindow() function, specifying 'ThunderDFrame' as the class (this identifies VBA UserForms) and the userform's caption as the window text. Other development environments make finding the device context or the windows handle easier.
modUSAFlagGDI standard module
In a new project add a standard module and name it modUSAFlagGDI and copy in the following code
Option Explicit
'*
'* Brought to you by the Excel Development Platform Blog
'* http://exceldevelopmentplatform.blogspot.com/2018/11/
'*
Private Declare Function CreatePen Lib "gdi32" _
(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function RestoreDC Lib "gdi32" (ByVal hDC As Long, ByVal nSavedDC As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function SaveDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Const PS_SOLID As Long = 0
Public Sub FindFormsDeviceContext(ByVal sFormCaption As String, ByRef hForm As Long, ByRef dcForm As Long, ByRef dcOldDeviceContext As Long)
hForm = FindWindow("ThunderDFrame", sFormCaption)
dcForm = GetDC(hForm)
dcOldDeviceContext = SaveDC(dcForm)
End Sub
Public Sub ReleaseDeviceContexts(ByVal dcDeviceContext As Long, ByVal dcOldDeviceContext As Long, ByVal hForm As Long)
ReleaseDC hForm, dcDeviceContext
RestoreDC hForm, dcOldDeviceContext
End Sub
Public Sub DrawUSAFlagByGDI(ByVal dcDeviceContext As Long, ByVal dScalar As Double)
Dim auRects() As RECT
Dim uBlue As RGB
Call modUSAFlagSpecification.GetOldGloryBlue(uBlue)
Dim uRed As RGB
Call modUSAFlagSpecification.GetOldGloryRed(uRed)
Dim uWhite As RGB
Call modUSAFlagSpecification.GetWhite(uWhite)
Call modUSAFlagSpecification.BlueCanton(dScalar, auRects)
DrawRects dcDeviceContext, uBlue, auRects
Call modUSAFlagSpecification.RedStripes(dScalar, auRects)
DrawRects dcDeviceContext, uRed, auRects
Call modUSAFlagSpecification.WhiteStripes(dScalar, auRects)
DrawRects dcDeviceContext, uWhite, auRects
DrawStars dcDeviceContext, dScalar
End Sub
Private Sub DrawStars(ByVal dcDeviceContext As Long, ByVal dScalar As Double)
Dim Pen As Long, OldPen As Long, Brush As Long, OldBrush As Long
Dim auRects() As RECT
Call modUSAFlagSpecification.WhiteStars(dScalar, auRects)
Dim uWhite As RGB
Call modUSAFlagSpecification.GetWhite(uWhite)
Pen = CreatePen(PS_SOLID, 1, uWhite.R + (uWhite.G * 256) + (uWhite.B * 65536))
OldPen = SelectObject(dcDeviceContext, Pen)
Brush = CreateSolidBrush(uWhite.R + (uWhite.G * 256) + (uWhite.B * 65536))
OldBrush = SelectObject(dcDeviceContext, Brush)
Dim lStarLoop As Long
For lStarLoop = 0 To 49
Dim uRect As RECT
uRect = auRects(lStarLoop)
Dim auPoints() As POINTAPI, lPointCount As Long
Call modUSAFlagSpecification.FivePointedStar(dScalar, 30, uRect.Left, uRect.Top, auPoints, lPointCount)
Call Polygon(dcDeviceContext, auPoints(0), 10)
Next
Call SelectObject(dcDeviceContext, OldPen)
Call SelectObject(dcDeviceContext, OldBrush)
End Sub
Private Sub DrawRects(ByVal dcDeviceContext As Long, ByRef uRGB As RGB, ByRef auRects() As RECT)
Dim Pen As Long, OldPen As Long, Brush As Long, OldBrush As Long
Pen = CreatePen(PS_SOLID, 1, uRGB.R + (uRGB.G * 256) + (uRGB.B * 65536))
OldPen = SelectObject(dcDeviceContext, Pen)
Brush = CreateSolidBrush(uRGB.R + (uRGB.G * 256) + (uRGB.B * 65536))
OldBrush = SelectObject(dcDeviceContext, Brush)
Dim lLoop As Long
For lLoop = LBound(auRects) To UBound(auRects)
Call Rectangle(dcDeviceContext, auRects(lLoop).Left, auRects(lLoop).Top, auRects(lLoop).Right, auRects(lLoop).Bottom)
Next lLoop
Call SelectObject(dcDeviceContext, OldPen)
Call SelectObject(dcDeviceContext, OldBrush)
End SubUserForm module
So add a new form and add a button, change the caption to Draw, do not rename. Then in the form's code copy in the code below. Run the form and press the button to draw the flag. Enjoy!
Option Explicit
'*
'* Brought to you by the Excel Development Platform Blog
'* http://exceldevelopmentplatform.blogspot.com/2018/11/
'*
Private Sub CommandButton1_Click()
DrawFlag
End Sub
Private Sub DrawFlag()
Dim hForm As Long, dcForm As Long, dcOldDeviceContext As Long
FindFormsDeviceContext Me.Caption, hForm, dcForm, dcOldDeviceContext
Dim dScalar As Double
dScalar = 0.5
modUSAFlagGDI.DrawUSAFlagByGDI dcForm, dScalar
modUSAFlagGDI.ReleaseDeviceContexts dcForm, dcOldDeviceContext, hForm
End Sub
