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 / ch16 / mdipnt1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-12-19  |  5.2 KB  |  124 lines
  1. VERSION 5.00
  2. Object = "{C5089F43-6EDC-101C-B41C-00AA0036005A}#4.0#0"; "dwsbc32d.ocx"
  3. Begin VB.MDIForm MDIForm1 
  4.    BackColor       =   &H8000000F&
  5.    Caption         =   "MDIForm1"
  6.    ClientHeight    =   5580
  7.    ClientLeft      =   990
  8.    ClientTop       =   2340
  9.    ClientWidth     =   6240
  10.    LinkTopic       =   "MDIForm1"
  11.    Begin VB.PictureBox Picture1 
  12.       Align           =   1  'Align Top
  13.       Height          =   375
  14.       Left            =   0
  15.       Picture         =   "mdiPnt1.frx":0000
  16.       ScaleHeight     =   345
  17.       ScaleWidth      =   6210
  18.       TabIndex        =   0
  19.       Top             =   0
  20.       Visible         =   0   'False
  21.       Width           =   6240
  22.       Begin DwsbcLibDemo.SubClass SubClass1 
  23.          Left            =   5820
  24.          Top             =   120
  25.          _Version        =   262144
  26.          _ExtentX        =   847
  27.          _ExtentY        =   847
  28.          _StockProps     =   0
  29.          CtlParam        =   ""
  30.          Persist         =   0
  31.          RegMessage1     =   ""
  32.          RegMessage2     =   ""
  33.          RegMessage3     =   ""
  34.          RegMessage4     =   ""
  35.          RegMessage5     =   ""
  36.          Type            =   0
  37.          Messages        =   "mdiPnt1.frx":7FA2
  38.       End
  39.    End
  40. Attribute VB_Name = "MDIForm1"
  41. Attribute VB_GlobalNameSpace = False
  42. Attribute VB_Creatable = False
  43. Attribute VB_PredeclaredId = True
  44. Attribute VB_Exposed = False
  45. Option Explicit
  46. ' Copyright 
  47.  1996-1997 by Desaware Inc. All Rights Reserved
  48. ' GetWindow() Constants
  49. Private Const GW_CHILD = 5
  50. Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  51. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  52. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  53. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  54. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  55. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  56. 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) As Long
  57. Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  58. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  59. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  60. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  61. Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
  62. Private Declare Function ExcludeClipRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  63. Private Declare Function ValidateRectBynum Lib "user32" Alias "ValidateRect" (ByVal hwnd As Long, ByVal lpRect As Long) As Long
  64. Const COLOR_BACKGROUND = 1
  65. Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  66. Private Type RECT
  67.         Left As Long
  68.         Top As Long
  69.         Right As Long
  70.         Bottom As Long
  71. End Type
  72. ' Bitmap Header Definition
  73. Private Type BITMAP
  74.         bmType As Long
  75.         bmWidth As Long
  76.         bmHeight As Long
  77.         bmWidthBytes As Long
  78.         bmPlanes As Integer
  79.         bmBitsPixel As Integer
  80.         bmBits As Long
  81. End Type
  82. Private Sub MDIForm_Load()
  83.     ' Subclass the MDI client window
  84.     SubClass1.HwndParam = GetWindow(hwnd, GW_CHILD)
  85.     Form1.Show
  86. End Sub
  87. Private Sub SubClass1_WndMessage(hwnd As OLE_HANDLE, msg As OLE_HANDLE, wp As OLE_HANDLE, lp As Long, retval As Long, nodef As Integer)
  88.     Dim tdc&
  89.     Dim usedc&
  90.     Dim oldbm&
  91.     Dim bm As BITMAP
  92.     Dim rc As RECT
  93.     Dim offsx&, offsy&
  94.     Debug.Print "Erasebkgnd"
  95.     ' Get a DC to draw into
  96.     usedc = GetDC(hwnd)
  97.     ' Create a compatible DC to use
  98.     tdc = CreateCompatibleDC(usedc)
  99.     ' Gets the bitmap handle of the background bitmap
  100.     oldbm = SelectObject(tdc, Picture1.Picture)
  101.     Call GetObjectAPI(Picture1.Picture, Len(bm), bm)
  102.     Call GetClientRect(hwnd, rc)
  103.     ' Decide where to place the MDI client logo
  104.     offsx = 20
  105.     offsy = 20
  106.     ' Set the clipping region to the entire window -
  107.     ' necessary because the hDC provided has a clipping
  108.     ' region set.
  109.     Call SelectClipRgn(usedc, 0)
  110.     ' We exclude the bitmap area - this reduces flicker (try removing it)
  111.     Call ExcludeClipRect(usedc, offsx, offsy, offsx + bm.bmWidth, offsy + bm.bmHeight)
  112.     Call FillRect(usedc, rc, COLOR_BACKGROUND)
  113.     ' And restore the clip region before painting the bitmap
  114.     Call SelectClipRgn(usedc, 0)
  115.     Call BitBlt(usedc, offsx, offsy, bm.bmWidth, bm.bmHeight, tdc, 0, 0, SRCCOPY)
  116.     Call ReleaseDC(hwnd, usedc)
  117.     Call SelectObject(tdc, oldbm)
  118.     Call DeleteDC(tdc)
  119.     ' This was added for VB5
  120.     Call ValidateRectBynum(hwnd, 0)
  121.     nodef = True
  122.     retval = True
  123. End Sub
  124.