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