Advertisement
2002VB Graphics #17567

Draw A Device Context In A Disabled State

Cut and Paste the code below into a new project.

AI

AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Source Code
original-source
Sub DisableHDC(SourceDC As Long, SourceWidth As Long, SourceHeight As Long)
Const BLACK = 0
Const DARKGREY = &H808080
Const WHITE = &HFFFFFF
Dim i As Long
Dim j As Long
Dim PixelColor As Long
Dim BackgroundColor As Long
Dim MemoryDC As Long
Dim MemoryBitmap As Long
Dim OldBitmap As Long
Dim BooleanArray() As Boolean
ReDim BooleanArray(SourceWidth, SourceHeight)
MemoryDC = CreateCompatibleDC(SourceDC)
MemoryBitmap = CreateCompatibleBitmap(SourceDC, SourceWidth, SourceHeight)
OldBitmap = SelectObject(MemoryDC, MemoryBitmap)
BitBlt MemoryDC, 0, 0, SourceWidth, SourceHeight, SourceDC, 0, 0, SRCCOPY
BackgroundColor = GetBkColor(SourceDC)
' Scan Pixels and if the pixel is black
' it is flagged as true and saved in BooleanArray(x,y)
' then colored dark grey (disabled color)
For i = 0 To SourceWidth
  For j = 0 To SourceHeight
    PixelColor = GetPixel(MemoryDC, i, j)
    If PixelColor <> BackgroundColor Then ' skip background color pixels
      If PixelColor = BLACK Then
        BooleanArray(i, j) = True
        SetPixel MemoryDC, i, j, DARKGREY
      Else
        SetPixel MemoryDC, i, j, BackgroundColor
      End If
    End If
  Next
Next

' For each Black pixel, draw a white shadow 1 pixel down and
' 1 pixel to the right to create a shadow effect
For i = 0 To SourceWidth - 1
  For j = 0 To SourceHeight - 1
    If BooleanArray(i, j) = True Then
      If BooleanArray(i + 1, j + 1) = False Then
      SetPixel MemoryDC, i + 1, j + 1, WHITE
      End If
    End If
  Next
Next
BitBlt SourceDC, 0, 0, SourceWidth, SourceHeight, MemoryDC, 0, 0, SRCCOPY
SelectObject MemoryDC, OldBitmap
DeleteObject MemoryBitmap
DeleteDC MemoryDC
End Sub
Private Sub Form_Load()
Me.Picture = Me.Icon
End Sub
' Hold down mouse button to disable
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Const PICSIZE = 32
Me.Picture = Me.Icon
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
DisableHDC Me.hdc, PICSIZE, PICSIZE
Me.Refresh
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Picture = Me.Icon
End Sub
Original Comments (3)
Recovered from Wayback Machine