jcframes.ctl

simple supermarket for beginners

VERSION 5.00
Begin VB.UserControl jcFrames 
   Alignable       =   -1  'True
   AutoRedraw      =   -1  'True
   CanGetFocus     =   0   'False
   ClientHeight    =   3000
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4770
   ControlContainer=   -1  'True
   FillStyle       =   0  'Solid
   HitBehavior     =   0  'None
   ScaleHeight     =   200
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   318
   Begin VB.Label Label 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "6"
      BeginProperty Font 
         Name            =   "Webdings"
         Size            =   14.25
         Charset         =   2
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   4410
      MousePointer    =   99  'Custom
      TabIndex        =   0
      Top             =   30
      Visible         =   0   'False
      Width           =   315
   End
End
Attribute VB_Name = "jcFrames"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

'Original Code by Juan Carlos San Rom醤 - Planet Source Code

Option Explicit

'*************************************************************
'   Required Type Definitions
'*************************************************************

'Mover o form
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 Sub ReleaseCapture Lib "user32" ()

'Mudar a borda para mudar tamanho
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private WithEvents frm As Form
Attribute frm.VB_VarHelpID = -1
Private Const GWL_STYLE As Long = -16
Private Const WS_CAPTION As Long = &HC00000

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBTRIPLE
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBTRIPLE
End Type

Private Type Point
    x As Long
    y As Long
End Type

Private Type RECT
    left As Long
    tOp As Long
    Right As Long
    Bottom As Long
End Type

Public Enum jcStyleConst
    XPDefault = 0
    jcGradient = 1
    TextBox = 2
    Windows = 3
    Messenger = 4
    InnerWedge = 5
    OuterWedge = 6
    Header = 7
    Panel = 8
End Enum

'xp theme
Public Enum jcThemeConst
    Blue = 0
    Silver = 1
    Olive = 2
    Visual2005 = 3
    Norton2004 = 4
    Custom = 5
    xThemeDarkBlue = 6
    xThemeGreen = 7
    xThemeOffice2003Style2 = 8
    xThemeMetallic = 9
    xThemeOrange = 10
    xThemeTurquoise = 11
    xThemeGray = 12
    xThemeDarkBlue2 = 13
    xThemeMoney = 14
    xThemeOffice2003Style1 = 15
End Enum

'Respons醰el por mover o form
Public Enum jcResp
    jcTitulo = 0
    jcPainel = 1
    jcAmbos = 2
End Enum

'gradient type
Public Enum jcGradConst
    VerticalGradient = 0
    horizontalGradient = 1
    VCilinderGradient = 2
    hCilinderGradient = 3
End Enum

'header style
Public Enum jcHeaderConst
    TxtBoxColor = 0
    Gradient = 1
End Enum

'TxtBox style
Public Enum jcShadowConst
    [No shadow] = 0
    Shadow = 1
End Enum

'gradient backstyle
Public Enum jcBackStyleConst
    g_Opaque = 0
    g_Transparent = 1
End Enum

'icon aligment
Public Enum IconAlignConst
    vbLeftAligment = 0
    vbRightAligment = 1
End Enum

Enum m_PanelArea
    xTitle = 0
    xPanel = 1
End Enum

'*************************************************************
'   events
'*************************************************************
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event TileClick()
Event PanelClick()
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single, PanelArea As m_PanelArea)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single, PanelArea As m_PanelArea)
Event CollapseClick(Button As Integer)

'*************************************************************
'   Required API Declarations
'*************************************************************

'FORM TRANSPARENTE
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2

'VERS肙 DO WINDOWS
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Point) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DrawIconEx Lib "user32.dll" (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 SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As Any) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal left As Long, ByVal tOp As Long, ByVal Right As Long, ByVal Bottom As Long, ByVal EllipseWidth As Long, ByVal EllipseHeight As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop 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.dll" (ByVal hdc As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetNearestColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private useMask As Boolean, useGrey As Boolean

'*************************************************************
'   Members
'*************************************************************
Private m_FrameColor            As OLE_COLOR
Private m_TextBoxColor          As OLE_COLOR
Private m_BackColor             As OLE_COLOR
Private m_FillColor             As OLE_COLOR

Private m_FrameColorDis         As OLE_COLOR
Private m_TextBoxColorDis       As OLE_COLOR
Private m_FillColorDis          As OLE_COLOR
Private jcColorToDis            As OLE_COLOR
Private jcColorFromDis          As OLE_COLOR
Private jcColorBorderPicDis     As OLE_COLOR

Private m_FrameColorIni         As OLE_COLOR
Private m_TextBoxColorIni       As OLE_COLOR
Private m_FillColorIni          As OLE_COLOR
Private jcColorToIni            As OLE_COLOR
Private jcColorFromIni          As OLE_COLOR
Private jcColorBorderPicIni     As OLE_COLOR

Private m_Caption               As String
Private m_Enabled               As Boolean
Private m_TextBoxHeight         As Long
Private m_TextHeight            As Long
Private m_TextWidth             As Long
Private m_Height                As Long
Private m_TextColor             As Long
Private m_Alignment             As Long
Private m_Font                  As StdFont
Private m_RoundedCorner         As Boolean
Private m_RoundedCornerTxtBox   As Boolean
Private m_style                 As jcStyleConst
Private m_HeaderStyle           As jcHeaderConst
Private m_GradientHeaderStyle   As jcGradConst
Private m_icon                  As StdPicture
Private m_IconSize              As Integer
Private m_IconAlignment         As IconAlignConst
Private m_ThemeColor            As jcThemeConst
Private m_ColorTo               As OLE_COLOR
Private m_ColorFrom             As OLE_COLOR
Private m_Indentation           As Integer
Private m_Space                 As Integer
Private m_TxtBoxShadow          As jcShadowConst
Private jcTextBoxCenter         As Long
Private jcTextDrawParams        As Long
Private jcColorTo               As OLE_COLOR
Private jcColorFrom             As OLE_COLOR
Private jcColorBorderPic        As OLE_COLOR
Private jcLpp As Point
Private Const TEXT_INACTIVE = &H80000011 '&H6A6A6A
Private Const m_Border_Inactive = &H8000000B
Private Const m_BtnFace_Inactive = &H8000000F
Private Const m_BtnFace = &H80000016 '&H8000000F '&H80000016&

'*************************************************************
'   Constants
'*************************************************************
Private Const DT_LEFT = &H0
Private Const DT_TOP = &H0
Private Const DT_RIGHT = &H2
Private Const DT_BOTTOM = &H8
Private Const DT_CENTER = &H1
Private Const DT_VCENTER = &H4
Private Const DT_SINGLELINE = &H20
Private Const DT_WORDBREAK = &H10
Private Const DT_NOCLIP = &H100
Private Const DT_CALCRECT = &H400

Private Const ALTERNATE = 1      ' ALTERNATE and WINDING are
Private Const WINDING = 2        ' constants for FillMode.
Private Const BLACKBRUSH = 4     ' Constant for brush type.
Private Const WHITE_BRUSH = 0    ' Constant for brush type.

Private Const RGN_AND = 1
Private Const RGN_COPY = 5
Private Const RGN_OR = 2
Private Const RGN_XOR = 3
Private Const RGN_DIFF = 4

Private Const m_def_Responsavel = 0
Private Const m_def_AllowDraging = 0
Private Const m_def_AtivarResizeDoForm = False
Private Const m_def_Collapsar = False

Dim temp_height As Integer
Public Collapsado As Boolean

Dim m_Responsavel As jcResp
Dim m_AllowDraging As Boolean
Dim m_AllowParentDraging As Boolean