xpframe.ctl

磁盘FAT扇区数据读写操作 Ver 1.20(更新版)

    If Ambient.UserMode Then Err.Raise 382
    m_hWnd = New_hWnd
    PropertyChanged "hWnd"
End Property
''***********************************************************************************

''**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=21,0,0,0
Public Property Get FrameType() As FrameTypes
    FrameType = MyFrameType
End Property

Public Property Let FrameType(ByVal New_FrameType As FrameTypes)
    MyFrameType = New_FrameType
    If MyFrameType = [Windows Standard] Then
       BackC = GetSysColor(COLOR_BTNFACE)
    End If
    Call SetColors
    Call UserControl_Resize
    Call Redraw(True)                                          '####(0, True)
    PropertyChanged "FrameType"
End Property

'**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    Call SetAccessKeys
    Call Redraw(True)                                         '####(0, True)
    PropertyChanged "Caption"
End Property
'******************************************************************************************
'

Public Property Get XpFrameType() As XpFrameTypes
    XpFrameType = MyXpFrameType
End Property

Public Property Let XpFrameType(ByVal New_XpFrameType As XpFrameTypes)
    MyXpFrameType = New_XpFrameType
    Call SetColors
    Call Redraw(True)                                                 '####Call Redraw(0, True)
    PropertyChanged "XpFrameType"
End Property
'***********************************************************************************************
Public Property Get GradientDirection() As GradientDirectionEnum
    GradientDirection = m_GradientDirection
End Property

Public Property Let GradientDirection(ByVal New_GradientDirection As GradientDirectionEnum)
    m_GradientDirection = New_GradientDirection
    Call SetColors
    Call Redraw(True)                                                 '####Call Redraw(0, True)
    PropertyChanged "GradientDirection"
End Property
'Public Property Get GradientBKColor() As Boolean
'    GradientBKColor = m_GradientBKColor
'End Property
'
'Public Property Let GradientBKColor(ByVal New_GradientBKColor As Boolean)
'    m_GradientBKColor = New_GradientBKColor
'    Call Redraw(True)
'    PropertyChanged "GradientBKColor"
'End Property
'*********************************************************************************************

'***********************************************************************************************
'为用户控件初始化属性
Private Sub UserControl_InitProperties()

    BackC = m_def_BackColor                   'GetSysColor(COLOR_BTNFACE)
    ForeC = GetSysColor(COLOR_BTNTEXT)
    isEnabled = m_def_Enabled
   ' Set TextFont = Ambient.Font
    Set TextFont = UserControl.Font
    m_hWnd = m_def_hWnd
    MyFrameType = m_def_FrameType
    MyXpFrameType = m_def_XpFrameType
    m_GradientDirection = m_def_GradientDirection
    m_Caption = Extender.Name                          ' m_def_Caption
    m_FrameColor = m_def_FrameColor
    m_Caption3D = m_def_Caption3D
    m_BKEndColor = m_def_BKEndColor
'    m_GradientBKColor = m_def_GradientBKColor
End Sub

'***********************************************************************************************
'***********************************************************************************************
'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    BackC = PropBag.ReadProperty("BackColor", m_def_BackColor)
    ForeC = PropBag.ReadProperty("ForeColor", GetSysColor(COLOR_BTNTEXT))
    FrameColor = PropBag.ReadProperty("Framecolor", m_def_FrameColor)
    isEnabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
    Set TextFont = PropBag.ReadProperty("Font", Ambient.Font)
    m_hWnd = PropBag.ReadProperty("hWnd", m_def_hWnd)
    MyFrameType = PropBag.ReadProperty("FrameType", m_def_FrameType)
    MyXpFrameType = PropBag.ReadProperty("XpFrameType", m_def_XpFrameType)
    m_GradientDirection = PropBag.ReadProperty("GradientDirection", m_def_GradientDirection)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
    m_Caption3D = PropBag.ReadProperty("Caption3D", m_def_Caption3D)
    m_BKEndColor = PropBag.ReadProperty("BKEndColor", m_def_BKEndColor)
'    m_GradientBKColor = PropBag.ReadProperty("GradientBKColor", m_def_GradientBKColor)
    UserControl.Enabled = isEnabled
    Set UserControl.Font = TextFont
    Call SetColors
    Call SetAccessKeys
    Call Redraw(True)                                   '####(0,true)
    
End Sub
'***********************************************************************************************
'************************************************************************************************
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", BackC, m_def_BackColor)
    Call PropBag.WriteProperty("ForeColor", ForeC, GetSysColor(COLOR_BTNTEXT))
    Call PropBag.WriteProperty("FrameColor", m_FrameColor, m_def_FrameColor)
    Call PropBag.WriteProperty("Enabled", isEnabled, m_def_Enabled)
    Call PropBag.WriteProperty("Caption3D", m_Caption3D, m_def_Caption3D)
    Call PropBag.WriteProperty("BKEndColor", m_BKEndColor, m_def_BKEndColor)
'    Call PropBag.WriteProperty("GradientBKColor", m_GradientBKColor, m_def_GradientBKColor)
    Call PropBag.WriteProperty("Font", TextFont, Ambient.Font)
    Call PropBag.WriteProperty("hWnd", m_hWnd, m_def_hWnd)
    Call PropBag.WriteProperty("FrameType", MyFrameType, m_def_FrameType)
    Call PropBag.WriteProperty("XpFrameType", MyXpFrameType, m_def_XpFrameType)
    Call PropBag.WriteProperty("GradientDirection", m_GradientDirection, m_def_GradientDirection)
    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
    
End Sub
'*****************************************************************************************************
'*************************************************************************************************
Private Sub UserContol_AccessKeyPress(KeyAscii As Integer)
    Call UserControl_Click
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
'Debug.Print PropertyName
Call Redraw(True)
End Sub
'******************************************************************************************************
Private Sub UserControl_DblClick()

   If LastButton = 1 And (isEnabled = True) Then
      Call UserControl_MouseDown(1, 1, 1, 1)
   End If
End Sub

Private Sub UserControl_Click()
   'If w Then
      If (LastButton = 1) And (isEnabled = True) Then
    
          UserControl.Refresh
          RaiseEvent Click
      End If
End Sub


Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 2 And (isEnabled = True) Then
   RaiseEvent MouseDown(Button, Shift, X, Y)
End If
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 2 And (isEnabled = True) Then
   LastButton = Button
  RaiseEvent MouseUp(Button, Shift, X, Y)
End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button < 2 And (isEnabled = True) Then
  
       If X >= 0 And Y >= 0 And _
       X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight Then
       '在按钮内部
        RaiseEvent MouseMove(Button, Shift, X, Y)
    
    End If
  
End If
'RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub UserControl_Resize()
    He = UserControl.ScaleHeight
    Wi = UserControl.ScaleWidth
    Call Redraw(True)                                 '####(0, True)
End Sub

'按钮重画子程序

Private Sub Redraw(ByVal Force As Boolean)
   Dim i As Long
   Dim ii As Long

If Force = False Then 'check drawing redundancy
    If (Te = m_Caption) Then Exit Sub
End If

If He = 0 Then Exit Sub 'we don't want errors

   Te = m_Caption
   'm_Caption = ""
   If m_Caption = "" Then
      TextHeight = 0
   Else
      TextHeight = UserControl.TextHeight(m_Caption)
   End If
   TextWidth = UserControl.TextWidth(m_Caption)
   'allcount = LenB(StrConv(m_Caption, vbFromUnicode))  '此段为中英文显示判断,计算总的字节数
With UserControl
     .Cls
     If m_GradientDirection <> Fill_None Then
        FillGradient UserControl.hdc, 0, 0, Wi, He, cFace, m_BKEndColor, m_GradientDirection
     Else
        DrawRectangle 0, 0, Wi, He, cFace         ' vbWhite
     End If
    If isEnabled = True Then
         Select Case MyFrameType
                Case 1
                     If TextHeight = 0 Then
                        DrawRectangle 1, 7, Wi - 1, He - 7, vbWhite, True
                        DrawRectangle 0, 6, Wi - 1, He - 7, RGB(128, 128, 128), True
                        mSetPixel Wi - 1, 6, vbWhite
                        mSetPixel 0, He - 1, vbWhite
                     Else
                        DrawRectangle 1, TextHeight \ 2 + 3, Wi - 1, He - TextHeight \ 2 - 3, vbWhite, True
                        DrawRectangle 0, TextHeight \ 2 + 2, Wi - 1, He - TextHeight \ 2 - 3, RGB(128, 128, 128), True
                        mSetPixel Wi - 1, TextHeight \ 2 + 2, vbWhite
                        mSetPixel 0, He - 1, vbWhite
                        DrawRectangle 8, 1, TextWidth + 2, TextHeight, cFace
                        rc.Left = 9: rc.Top = 2: rc.Right = TextWidth + 11: rc.Bottom = TextHeight + 2
                        SetTextColor .hdc, cText
                        DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                     End If
                Case 2, 3
                     
                     If m_Caption3D = True Then
                            rc.Left = 8: rc.Top = 3: rc.Right = TextWidth + 10: rc.Bottom = TextHeight + 3
                            SetTextColor .hdc, ShiftColor(cText, -&H3F) '&H808080
                            DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                            rc.Left = 7: rc.Top = 2: rc.Right = TextWidth + 9: rc.Bottom = TextHeight + 2
                            SetTextColor .hdc, cText
                            DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                     Else
                            rc.Left = 8: rc.Top = 3: rc.Right = TextWidth + 10: rc.Bottom = TextHeight + 3
                            SetTextColor .hdc, cText 'restore font color
                            DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                     End If
                     DrawLine 0, TextHeight \ 2 + 4, 0, He - 2, rgbcolor          '画左线
                     DrawCorner 0, 0, 1, 1, rgbcolor                     '画左上角
                     DrawLine 2, TextHeight \ 2 + 2, 8, TextHeight \ 2 + 2, rgbcolor '画上线左
                     DrawLine TextWidth + 8, TextHeight \ 2 + 2, Wi - 2, TextHeight \ 2 + 2, rgbcolor '画上线右
                     DrawCorner Wi - 4, -1, 1, -1, rgbcolor             '画右上角
                     DrawLine Wi - 1, TextHeight \ 2 + 4, Wi - 1, He - 2, rgbcolor        '画右线
                     DrawCorner Wi - 4, He - TextHeight \ 2 - 5, 1, 1, rgbcolor             '画右下角
                     DrawLine Wi - 3, He - 1, 1, He - 1, rgbcolor               '画下线
                     DrawCorner 0, He - TextHeight \ 2 - 6, 1, -1, rgbcolor                 '画左下角
         End Select
 
Else
'#~#~#~#~#~# DISABLED STATUS #~#~#~#~#~#
         Select Case MyFrameType
                Case 1
                     If TextHeight = 0 Then