gurhanbutton.ctl

vb 24点计算.是一个智力小游戏

VERSION 5.00
Begin VB.UserControl GurhanButton 
   ClientHeight    =   1665
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4290
   DefaultCancel   =   -1  'True
   EditAtDesignTime=   -1  'True
   MouseIcon       =   "GurhanButton.ctx":0000
   MousePointer    =   99  'Custom
   ScaleHeight     =   111
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   286
   Tag             =   "271201"
   Begin VB.Timer OverTimer 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   1080
      Top             =   0
   End
   Begin VB.Image imgHAND 
      Height          =   480
      Left            =   1800
      Picture         =   "GurhanButton.ctx":030A
      Top             =   0
      Visible         =   0   'False
      Width           =   480
   End
End
Attribute VB_Name = "GurhanButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
Option Explicit

'INFO:
'This Button Control is totally FREE to use, modify...., i.e. you can do
'whatever you want with it. However, you are NOT authorized to sell this
'control. On the other hand, I would appreciate if you send me a feedback.
'This is an enhancement of another project of mine.
'I am sorry about the comments that almost do not exist.
'
'
'
'WHY THIS BUTTON?
'Well, this is just another button to which you can add pictures/icons. However,
'what makes this button different than the others is as follows:
'-You can customize the size of the picture/icon
'-Transparent Background
'-It includes a URL Navigation function so that you can reach a web address
' or send an e-mail message just by clicking the button.
'-I added a 'sound' property so you'll hear a sound for hover & click events
'-Several Styles => Raised, Flat, NoBorder, XPLike+XPWinStyle
'-Regular Picture & Hover Picture
'
'
'PROBLEMS TO SOLVE:
'1-There is more optimization to be done to speed up the performance.
'  Especially some memory cleaning may need to be done upon termination
'  of the control. Any ideas?
'
'
'
'CREDITS:
'-Some XPWindowsButton ideas from [e-mail] regarding
' highlighting of the edges.
'-http://www.mvps.org/vbnet/ for transparent blt api functions.
'-ALL Picture sizing and Bevel stuff is 100% my work.
' (Maybe needs more optimization,though)
'-Thanks to Tuan Hai for a resource usage bug report.
'
'22 December 2001
'Gurhan KARTAL
'http://gurhan.kartal.org (nothing much there :)
'[e-mail]
'
'
'
'
'Hope You like it!
'
'
'

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) 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 FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetPixel Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private AreaOriginal As Long
Dim Gen As Long
Dim Yuk 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 CreateSolidBrush Lib "gdi32" (ByVal crColor 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
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc 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 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 GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor 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 GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc 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 DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long

'Draw State constants
'Image type
Private Const DST_ICON = &H3&
Private Const DST_BITMAP = &H4&
'State type
Private Const DSS_DISABLED = &H20&
Private Const DSS_ENABLED = &H0


Private Type RGB
    Red As Double
    Green As Double
    Blue As Double
End Type


Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) 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 textparametreleri) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'-*-*-*-*-* SOUND  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Const SND_ASYNC = &H1 'continue executing code even
'if sound isn't finished
Const SND_FILENAME = &H20000 '  name is a file name
Const SND_SYNC = &H0 'suspend execution until sound is finished
Const SND_NODEFAULT = &H2 'if file name is not found, don't play
'default sound
Const SND_LOOP = &H8 'loop the sound until next call to the
'function
Const SND_NOSTOP = &H10   'don't stop any currently playing sound
Const SND_NOWAIT = &H2000  'return immediately if driver is busy
'-*-*-*-*-* SOUND  B軹ER -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Private Type textparametreleri
    cbSize As Long
    iTabLength As Long
    iLeftMargin As Long
    iRightMargin As Long
    uiLengthDrawn As Long
End Type

Public Enum XBPicturePosition
    gbTOP = 0
    gbLEFT = 1
    gbRIGHT = 2
    gbBOTTOM = 3
End Enum
Public Enum XBPictureSize
    size16x16 = 0
    size32x32 = 1
    sizeDefault = 2
    sizeCustom = 3
End Enum

Private mvarClientRect As RECT
Private mvarPictureRect As RECT
Private mvarCaptionRect As RECT
Dim mvarTempRect As RECT
Dim g_FocusRect As RECT
Dim alan As RECT

Dim m_OriginalPicSizeW  As Long
Dim m_OriginalPicSizeH  As Long


Dim m_PictureOriginal As Picture
Dim m_PictureHover As Picture
Dim m_Caption As String
Dim m_PicturePosition As XBPicturePosition
Dim m_Picture As Picture
Dim m_PictureWidth As Long
Dim m_PictureHeight As Long
Dim m_PictureSize As XBPictureSize
Dim mvarDrawTextParams As textparametreleri
Dim g_HasFocus As Boolean
Dim g_MouseDown As Boolean, g_MouseIn As Boolean
Dim g_Button As Integer, g_Shift As Integer, g_X As Single, g_Y As Single
Dim g_KeyPressed As Boolean
Dim m_URL As String
Dim m_Raised As Boolean
Dim m_ShowBorderOnFocus As Boolean
Dim m_ShowFocusRect As Boolean


Dim WithEvents g_Font As StdFont    'font problemlerini kaldirmak icin
Attribute g_Font.VB_VarHelpID = -1

Const m_def_URL = ""
Const m_def_Raised = 0
Const m_def_ShowBorderOnFocus = True
Const m_def_ShowFocusRect = True
Const SW_SHOW = 1
Const mvarPadding As Long = 4
Const g_Light = &H80000016
Const g_Shadow = &H80000010
Const g_HighLight = &H80000014
Const g_DarkShadow = &H80000015

Event Click()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseIn(Shift As Integer)
Event MouseOut(Shift As Integer)
'**********************************************************************************
'Default Property Values:
Const m_def_XPWinStyle = 1
Const m_def_BEVEL = 1
Const m_def_BEVELDEPTH = 8
Const m_def_TransparentBG = 0
Const m_def_MaskColor = 0
Const m_def_XPShowBorderAlways = 0
Const m_def_DefCurHand = 1
Const m_def_NoBorderEffect = 0
Const m_def_SoundOver = ".\sound\over.wav"
Const m_def_SoundClick = ".\sound\click.wav"
Const m_def_ForeColor = &H80000012
Const m_def_BackColor = &H8000000F
Const m_def_XPDefaultColors = 1
Const m_def_XPColor_Pressed = &H80000014
Const m_def_XPColor_Hover = &H80000016
Const m_def_XPStyle = 0
'Property Variables:
Dim m_XPWinStyle As Boolean
Dim m_BEVEL As Integer
Dim m_BEVELDEPTH As Integer
Dim m_TransparentBG As Boolean
Dim m_MaskColor As OLE_COLOR
Dim m_XPShowBorderAlways As Boolean
Dim m_DefCurHand As Boolean
Dim m_NoBorderEffect As Boolean
Dim m_SoundOver As String
Dim m_SoundClick As String
Dim m_ForeColor As OLE_COLOR
Dim m_BackColor As OLE_COLOR
Dim m_XPDefaultColors As Boolean
Dim m_XPColor_Pressed As OLE_COLOR
Dim m_XPColor_Hover As OLE_COLOR
Dim m_XPStyle As Boolean

Private Sub UserControl_InitProperties()
    m_BackColor = m_def_BackColor
    m_ForeColor = m_def_ForeColor
    m_ShowBorderOnFocus = m_def_ShowBorderOnFocus
    m_ShowFocusRect = m_def_ShowFocusRect
    Set UserControl.Font = Ambient.Font
    Set g_Font = Ambient.Font
    m_Caption = Ambient.DisplayName
    m_PicturePosition = 1
    m_PictureWidth = 32
    m_PictureHeight = 32
    m_PictureSize = 1
    Set m_PictureHover = LoadPicture("")
    Set m_PictureOriginal = LoadPicture("")
    m_Raised = m_def_Raised
    m_URL = m_def_URL
    m_XPStyle = m_def_XPStyle
    m_XPColor_Pressed = m_def_XPColor_Pressed
    m_XPColor_Hover = m_def_XPColor_Hover
    m_XPDefaultColors = m_def_XPDefaultColors
    
    m_SoundOver = m_def_SoundOver
    m_SoundClick = m_def_SoundClick
    m_NoBorderEffect = m_def_NoBorderEffect
    m_DefCurHand = m_def_DefCurHand
    m_XPShowBorderAlways = m_def_XPShowBorderAlways
    m_MaskColor = m_def_MaskColor
    m_TransparentBG = m_def_TransparentBG
    m_BEVEL = m_def_BEVEL
    m_BEVELDEPTH = m_def_BEVELDEPTH
    m_XPWinStyle = m_def_XPWinStyle
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
    UserControl.BackColor = m_BackColor
    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
    UserControl.ForeColor = m_ForeColor
    
    m_ShowFocusRect = PropBag.ReadProperty("ShowFocusRect", m_def_ShowFocusRect)
    m_ShowBorderOnFocus = PropBag.ReadProperty("ShowBorderOnFocus", m_def_ShowBorderOnFocus)
    m_Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
    m_PicturePosition = PropBag.ReadProperty("PicturePosition", 1)
    Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
    m_PictureWidth = PropBag.ReadProperty("PictureWidth", 32)
    m_PictureHeight = PropBag.ReadProperty("PictureHeight", 32)
    m_PictureSize = PropBag.ReadProperty("PictureSize", 1)
    m_OriginalPicSizeW = PropBag.ReadProperty("OriginalPicSizeW", 32)
    m_OriginalPicSizeH = PropBag.ReadProperty("OriginalPicSizeH", 32)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set g_Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set m_PictureHover = PropBag.ReadProperty("PictureHover", Nothing)
    Set m_PictureOriginal = PropBag.ReadProperty("Picture", Nothing)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)