xpframe.ctl

可以用于商业用途

VERSION 5.00
Begin VB.UserControl xpFrame 
   Alignable       =   -1  'True
   ClientHeight    =   780
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2505
   ControlContainer=   -1  'True
   DrawWidth       =   56
   EditAtDesignTime=   -1  'True
   ScaleHeight     =   52
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   167
   ToolboxBitmap   =   "xpFrame.ctx":0000
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Frame1"
      Height          =   195
      Left            =   135
      TabIndex        =   0
      Top             =   -30
      Visible         =   0   'False
      Width           =   525
   End
End
Attribute VB_Name = "xpFrame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

'****************************************************************************
Option Explicit

'===Declarations enumations et types======================================================================================================
Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean

Private Declare Function MoveWindow Lib "User32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
'Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "User32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function InflateRect Lib "User32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long)
Private Declare Function PostMessage Lib "User32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClientRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function LockWindowUpdate Lib "User32" (ByVal hwndLock As Long) As Long
Private Declare Function GetIconInfo Lib "User32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Declare Function CopyImage Lib "User32" (ByVal Handle As Long, ByVal imageType As Long, ByVal newWidth As Long, ByVal newHeight As Long, ByVal lFlags As Long) As Long
Private Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetMapMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal HPALETTE As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseDC Lib "User32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetSysColor Lib "User32" (ByVal nIndex As Long) As Long
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) As Long
Private Declare Function DrawIconEx Lib "User32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObj As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObj As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
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

Const SRCAND = &H8800C6
Const SRCCOPY = &HCC0020
Const SRCERASE = &H440328
Const SRCINVERT = &H660046
Const SRCPAINT = &HEE0086

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Type ICONINFO
    fIcon As Long
    xHotSpot As Long
    yHotSpot As Long
    hbmMask As Long
    hbmColor As Long
End Type

Public Enum Theme
    xThemeDarkBlue
    xThemeMoney
    xThemeMediaPlayer
    xThemeMediaPlayer2
    xThemeGreen
    xThemeMetallic
    xThemeOffice2003
    xThemeOrange
    xThemeTurquoise
    xThemeGray
    xThemeDarkBlue2
    xThemeLightBlue
End Enum

'Public Enum PictureAlign
'    xAlignLeftEdge                      '-->Left edge
'    xAlignRightEdge                     '-->Right Edge
'    xAlignLeftOfCaption                 '-->Left of the caption
'    xAlignRightOfCaption                '-->Right of the caption
'End Enum

Public Enum TextAlign
    xAlignLefttop
    xAlignLeftMiddle
    xAlignLeftBottom
    xAlignRightTop
    xAlignRightMiddle
    xAlignRightBottom
    xAlignCenterTop
    xAlignCenterMiddle
    xAlignCenterBottom
End Enum

Public Enum FillStyle
    HorizontalFading
    VerticalFading
End Enum

Public Enum HeaderFooterStyleSize
    Small
    Medium
    Large
End Enum
Public Enum FooterStyleSize
    eMedium
    eLarge
End Enum

Public Enum TraceBorderStyle
    SOLID = 0                   '  _______
    DASH = 1                    '  -------
    DOT = 2                     '  .......
    DASHDOT = 3                 '  _._._._
    DASHDOTDOT = 4              '  _.._.._
    NONE = 5
End Enum

Public Enum ShapeStyle
    Squared
    Rounded
End Enum

Public Enum HeaderBarStates
    eBarcollapsed
    eBarExpanded
End Enum

'resize
Private OldX As Single
Private OldY As Single
Private DragMode As Boolean
Dim MoveMe As Boolean
Dim SizeMe As Boolean

'===Constantes=========================================================================================================

'HELLO ME

'#Header
Private Const m_def_sHeaderText As String = "Header"      'texte du header
Private Const m_def_eHeaderTextAlign As Integer = xAlignLefttop      'alignement du caption
Private Const m_def_oHeaderTextColor As Long = vbWhite     'couleur texte header
Private Const m_def_eHeaderSize As Integer = HeaderFooterStyleSize.Medium      'taille
Private Const m_def_bHeaderVisible As Boolean = True        'visibilit