Example of using Word VBA graphics drawing library
by world coordinates (using GDI32 instructions version)
Basic Drawing Functions - Rectangles, Ellipses, Line Styles
Ex.1 Draw some boxes while changing colors
Sub ColorBox() Dim c, myBoxSize, myInterval Dim x1, y1, x2, y2 monhdc = GetForegroundWindow() myhdc = GetDC(monhdc) If myhdc = 0 Then Exit Sub InitializeGraphics ' Declaration of using graphics library myBoxSize = 24 myInterval = myBoxSize + 6 x1 = 10 y1 = 10 For c = 0 To 14 DrawRectangle x1, y1, x1 + myBoxSize, y1 + myBoxSize, QBColor(c) ' Draw a box x1 = x1 + myInterval Next c x1 = 10 y1 = 60 For c = 0 To 14 DrawRectangleFill x1, y1, x1 + myBoxSize, y1 + myBoxSize, QBColor(c) ' Draw a filled box x1 = x1 + myInterval Next c x1 = 10 y1 = 100 For c = 0 To 14 ' Draw a box with different fill color and line color DrawRectangleFill x1, y1, x1 + myBoxSize, y1 + myBoxSize, QBColor(c), QBColor(c + 1) x1 = x1 + myInterval Next c End Sub
Ex.2 Draw some circles while changing colors
Sub ColorCircle() Dim c, r, d Dim x, y monhdc = GetForegroundWindow() myhdc = GetDC(monhdc) If myhdc = 0 Then Exit Sub r = 20 d = 50 InitializeGraphics ' Declaration of using graphics library c = 0 ' Initialize color number For y = 30 To 100 Step d For x = 40 To 400 Step d DrawOval x, y, r, r, QBColor(c) ' Draw a circle c = c + 1 Next x Next y c = 0 For y = 140 To 210 Step d For x = 40 To 400 Step d DrawOvalFill x, y, r, r, QBColor(c) ' Draw a filled circle c = c + 1 Next x Next y End Sub
Ex.3 Draw an ellipse
Sub DrawOvalTest() monhdc = GetForegroundWindow() myhdc = GetDC(monhdc) If myhdc = 0 Then Exit Sub InitializeGraphics ' Declaration of using graphics library ' Draw Oval DrawOval 100, 80, 70, 30, vbGreen ' Draw Circle DrawOval 200, 80, 30, 30, vbBlack ' Specification of radius ratio of oval and line color by default DrawOval 260, 80, 50 ' Specification of line and fill color by QBColor function DrawOvalFill 360, 80, 40, , QBColor(9), QBColor(12) End Sub
Ex.4 Change the line width and type
Sub LineStyleTest() Dim c, y Const x1 = 30 Const x2 = 330 Const d = 20 monhdc = GetForegroundWindow() myhdc = GetDC(monhdc) If myhdc = 0 Then Exit Sub InitializeGraphics ' Declaration of using graphics library c = QBColor(0) y = 30 gLineWidth = 3 ' Line Width 3 pixel DrawLine x1, y, x2, y, c ' Draw a Line y = y + d gLineWidth = 10 ' Line Width 10 pixel DrawLine x1, y, x2, y, c ' Draw a Line y = y + d gLineWidth = 1 ' Line Width 1 pixel DrawLine x1, y, x2, y, c ' Draw a Line y = y + d SetLineStyle PS_DASH DrawLine x1, y, x2, y, c y = y + d SetLineStyle PS_DOT DrawLine x1, y, x2, y, c y = y + d SetLineStyle PS_DASHDOT DrawLine x1, y, x2, y, c y = y + d SetLineStyle PS_DASHDOTDOT DrawLine x1, y, x2, y, c End Sub