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 / ch16 / mdipnt1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  4.9 KB  |  121 lines
  1. VERSION 4.00
  2. Begin VB.MDIForm MDIForm1 
  3.    BackColor       =   &H8000000F&
  4.    Caption         =   "MDIForm1"
  5.    ClientHeight    =   5580
  6.    ClientLeft      =   990
  7.    ClientTop       =   2340
  8.    ClientWidth     =   6240
  9.    Height          =   5985
  10.    Left            =   930
  11.    LinkTopic       =   "MDIForm1"
  12.    Top             =   1995
  13.    Width           =   6360
  14.    Begin VB.PictureBox Picture1 
  15.       Align           =   1  'Align Top
  16.       Height          =   375
  17.       Left            =   0
  18.       Picture         =   "mdiPnt1.frx":0000
  19.       ScaleHeight     =   345
  20.       ScaleWidth      =   6210
  21.       TabIndex        =   0
  22.       Top             =   0
  23.       Visible         =   0   'False
  24.       Width           =   6240
  25.       Begin DwsbcLibDemo.SubClass SubClass1 
  26.          Left            =   5820
  27.          Top             =   120
  28.          _Version        =   262144
  29.          _ExtentX        =   847
  30.          _ExtentY        =   847
  31.          _StockProps     =   0
  32.          CtlParam        =   ""
  33.          Persist         =   0
  34.          RegMessage1     =   ""
  35.          RegMessage2     =   ""
  36.          RegMessage3     =   ""
  37.          RegMessage4     =   ""
  38.          RegMessage5     =   ""
  39.          Type            =   0
  40.          Messages        =   "mdiPnt1.frx":7FA2
  41.       End
  42.    End
  43. Attribute VB_Name = "MDIForm1"
  44. Attribute VB_Creatable = False
  45. Attribute VB_Exposed = False
  46. Option Explicit
  47. ' Copyright 
  48.  1997 by Desaware Inc. All Rights Reserved
  49. ' GetWindow() Constants
  50. Private Const GW_CHILD = 5
  51. Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  52. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  53. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  54. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  55. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  56. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  57. 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
  58. Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  59. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  60. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  61. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  62. Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
  63. 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
  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 Long, msg As Long, wp As Long, 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.     ' Get a DC to draw into
  95.     usedc = GetDC(hwnd)
  96.     ' Create a compatible DC to use
  97.     tdc = CreateCompatibleDC(usedc)
  98.     ' Gets the bitmap handle of the background bitmap
  99.     oldbm = SelectObject(tdc, Picture1.Picture)
  100.     Call GetObjectAPI(Picture1.Picture, Len(bm), bm)
  101.     Call GetClientRect(hwnd, rc)
  102.     ' Decide where to place the MDI client logo
  103.     offsx = 20
  104.     offsy = 20
  105.     ' Set the clipping region to the entire window -
  106.     ' necessary because the hDC provided has a clipping
  107.     ' region set.
  108.     Call SelectClipRgn(usedc, 0)
  109.     ' We exclude the bitmap area - this reduces flicker (try removing it)
  110.     Call ExcludeClipRect(usedc, offsx, offsy, offsx + bm.bmWidth, offsy + bm.bmHeight)
  111.     Call FillRect(usedc, rc, COLOR_BACKGROUND)
  112.     ' And restore the clip region before painting the bitmap
  113.     Call SelectClipRgn(usedc, 0)
  114.     Call BitBlt(usedc, offsx, offsy, bm.bmWidth, bm.bmHeight, tdc, 0, 0, SRCCOPY)
  115.     Call ReleaseDC(hwnd, usedc)
  116.     Call SelectObject(tdc, oldbm)
  117.     Call DeleteDC(tdc)
  118.     nodef = True
  119.     retval = True
  120. End Sub
  121.