Microsoft Access, Office/VBA, VB6 Modules royalty-free source code library

Microsoft Access Modules royalty-free source code library

Microsoft Access VBA and VB6 Module Library

Free trial of Total Visual SourceBook for Microsoft Access, Office, VB6 and VBA

Module: Graphics in Category Microsoft Visual Basic 6 : Graphics from Total Visual SourceBook

Routines for creating graphics, primarily with Windows API calls in VB6.

The majority of the procedures in this module enhance VB6's built-in graphics handling capabilities by allowing you to call routines in the Windows API to create graphical effects on your forms and other objects. Routines such as GradientFill, DrawControlEdge and RotateText actually place graphical objects on your forms. Other routines in this module perform numerical or calculated transformations only, or retrieve graphical information, such as the TranslateVBColor, GetRedValue and GetPixelColor functions. These functions do not produce any output, but they are useful helper functions for working with VB6 graphics.

Procedure List

Procedure Name	Type	Description
(Declarations)	Declarations	Declarations and private variables for the modGraphics module.
DrawControlEdge	Procedure	Draw a 3D border around a control to create nonstandard 3D effects around controls, such as etched lines, or sunken/raised effects which are 1 pixel rather than 2 pixels deep, etc. Easily change the 3D effect to Raised when a control gets focus, then change it back to sunken when it loses focus to highligh which control has focus. See the enumerated constants beginning with grphBDR_ and grphTBDR_ in the declarations section for options to use with this function. Note: The effects are simply drawn onto the control's container using its hDC property. If the form is covered by another form, the Edge effect iserased. You may want to draw the edge in the form or container's Paint event.
DrawFocusRectangle	Procedure	Draw or remove a focus rectangle at the specified location. This draws a standard dotted-line rectangle, which is usually used to indicate that the area has the input focus on the object. This function is useful if you are creating graphical controls which don't have their own windows, and wish to simulate a control getting focus. Calling the function twice in a row with the same coordinates removes the focus rectangle.
DrawPixel	Procedure	Draw one pixel at the specified location.
DrawRectEdge	Procedure	Draw a 3D border with the specified dimensions. This function can be used to draw rectangles using various 3D effects such as etched lines, or sunken/raised effects which are 1 pixel rather than 2 pixels deep. Specify the dimensions of the rectangle by passing a grphRECT type variable containing values for Left, Top, Bottom and Right. See the EnumGraphicsBorderStyles constants in the declarations section for constant options which can be used with this function. Note: The effects are simply drawn onto object using the hDC property. If the object is covered by another form, the Edge effect will be erased. You might want to draw the edge in the form or container's Paint event.
FillRectHatch	Procedure	Fill a specified rectangular area with a hatched style.
FillRectPattern	Procedure	Fill a specified rectangular area with an 8x8 pixel pattern specified in the selected picture.
FillRectSolid	Procedure	Fill a specified rectangular area with a selected color.
FrameRectangle	Procedure	Draw a frame around the specified rectangular area.
GetBlueValue	Procedure	Get the Blue component of an RGB value.
GetGreenValue	Procedure	Get the Green component of an RGB value.
GetPixelColor	Procedure	Get the RBG color value of the specified pixel.
GetRedValue	Procedure	Get the Red component of an RGB value.
GradientFill	Procedure	Draw a gradient on the background of an object, such as a form or picture, between two specified colors. There are two ways to use this procedure. You may call it from your object's Paint event to draw the gradient each time the background of the object needs to be painted, or you can permanently draw the gradients onto the background of the object by writing to its persistent bitmap. In this case you need to: Set the object's Autoredraw property to True. Call the GradientFill function to draw the gradients. Set the object's Autoredraw property back to False.
InvertRectangle	Procedure	Invert the colors of the specified rectangle. Call the function once to invert the colors in the rectangle. Call it again to restore the original colors.
PaintFromDesktop	Procedure	Fill the clipping region in the specified device context with the desktop pattern or wallpaper. This function is useful for creating alternative shell programs.
RotateText	Procedure	Draw rotated text onto a form or picture box. The text is printed directly onto the object.
TilePicture	Procedure	Tile the contents of a PictureBox control on the background of a form. There are two ways to use this procedure. You may call it from your form's Paint event to refresh the tiling each time the background of the form needs to be painted. In this case you would want to set the fFillFormOnly argument to True, since there is no point in tiling the picture over any area of the form which is not visible. If the form is resized so that more of it becomes visible, the Paint event will fire anyway, and so that portion of the form will be drawn. Instead of tiling the picture in your form's Paint event, you may permanently draw the picture onto the background of the form by writing to its persistent bitmap. In this case you need to set the form's Autoredraw property to True, tile the picture on the form's background, and set the form's Autoredraw property back to False. With a resizable form, set the fFillFormOnly argument of the TilePicture function to True, so that if more of the form is uncovered when the user resizes it, the background is already drawn.
TranslateVBColor	Procedure	Translates VBA/VB6 color constants for system colors into GDI equivalents. VBA/VB6 color constants, such as vbRed, vbBlue, or values returned using the QBColor() or RGB() functions, can be used directly for the color values used with Windows API calls. However, the VBA/VB6 color constants for system colors (vbButtonFace, vb3DShadow etc.) do not map correctly to those expected by Windows. This function accepts either form of constant and translates the value, if necessary, into the equivalent value expected by the Windows GDI subsystem.

Example Code for Using Module: Graphics

' Example of modGraphics
'
' To try this example, do the following:
' 1. Create a new form
' 2. Create a label 'lblCaption'
' 3. Create a command button 'cmdTest'
' 4. Create a command button 'cmdFocusRect'
' 5. Create a command button 'cmdInvert'
' 6. Create a command button 'cmdPaintDesktop'
' 7. Create a command button 'cmdRotateFont'
' 8. Create a command button 'cmdTilePicture'
' 9. Create a picture box called 'picPoint'
'    Set the following properties
'    BackColor    &H00FFFFFF& (white)
' 10. Create a picture box called 'picPattern'
' 11. Create a picture box called 'picGradient'
' 12. Paste all the code from this example to the new form's module.

' This example assumes that the sample files are located in the folder named by the following constant.
Private Const mcstrSamplePath As String = "C:\TVSBSamp"

Private Sub Form_Load()
  cmdTest.Caption = "Test"
  cmdFocusRect.Caption = "Focust Rectangle"
  cmdInvert.Caption = "Invert"
  cmdPaintDesktop.Caption = "Paint Desktop"
  cmdRotateFont.Caption = "Rotate Font"
  cmdTilePicture.Caption = "Tile Picture"

  lblCaption = "Here is a label"
  picPattern.Picture = LoadPicture(mcstrSamplePath & "\grnblupt.bmp")
  picPattern.Width = ScaleX(8, vbPixels, vbTwips)
  picPattern.Height = ScaleY(8, vbPixels, vbTwips)

End Sub

Private Sub Form_Paint()
  Dim rectDraw As grphRECT

  ' Example of DrawControlEdge
  ' Draw a raised border around the Test button
  DrawControlEdge cmdTest, grphTBDR_RESET

  ' Example of DrawRectEdge
  ' Draw a small rectangle in the lower-left portion of the form
  With rectDraw
    .Left = 5
    .Top = ScaleY(Me.ScaleHeight, vbTwips, vbPixels) - 20
    .Right = 50
    .Bottom = .Top + 10
  End With

  DrawRectEdge Me.hDC, rectDraw, grphTBDR_ETCHED

  ' Example of FillRectHatch
  ' Draw a small hatched rectangle to the right of the previous rectangle
  With rectDraw
    .Left = 60
    .Right = 100
  End With

  FillRectHatch Me.hDC, rectDraw, grphHS_DIAGCROSS, vbBlue

  ' Example of FillRectSolid
  ' Draw a small solid rectangle to the right of the previous rectangle
  With rectDraw
    .Left = 110
    .Right = 150
  End With

  FillRectSolid Me.hDC, rectDraw, vbRed

  ' Example of FrameRectangle
  ' Draw a small unfilled rectangle to the right of the previous rectangle
  With rectDraw
    .Left = 160
    .Right = 200
  End With

  FrameRectangle Me.hDC, rectDraw, vbGreen

End Sub

Private Sub cmdInvert_Click()
  Dim rectDraw As grphRECT
  With rectDraw
    .Left = 5
    .Top = 5
    .Right = ScaleX(Me.ScaleWidth, vbTwips, vbPixels) - 5
    .Bottom = ScaleY(Me.ScaleHeight, vbTwips, vbPixels) - 5
  End With

  ' Example of InvertRectangle
  ' Invert the contents of the form in a rectangle. Pressing the
  ' button twice restores the form
  InvertRectangle Me.hDC, rectDraw

End Sub

Private Sub cmdPaintDesktop_Click()
  ' Example of PaintFromDesktop
  PaintFromDesktop picPoint.hDC

End Sub

Private Sub cmdRotateFont_Click()

  Me.Font.Name = "Arial"
  Me.Font.Bold = True
  Me.Font.Size = 12
  Me.ForeColor = vbRed

  ' Example of RotateText
  ' This code draws a vertical line of text on the left edge of the form
  RotateText Me.hDC, "Rotated Text", 90, 1, ScaleY(Me.ScaleHeight, vbTwips, vbPixels) / 2, Me.Font

End Sub

Private Sub cmdTest_Click()
  ' Example of VBTranslateColor
  Dim lngPointColor As Long

  MsgBox "BackColor: " & TranslateVBColor(Me.BackColor)
  MsgBox "ForeColor: " & TranslateVBColor(Me.ForeColor)
  MsgBox "vbRed: " & TranslateVBColor(vbRed)
  MsgBox "vbButtonFace: " & TranslateVBColor(vbButtonFace)

  lngPointColor = picGradient.Point(picGradient.ScaleWidth / 2, picGradient.ScaleHeight / 2)
  MsgBox "Value of middle pixel: " & lngPointColor

  MsgBox "Red value: " & GetRedValue(lngPointColor)
  MsgBox "Green value: " & GetGreenValue(lngPointColor)
  MsgBox "Blue value: " & GetBlueValue(lngPointColor)

End Sub

Private Sub cmdTilePicture_Click()
  ' Example of TilePicture
  TilePicture Me, picPattern
End Sub

Private Sub cmdFocusRect_Click()
  ' Example of DrawFocusRect
  ' Draw a simulated focus rectangle around the lblCaption label.
  ' Pressing the button twice removes the focus rectangle

  Dim r As grphRECT

  With r
    .Left = ScaleX(lblCaption.Left, vbTwips, vbPixels)
    .Top = ScaleY(lblCaption.Top, vbTwips, vbPixels)
    .Right = ScaleX(lblCaption.Left + lblCaption.Width, vbTwips, vbPixels)
    .Bottom = ScaleY(lblCaption.Top + lblCaption.Height, vbTwips, vbPixels)
  End With

  DrawFocusRectangle Me.hDC, r

End Sub

Private Sub cmdFillPattern_Click()
  Dim rectDraw As grphRECT

  With rectDraw
    .Top = 5
    .Bottom = 50
    .Left = 5
    .Right = 50
  End With

  ' Example of FillRectPattern
  ' Fills a pattern in the upper-left hand corner of the form
  FillRectPattern Me.hDC, rectDraw, picPattern.Picture

End Sub

Private Sub picGradient_Paint()
  ' Example of GradientFill
  GradientFill picGradient.hDC, picGradient.hwnd,     vbRed , vbBlue, gfdTopToBottom, gfsNormal

End Sub

Private Sub picPoint_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)

  ' Example of DrawPixel
  ' Create several pixel points by clicking in the picture box. Then
  ' move the mouse around in the picture box to retrieve the color of the
  ' pixel under the cursor
  lblCaption = "Color: " & GetPixelColor(picPoint.hDC, ScaleX(X, vbTwips, vbPixels), ScaleY(Y, vbTwips, vbPixels))

End Sub

Private Sub picPoint_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)

  Static lngColor As Long

  lngColor = lngColor + 1
  If lngColor > 15 Then
    lngColor = 0
  End If

  ' Example of DrawPixel
  ' Draw a single pixel at the point of the mouse click in one of the 16 standard VB6 colors

  DrawPixel picPoint.hDC, ScaleX(X, vbTwips, vbPixels), ScaleY(Y, vbTwips, vbPixels), QBColor(lngColor)

End Sub

Overview of Total Visual SourceBook

The source code in Total Visual Sourcebook includes modules and classes for Microsoft Access, Visual Basic 6 (VB6), and Visual Basic for Applications (VBA) developers. Easily add this professionally written, tested, and documented royalty-free code into your applications to simplify your application development efforts.

Total Visual SourceBook is written for the needs of a developer using a source code library covering the many challenges you face. Countless developers over the years have told us they learned some or much of their development skills and tricks from our code. You can too!