custmcap.frm

改变Form的标题

VERSION 5.00
Begin VB.Form Form1 
   ClientHeight    =   3135
   ClientLeft      =   1125
   ClientTop       =   2775
   ClientWidth     =   4185
   ControlBox      =   0   'False
   ForeColor       =   &H80000008&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   209
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   279
   Begin VB.Label Label1 
      Caption         =   "Click the button at the top, right corner of this window and select About for more information."
      Height          =   1935
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   3495
   End
   Begin VB.Menu mnuControl 
      Caption         =   "Control"
      Visible         =   0   'False
      Begin VB.Menu mnuControlAbout 
         Caption         =   "&About..."
      End
      Begin VB.Menu mnuControlSep10 
         Caption         =   "-"
      End
      Begin VB.Menu mnuControlClose 
         Caption         =   "&Close"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'CustmCap - Custom Caption Demo for Visual Basic 5
'Copyright (c) 1997 SoftCircuits Programming (R)
'Redistributed by Permission.
'
'This example program demonstrates how to create a form with no
'caption, one possible way of painting your own custom caption, and
'an easy way to allow the user to drag the form by dragging you custom
'caption.
'
'Note: To create the captionless form, set your form's Caption
'property to "" and set its ControlBox property to False. Also note:
'This demo includes code in the Form_Activatee and Form_Deactivate
'events to set the caption color in response to the window becoming
'active or inactive. However, these events occur only when the active
'form is changed within this same application, and not when focus
'switches between applications. To handle form activation in every
'case, it is necessary to implement Windows subclassing to intercept
'the appropriate messages.
'
'This program may be distributed on the condition that it is
'distributed in full and unchanged, and that no fee is charged for
'such distribution with the exception of reasonable shipping and media
'charged. In addition, the code in this program may be incorporated
'into your own programs and the resulting programs may be distributed
'without payment of royalties.
'
'This example program was provided by:
' SoftCircuits Programming
' http://www.softcircuits.com
' P.O. Box 16262
' Irvine, CA 92623
Option Explicit

'Caption metrics
Private Const TITLE_HEIGHT = 12 'Height of title bar in pixels
Private Const CTRLBOXWIDTH = 10 'Width of control box in pixels

Private m_rcButton As RECT      'Control box rectangle
Private rgbTitleColor As Long   'Current caption color

'API declarations
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean

Private Const COLOR_ACTIVECAPTION = 2
Private Const COLOR_INACTIVECAPTION = 3
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Const EDGE_SUNKEN = &HA
Private Const EDGE_RAISED = &H5
Private Const BF_RECT = &HF

Private Sub Form_MouseDown(button As Integer, Shift As Integer, x As Single, y As Single)
    'Since our title bar is just painted on, we need to test for left mouse
    'clicks. If the mouse is over the caption, we initiate dragging. If the
    'mouse is over the control box, we close the toolbar.
    If button = 1 And x >= (ScaleWidth - TITLE_HEIGHT) Then
        'Test for click over "control" button
        If x >= m_rcButton.Left And x < m_rcButton.Right And _
            y >= m_rcButton.Top And y < m_rcButton.Bottom Then
            PopupMenu mnuControl, vbPopupMenuRightButton
        Else                        'Title bar
            'Visual Basic calls SetCapture when the left mouse
            'button is pressed so call ReleaseCapture so mouse
            'messages will be sent to Windows
            ReleaseCapture
            'Tell Windows the mouse was pressed in the caption
            'area (initiates dragging)
            SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
        End If
    End If
End Sub

Private Sub Form_Paint()
    'Paint title bar
    Line (ScaleWidth, 0)-(ScaleWidth - TITLE_HEIGHT, ScaleHeight), rgbTitleColor, BF
    'Draw button
    Line (m_rcButton.Left, m_rcButton.Top)-(m_rcButton.Right - 1, m_rcButton.Bottom - 1), vbButtonFace, BF
    DrawEdge hdc, m_rcButton, EDGE_RAISED, BF_RECT
End Sub

'***
'*** NOTE: Assumes ScaleMode set to 3 - Pixel
'***
Private Sub Form_Resize()
    m_rcButton.Left = ScaleWidth - (TITLE_HEIGHT - 1)
    m_rcButton.Top = 1
    m_rcButton.Right = ScaleWidth - 1
    m_rcButton.Bottom = CTRLBOXWIDTH + 1
    'Force repaint
    Refresh
End Sub

'***
'*** NOTE: This code sets the caption color in
'*** response to the window becoming active or inactive.
'*** However, these events occur only when the active
'*** form is changed within this same application, and
'*** not when focus switches between applications. To
'*** handle form activation in every case, it is
'*** necessary to implement Windows subclassing to
'*** intercept the appropriate messages.
'***
Private Sub Form_Activate()
    'Change title color to active
    rgbTitleColor = GetSysColor(COLOR_ACTIVECAPTION)
    Form_Paint
End Sub

'***
'*** NOTE: See comment for Form_Activate
'***
Private Sub Form_Deactivate()
    'Change title color to inactive
    rgbTitleColor = GetSysColor(COLOR_INACTIVECAPTION)
    Form_Paint
End Sub

Private Sub mnuControlAbout_Click()
    MsgBox "This example demonstrates how you can create a custom" & _
        " window caption. It creates a form with no caption at all" & _
        " and then paints a custom caption along the right side. The" & _
        " demo allows you to drag the window from the custom caption."
End Sub

Private Sub mnuControlClose_Click()
    Unload Me
End Sub