You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
422 lines
15 KiB
422 lines
15 KiB
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "OffScreenDC"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
'----------------------------------------------------------------------
|
|
' OffScreenDC.cls
|
|
'----------------------------------------------------------------------
|
|
' Implementation file for OffScreenDC class
|
|
' This class represents an off screen DC that is useful
|
|
' for enabling flick-free and smooth repainting of things
|
|
' like controls.
|
|
'
|
|
' There are also a couple helper methods that do interesting
|
|
' GDI operations like drawing 3d rectangles and fast rectangles
|
|
'----------------------------------------------------------------------
|
|
' Copyright (c) 1996, Microsoft Corporation
|
|
' All Rights Reserved
|
|
'
|
|
' Information Contained Herin is Proprietary and Confidential
|
|
'----------------------------------------------------------------------
|
|
|
|
Option Explicit
|
|
|
|
'======================================================================
|
|
' Public Enumerations
|
|
'======================================================================
|
|
Public Enum CaptionAlignments
|
|
caCenterCenter
|
|
cacenterleft
|
|
caCenterRight
|
|
caTopCenter
|
|
caTopLeft
|
|
caTopRight
|
|
caBottomCenter
|
|
caBottomLeft
|
|
caBottomright
|
|
End Enum
|
|
|
|
Public Enum Appearances
|
|
Raised
|
|
Flat
|
|
Sunken
|
|
Selected
|
|
End Enum
|
|
|
|
'======================================================================
|
|
' Private Constants
|
|
'======================================================================
|
|
Private Const BORDER_WIDTH As Long = 3
|
|
|
|
'======================================================================
|
|
' Private Data Members
|
|
'======================================================================
|
|
Private mhdcWork As Long 'off-screen HDC
|
|
Private mhdcCtl As Long 'actual HDC of the control
|
|
Private mhbmpOld As Long 'hBmp of the old bitmap in the off-sceen DC
|
|
Private mfntCurrent As IFont 'font to use when drawing text
|
|
Private mhfntOld As Long 'hFont of the old font in the off-screen dc
|
|
|
|
Private mcxCtlWidth As Long 'width of the control's surface
|
|
Private mcyCtlHeight As Long 'height of the control's surface
|
|
|
|
Private mrgb3DFace As Long 'color to use for the 3d face
|
|
Private mrgb3DHighlight As Long 'color to use for the 3d highlight
|
|
Private mrgb3DShadow As Long 'color to use for the 3d shadow
|
|
|
|
'======================================================================
|
|
' Initialize and Terminate Events
|
|
'======================================================================
|
|
|
|
'----------------------------------------------------------------------
|
|
' Class_Terminate()
|
|
'----------------------------------------------------------------------
|
|
' Purpose: Called when the object is destroyed--do clean-up work
|
|
' Inputs: None
|
|
' Outputs: None
|
|
'----------------------------------------------------------------------
|
|
Private Sub Class_Terminate()
|
|
Dim hBmp As Long
|
|
|
|
'if our handles are NULL then just get out
|
|
If mhdcWork <> 0 Then
|
|
'select the old font back into the off-screen dc
|
|
SelectObject mhdcWork, mhfntOld
|
|
|
|
'select the old bitmap back into the off-screen DC
|
|
hBmp = SelectObject(mhdcWork, mhbmpOld)
|
|
|
|
'delete the bitmap we were using
|
|
DeleteObject hBmp
|
|
|
|
'and now delete the off-screen DC to totally clean up
|
|
DeleteDC mhdcWork
|
|
End If 'we were initialized
|
|
|
|
End Sub 'Class_Terminate()
|
|
|
|
'======================================================================
|
|
' Public Methods and Properties
|
|
'======================================================================
|
|
|
|
'----------------------------------------------------------------------
|
|
' BackColor Get/Let
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To get and let the current background color of the DC
|
|
'----------------------------------------------------------------------
|
|
Public Property Get BackColor() As Long
|
|
'assert that we are initialized
|
|
Debug.Assert mhdcWork <> 0
|
|
|
|
'return the current background color
|
|
BackColor = GetBkColor(mhdcWork)
|
|
End Property 'BackColor Get
|
|
|
|
Public Property Let BackColor(rgbNew As Long)
|
|
'assert that we are initialized
|
|
Debug.Assert mhdcWork <> 0
|
|
|
|
'set the new background color
|
|
SetBkColor mhdcWork, rgbNew
|
|
End Property 'BackColor Let
|
|
|
|
'----------------------------------------------------------------------
|
|
' TextColor Get/Let
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To get and let the current text color of the DC
|
|
'----------------------------------------------------------------------
|
|
Public Property Get TextColor() As Long
|
|
'assert that we are initialized
|
|
Debug.Assert mhdcWork <> 0
|
|
|
|
'return the current Text color
|
|
TextColor = GetTextColor(mhdcWork)
|
|
End Property 'TextColor Get
|
|
|
|
Public Property Let TextColor(rgbNew As Long)
|
|
'assert that we are initialized
|
|
Debug.Assert mhdcWork <> 0
|
|
|
|
'set the new text color
|
|
SetTextColor mhdcWork, rgbNew
|
|
End Property 'TextColor Let
|
|
|
|
'----------------------------------------------------------------------
|
|
' Font Get/Set
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To get and set the current font to use on the DC
|
|
'----------------------------------------------------------------------
|
|
Public Property Get Font() As StdFont
|
|
'just return the reference we currently are holding
|
|
Set Font = mfntCurrent
|
|
End Property 'Font Get
|
|
|
|
Public Property Set Font(NewFont As StdFont)
|
|
'make sure we're initialized first
|
|
'must call Initialize before setting the font!
|
|
Debug.Assert (mhdcWork <> 0)
|
|
|
|
'below we will set a local member variable equal to the
|
|
'object passed in. Even though the type passed in is a
|
|
'StdFont, our member variable is of type IFont. A StdFont
|
|
'can be casted (QI) to an IFont, and the IFont interface gives
|
|
'us access to the hFont property, which we need in order to
|
|
'set the current font of the off-screen device context.
|
|
|
|
'if this is the first time the font is being set,
|
|
'grab the existing hFont handle so we can restore it
|
|
'before deleting the DC
|
|
If mfntCurrent Is Nothing Then
|
|
Set mfntCurrent = NewFont
|
|
mhfntOld = SelectObject(mhdcWork, mfntCurrent.hFont)
|
|
Else
|
|
Set mfntCurrent = NewFont
|
|
|
|
'if this is being set to Nothing, restore the old font
|
|
If mfntCurrent Is Nothing Then
|
|
SelectObject mhdcWork, mhfntOld
|
|
Else
|
|
SelectObject mhdcWork, mfntCurrent.hFont
|
|
End If 'new font is nothing
|
|
|
|
End If 'first time setting font
|
|
|
|
End Property 'Font Set
|
|
|
|
'----------------------------------------------------------------------
|
|
' 3D Colors Properties
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To return the RGB values for 3d colors
|
|
'----------------------------------------------------------------------
|
|
Public Property Get ThreeDFaceColor() As Long
|
|
ThreeDFaceColor = mrgb3DFace
|
|
End Property
|
|
|
|
Public Property Get ThreeDHighlightColor() As Long
|
|
ThreeDHighlightColor = mrgb3DHighlight
|
|
End Property
|
|
|
|
Public Property Get ThreeDShadowColor() As Long
|
|
ThreeDShadowColor = mrgb3DShadow
|
|
End Property
|
|
|
|
'----------------------------------------------------------------------
|
|
' Initialize()
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To initialize the object with the screen DC from which we
|
|
' will create the off-screen DC
|
|
' Inputs: The user control
|
|
' Outputs: none
|
|
'----------------------------------------------------------------------
|
|
Public Sub Initialize(CtlHdc As Long, CtlWidth As Long, CtlHeight As Long)
|
|
Dim hBmp As Long
|
|
|
|
'assert that the inputs are valid
|
|
'and that we haven't already called Initialize
|
|
Debug.Assert (CtlHdc <> 0)
|
|
Debug.Assert (mhdcWork = 0)
|
|
|
|
'store the HDC of the control in our private variable
|
|
mhdcCtl = CtlHdc
|
|
|
|
'capture the width and height of the control
|
|
mcxCtlWidth = CtlWidth
|
|
mcyCtlHeight = CtlHeight
|
|
|
|
'create the off-sceen DC
|
|
mhdcWork = CreateCompatibleDC(mhdcCtl)
|
|
|
|
'create a compatible bitmap from the control DC
|
|
'that is the same size as the control itself
|
|
hBmp = CreateCompatibleBitmap(mhdcCtl, mcxCtlWidth, mcyCtlHeight)
|
|
|
|
'select that new bitmap into the off-screen DC
|
|
'and save the old bitmap handle so we can reselect
|
|
'it back in before we destroy the off-screen DC
|
|
mhbmpOld = SelectObject(mhdcWork, hBmp)
|
|
End Sub 'Initialize()
|
|
|
|
'----------------------------------------------------------------------
|
|
' FillRect()
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To fill a rectangle on the off-screen DC with a specified
|
|
' color in a fast way
|
|
' Inputs: The rectangle to fill and color to use
|
|
' Outputs: none
|
|
'----------------------------------------------------------------------
|
|
Public Sub FillRect(nLeft As Long, nTop As Long, nWidth As Long, nHeight As Long, rgbColor As Long, Optional sCaption As String = "", Optional CaptionAlign As CaptionAlignments = caCenterCenter)
|
|
Dim nX As Long 'X for drawing caption text
|
|
Dim nY As Long 'Y for drawing caption text
|
|
Dim rc As RECT 'rect struct to pass to the GDI
|
|
Dim szTextExtent As Size 'pixel size of caption
|
|
|
|
'assert that we've been initialized already
|
|
'and check the inputs
|
|
Debug.Assert mhdcWork <> 0
|
|
Debug.Assert rgbColor >= 0
|
|
|
|
'set the back color of the DC to the color desired
|
|
Me.BackColor = rgbColor
|
|
|
|
'calculate the caption X and Y (centered) if the caption
|
|
'is not an empty string
|
|
If Len(sCaption) > 0 Then
|
|
|
|
'get the pixel width of the Caption
|
|
GetTextExtentPoint32 mhdcWork, sCaption, Len(sCaption), szTextExtent
|
|
|
|
'determine the X value based on the alignment chosen
|
|
Select Case CaptionAlign
|
|
Case caCenterCenter, caTopCenter, caBottomCenter
|
|
nX = ((nWidth - szTextExtent.cx) \ 2) + nLeft
|
|
|
|
Case caCenterRight, caTopRight, caBottomright
|
|
nX = nWidth - BORDER_WIDTH - szTextExtent.cx + nLeft
|
|
|
|
Case cacenterleft, caTopLeft, caBottomLeft
|
|
nX = nLeft + BORDER_WIDTH
|
|
End Select
|
|
|
|
'determine the Y value base on the alignment chosen
|
|
Select Case CaptionAlign
|
|
Case caCenterCenter, caCenterRight, cacenterleft
|
|
nY = ((nHeight - szTextExtent.cy) \ 2) + nTop
|
|
|
|
Case caTopCenter, caTopLeft, caTopRight
|
|
nY = nTop + BORDER_WIDTH
|
|
|
|
Case caBottomCenter, caBottomLeft, caBottomright
|
|
nY = nHeight - BORDER_WIDTH - szTextExtent.cy + nTop
|
|
|
|
End Select
|
|
End If 'caption is not ""
|
|
|
|
'assign the input values to the rect struct
|
|
rc.Left = nLeft
|
|
rc.Top = nTop
|
|
rc.Right = nWidth + nLeft
|
|
rc.Bottom = nHeight + nTop
|
|
|
|
'ExtTextOut is one of the fastest ways to fill a rectangular
|
|
'area on a DC and is used here to fill our rect
|
|
ExtTextOut mhdcWork, nX, nY, ETO_OPAQUE + ETO_CLIPPED, rc, sCaption, Len(sCaption), 0
|
|
|
|
End Sub 'FillRect
|
|
|
|
'----------------------------------------------------------------------
|
|
' Draw3DRect()
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To draw a 3D looking rectangle on the off-screen DC
|
|
' Inputs: The rectangle to make 3d and optionally a caption to
|
|
' display centered in the rect
|
|
' Outputs: none
|
|
'----------------------------------------------------------------------
|
|
Public Sub Draw3DRect(ByVal nLeft As Long, ByVal nTop As Long, ByVal nWidth As Long, ByVal nHeight As Long, Optional sCaption As String = "", Optional CaptionAlign As CaptionAlignments = caCenterCenter, Optional Appearance As Appearances = Raised)
|
|
Dim rgbLowerRight As Long 'color to use for the lower right
|
|
Dim rgbUpperLeft As Long 'color to use for the upper left
|
|
|
|
'assert that we've been initialized already
|
|
'and check the inputs
|
|
Debug.Assert mhdcWork <> 0
|
|
|
|
'if we haven't gotten the system colors for 3d effects
|
|
'get them first
|
|
If mrgb3DFace = 0 Then
|
|
mrgb3DFace = GetSysColor(COLOR_BTNFACE)
|
|
mrgb3DHighlight = GetSysColor(COLOR_BTNHIGHLIGHT)
|
|
mrgb3DShadow = GetSysColor(COLOR_BTNSHADOW)
|
|
End If
|
|
|
|
'set the lower-right and upper-left colors based on the
|
|
'desired appearance
|
|
Select Case Appearance
|
|
Case Flat
|
|
rgbLowerRight = mrgb3DShadow
|
|
rgbUpperLeft = mrgb3DShadow
|
|
|
|
Case Raised
|
|
rgbLowerRight = mrgb3DShadow
|
|
rgbUpperLeft = mrgb3DHighlight
|
|
|
|
Case Sunken
|
|
rgbLowerRight = mrgb3DHighlight
|
|
rgbUpperLeft = mrgb3DShadow
|
|
|
|
Case Selected
|
|
rgbLowerRight = mrgb3DHighlight
|
|
rgbUpperLeft = vbBlack
|
|
|
|
End Select
|
|
|
|
'fill the rect with the shadow color (or hightlight if sunken)
|
|
Me.FillRect nLeft, nTop, nWidth, nHeight, rgbLowerRight
|
|
|
|
'now pull the right and bottom edges in by 1 pixel
|
|
nWidth = nWidth - 1
|
|
nHeight = nHeight - 1
|
|
|
|
'fill the rect with the 3d highlight color (or shadow if sunken)
|
|
Me.FillRect nLeft, nTop, nWidth, nHeight, rgbUpperLeft
|
|
|
|
'finally pull in the left and top edges by 1 pixel
|
|
nLeft = nLeft + 1
|
|
nTop = nTop + 1
|
|
nWidth = nWidth - 1
|
|
nHeight = nHeight - 1
|
|
|
|
'change the color to the 3d face color
|
|
'and fill the rect passing the desired caption
|
|
Me.FillRect nLeft, nTop, nWidth, nHeight, mrgb3DFace, sCaption, CaptionAlign
|
|
|
|
'if the appearance setting was Selected, invert the rect
|
|
If Appearance = Selected Then
|
|
InvertRect nLeft, nTop, nWidth, nHeight
|
|
End If 'appearance = selected
|
|
|
|
End Sub 'Draw3dRect
|
|
|
|
'----------------------------------------------------------------------
|
|
' InvertRect()
|
|
'----------------------------------------------------------------------
|
|
' Purpose: To invert a particular rect on the bitmap
|
|
' Inputs: The area to invert
|
|
' Outputs: none
|
|
'----------------------------------------------------------------------
|
|
Public Sub InvertRect(nLeft As Long, nTop As Long, nWidth As Long, nHeight As Long)
|
|
Dim rc As RECT
|
|
|
|
rc.Left = nLeft
|
|
rc.Top = nTop
|
|
rc.Right = nLeft + nWidth
|
|
rc.Bottom = nTop + nHeight
|
|
|
|
Utils.InvertRect mhdcWork, rc
|
|
End Sub 'InvertRect()
|
|
|
|
'----------------------------------------------------------------------
|
|
' BlastToScreen()
|
|
'----------------------------------------------------------------------
|
|
' Purpose: Blasts the contents of the off-screen DC to the control's
|
|
' on-screen surface
|
|
' Inputs: none
|
|
' Outputs: none
|
|
'----------------------------------------------------------------------
|
|
Public Sub BlastToScreen(Optional Left As Long = 0, Optional Top As Long = 0, Optional Width As Long = -1, Optional Height As Long = -1)
|
|
If Width = -1 Then Width = mcxCtlWidth
|
|
If Height = -1 Then Height = mcyCtlHeight
|
|
|
|
'use bitblt to blast the contents of the off-screen dc to the control
|
|
BitBlt mhdcCtl, Left, Top, Width, Height, mhdcWork, _
|
|
Left, Top, SRCCOPY
|
|
End Sub 'BlastToScreen()
|
|
|
|
'======================================================================
|
|
' Private Helper Methods
|
|
'======================================================================
|
|
|