home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch09 / shade.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  10.0 KB  |  248 lines
  1. VERSION 5.00
  2. Begin VB.Form frmIcon 
  3.    Caption         =   "Icon Shading"
  4.    ClientHeight    =   1395
  5.    ClientLeft      =   1710
  6.    ClientTop       =   2055
  7.    ClientWidth     =   2685
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   93
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   179
  13.    Begin VB.PictureBox pctFlag 
  14.       BackColor       =   &H000000FF&
  15.       Height          =   555
  16.       Index           =   1
  17.       Left            =   960
  18.       Picture         =   "Shade.frx":0000
  19.       ScaleHeight     =   35
  20.       ScaleMode       =   3  'Pixel
  21.       ScaleWidth      =   35
  22.       TabIndex        =   2
  23.       Top             =   60
  24.       Width           =   555
  25.    End
  26.    Begin VB.PictureBox pctFlag 
  27.       BackColor       =   &H0000FF00&
  28.       Height          =   555
  29.       Index           =   2
  30.       Left            =   1800
  31.       Picture         =   "Shade.frx":030A
  32.       ScaleHeight     =   35
  33.       ScaleMode       =   3  'Pixel
  34.       ScaleWidth      =   35
  35.       TabIndex        =   1
  36.       Top             =   60
  37.       Width           =   555
  38.    End
  39.    Begin VB.PictureBox pctFlag 
  40.       BackColor       =   &H00FF0000&
  41.       Height          =   555
  42.       Index           =   0
  43.       Left            =   120
  44.       Picture         =   "Shade.frx":0614
  45.       ScaleHeight     =   35
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   35
  48.       TabIndex        =   0
  49.       Top             =   60
  50.       Width           =   555
  51.    End
  52.    Begin VB.Label lblText 
  53.       Caption         =   "Choose an icon and watch how  the selected icon gets the Windows95 ""Selected Icon"" look."
  54.       Height          =   615
  55.       Left            =   120
  56.       TabIndex        =   3
  57.       Top             =   720
  58.       Width           =   2415
  59.       WordWrap        =   -1  'True
  60.    End
  61. Attribute VB_Name = "frmIcon"
  62. Attribute VB_GlobalNameSpace = False
  63. Attribute VB_Creatable = False
  64. Attribute VB_PredeclaredId = True
  65. Attribute VB_Exposed = False
  66. Option Explicit
  67. ' Copyright 
  68.  1997 by Desaware Inc. All Rights Reserved
  69. '**********************************
  70. '**  Type Definitions:
  71. #If Win32 Then
  72. Private Type RECT
  73.         left As Long
  74.         top As Long
  75.         right As Long
  76.         bottom As Long
  77. End Type
  78. #End If 'WIN32 Types
  79. '**********************************
  80. '**  Constant Definitions:
  81. #If Win32 Then
  82. Private Const OPAQUE& = 2
  83. Private Const SRCAND& = &H8800C6
  84. Private Const SRCCOPY& = &HCC0020
  85. Private Const SRCERASE& = &H440328
  86. Private Const SRCINVERT& = &H660046
  87. Private Const DSTINVERT& = &H550009
  88. Private Const SRCPAINT& = &HEE0086
  89. Private Const COLOR_HIGHLIGHT& = 13
  90. Private Const WHITENESS& = &HFF0062
  91. Private Const BLACKNESS& = &H42
  92. #End If 'WIN32
  93. '**********************************
  94. '**  Function Declarations:
  95. #If Win32 Then
  96. Private Declare Function DrawIcon& Lib "user32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long)
  97. Private Declare Function CreateBitmap& Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any)
  98. Private Declare Function CreateCompatibleBitmap& Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long)
  99. Private Declare Function CreateCompatibleDC& Lib "gdi32" (ByVal hDC As Long)
  100. Private Declare Function CreatePatternBrush& Lib "gdi32" (ByVal hBitmap As Long)
  101. Private Declare Function SelectObject& Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long)
  102. Private Declare Function DeleteDC& Lib "gdi32" (ByVal hDC As Long)
  103. Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
  104. Private Declare Function FillRect& Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long)
  105. Private Declare Function BitBlt& Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long)
  106. Private Declare Function PatBlt& Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal Pattern As Long)
  107. Private Declare Function GetSysColor& Lib "user32" (ByVal nIndex As Long)
  108. Private Declare Function SetBkColor& Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long)
  109. Private Declare Function SetTextColor& Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long)
  110. Private Declare Function SetBkMode& Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long)
  111. Private Declare Function GetDesktopWindow& Lib "user32" ()
  112. Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
  113. Private Declare Function UpdateWindow& Lib "user32" (ByVal hwnd As Long)
  114. Private Declare Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As Long, ByVal lpOutput As Long, lpInitData As Long)
  115. #End If 'WIN32
  116. Private Sub ShadeRect(ByVal hDC As Long, lpRect As RECT)
  117.     Dim crHiColor&, crOldBkColor&, crOldTextColor&
  118.     Dim hBrush&, hOldBrush&
  119.     Dim hBitmap&, hBitmap2&
  120.     Dim hBrushBitmap&, hOldMemBitmap&
  121.     Dim oldBkMode&, nWidth&, nHeight&
  122.     Dim hMemDC&
  123.     Dim rcRect As RECT
  124.     Dim Bits(7) As Integer
  125.     Dim i%, dl&
  126.     For i% = 0 To 6 Step 2
  127.         Bits(i%) = &H55
  128.         Bits(i% + 1) = &HAA
  129.     Next i%
  130.     nHeight = lpRect.bottom - lpRect.top
  131.     nWidth = lpRect.right - lpRect.left
  132.     hBrushBitmap = CreateBitmap(8, 8, 1, 1, Bits(0))
  133.     hBrush = CreatePatternBrush(hBrushBitmap)
  134.     hBitmap = CreateCompatibleBitmap(hDC, nWidth, nHeight)
  135.     hMemDC = CreateCompatibleDC(hDC)
  136.     hOldMemBitmap = SelectObject(hMemDC, hBitmap)
  137.     rcRect.right = nWidth
  138.     rcRect.bottom = nHeight
  139.     dl& = FillRect(hMemDC, rcRect, hBrush)
  140.     dl& = BitBlt(hMemDC, 0, 0, nWidth, nHeight, hDC, lpRect.left, lpRect.top, SRCAND)
  141.     crOldTextColor = SetTextColor(hDC, 0)
  142.     crOldBkColor = SetBkColor(hDC, RGB(0, 0, 0))
  143.     dl& = SetBkMode(hDC, OPAQUE)
  144.     hOldBrush = SelectObject(hDC, hBrush)
  145.     dl& = FillRect(hDC, lpRect, hBrush)
  146.     dl& = BitBlt(hDC, lpRect.left, lpRect.top, nWidth, nHeight, hMemDC, 0, 0, SRCPAINT)
  147.     dl& = SetBkMode(hDC, oldBkMode)
  148.     dl& = SetBkColor(hDC, crOldBkColor)
  149.     dl& = SetTextColor(hDC, crOldTextColor)
  150.     dl& = SelectObject(hMemDC, hOldMemBitmap)
  151.     dl& = DeleteObject(hBitmap)
  152.     dl& = DeleteDC(hMemDC)
  153.     dl& = DeleteObject(hBrushBitmap)
  154.     dl& = SelectObject(hDC, hOldBrush)
  155.     dl& = DeleteObject(hBrush)
  156. End Sub
  157. Private Sub Form_Click()
  158.     Dim desktop&, myRect As RECT, dl&, i%
  159.     Exit Sub
  160.     myRect.left = 0
  161.     myRect.top = 0
  162.     myRect.right = 1000
  163.     myRect.bottom = 1000
  164.     dl& = CreateDC("DISPLAY", 0, 0, 0)
  165.     ShadeRect dl&, myRect
  166.     MsgBox "BLAH"
  167. '    dl& = PatBlt&(dl&, 0, 0, 1000, 1000, WHITENESS)
  168.     DeleteDC (dl&)
  169. End Sub
  170. Private Sub lblText_Click()
  171.     Form_Click
  172. End Sub
  173. Private Sub pctFlag_Click(Index As Integer)
  174.     Dim i%
  175.     For i% = 0 To 2
  176.         pctFlag(i%).Refresh
  177.     Next i%
  178.     ShadeIcon pctFlag(Index).hDC, pctFlag(Index).Picture
  179. End Sub
  180. Private Function ShadeIcon(ByVal hDC As Long, hIcon As Long)
  181.     Dim crHiColor&, crOldBkColor&, crOldTextColor&
  182.     Dim hBrush&, hOldBrush&
  183.     Dim hBitmap&, hBitmap2&
  184.     Dim hBrushBitmap&, hOldMemBitmap&
  185.     Dim oldBkMode&, nWidth&, nHeight&
  186.     Dim hMemDC&, hMemDC2&
  187.     Dim hMaskDC&, hMaskDC2&, hMaskBitmap&, hMaskBitmap2&
  188.     Dim rcRect As RECT
  189.     Dim Bits(7) As Integer
  190.     Dim i%, dl&
  191.     For i% = 0 To 6 Step 2
  192.         Bits(i%) = &H55
  193.         Bits(i% + 1) = &HAA
  194.     Next i%
  195.     nWidth = 32
  196.     nHeight = 32
  197.     hBrushBitmap = CreateBitmap(8, 8, 1, 1, Bits(0))
  198.     hBrush = CreatePatternBrush(hBrushBitmap)
  199.     hBitmap = CreateCompatibleBitmap(hDC, nWidth, nHeight)
  200.     hBitmap2 = CreateCompatibleBitmap(hDC, nWidth, nHeight)
  201.     hMemDC = CreateCompatibleDC(hDC)
  202.     hMemDC2 = CreateCompatibleDC(hDC)
  203.     dl& = BitBlt(hMemDC2, 0, 0, nWidth, nHeight, hDC, 0, 0, SRCCOPY)
  204.     hOldMemBitmap = SelectObject(hMemDC, hBitmap)
  205.     dl& = SelectObject(hMemDC2, hBitmap2)
  206.     rcRect.right = nWidth
  207.     rcRect.bottom = nHeight
  208.     dl& = FillRect(hMemDC, rcRect, hBrush)
  209.     dl& = BitBlt(hMemDC, 0, 0, nWidth, nHeight, hDC, 0, 0, SRCAND)
  210.     crOldTextColor = SetTextColor(hMemDC2, GetSysColor(COLOR_HIGHLIGHT))
  211.     crOldBkColor = SetBkColor(hMemDC2, RGB(0, 0, 0))
  212.     dl& = SetBkMode(hMemDC2, OPAQUE)
  213.     hOldBrush = SelectObject(hDC, hBrush)
  214.     dl& = FillRect(hMemDC2, rcRect, hBrush)
  215.     dl& = BitBlt(hMemDC2, 0, 0, nWidth, nHeight, hMemDC, 0, 0, SRCPAINT)
  216.     hMaskDC = CreateCompatibleDC(hDC)
  217.     hMaskDC2 = CreateCompatibleDC(hDC)
  218.     hMaskBitmap = CreateCompatibleBitmap(hDC, 32, 32)
  219.     hMaskBitmap2 = CreateCompatibleBitmap(hDC, 32, 32)
  220.     dl& = SelectObject(hMaskDC, hMaskBitmap)
  221.     dl& = SelectObject(hMaskDC2, hMaskBitmap2)
  222.     dl& = PatBlt(hMaskDC, 0, 0, 32, 32, WHITENESS)
  223.     dl& = PatBlt(hMaskDC2, 0, 0, 32, 32, BLACKNESS)
  224.     dl& = DrawIcon(hMaskDC, 0, 0, hIcon)
  225.     dl& = DrawIcon(hMaskDC2, 0, 0, hIcon)
  226.     dl& = BitBlt(hMaskDC, 0, 0, 32, 32, hMaskDC2, 0, 0, SRCINVERT)
  227.     dl& = BitBlt(hDC, 0, 0, 32, 32, hMaskDC, 0, 0, SRCAND)
  228.     dl& = BitBlt(hMaskDC, 0, 0, 32, 32, hMaskDC, 0, 0, DSTINVERT)
  229.     dl& = BitBlt(hMaskDC2, 0, 0, 32, 32, hMemDC, 0, 0, SRCCOPY)
  230.     dl& = BitBlt(hMaskDC2, 0, 0, 32, 32, hMaskDC, 0, 0, SRCAND)
  231.     dl& = BitBlt(hDC, 0, 0, 32, 32, hMaskDC2, 0, 0, SRCPAINT)
  232.     dl& = SetBkMode(hDC, oldBkMode)
  233.     dl& = SetBkColor(hDC, crOldBkColor)
  234.     dl& = SetTextColor(hDC, crOldTextColor)
  235.     dl& = SelectObject(hMemDC, hOldMemBitmap)
  236.     dl& = DeleteObject(hBitmap)
  237.     dl& = DeleteObject(hBitmap2)
  238.     dl& = DeleteDC(hMemDC)
  239.     dl& = DeleteDC(hMemDC2)
  240.     dl& = DeleteDC(hMaskDC)
  241.     dl& = DeleteDC(hMaskDC2)
  242.     dl& = DeleteObject(hMaskBitmap)
  243.     dl& = DeleteObject(hMaskBitmap2)
  244.     dl& = DeleteObject(hBrushBitmap)
  245.     dl& = SelectObject(hDC, hOldBrush)
  246.     dl& = DeleteObject(hBrush)
  247. End Function
  248.