mybutton.ctl

VS平台内存补丁

        lcolor = TranslateColor(vbGrayText)
      Case Else
        lcolor = m_lFontHighlightColor
    End Select

  End If

  ltmpColor = UserControl.ForeColor
  UserControl.ForeColor = lcolor
  DrawText UserControl.hDC, m_sCaption, -1, m_txtRect, lwFontAlign
  UserControl.ForeColor = ltmpColor
  Exit Sub

DrawCaption_Error:
End Sub


Private Sub DrawVGradient(lEndColor As Long, _
                          lStartcolor As Long, _
                          ByVal X As Long, _
                          ByVal Y As Long, _
                          ByVal X2 As Long, _
                          ByVal Y2 As Long)
  ''Draw a Vertical Gradient in the current HDC
  On Error GoTo DrawVGradient_Error

  Dim dR As Single, dG As Single, dB As Single
  Dim sR As Single, sG As Single, sB As Single
  Dim eR As Single, eG As Single, eB As Single
  Dim ni As Long
  'lh = UserControl.ScaleHeight
  'lw = UserControl.ScaleWidth
  sR = (lStartcolor And &HFF)
  sG = (lStartcolor \ &H100) And &HFF
  sB = (lStartcolor And &HFF0000) / &H10000
  eR = (lEndColor And &HFF)
  eG = (lEndColor \ &H100) And &HFF
  eB = (lEndColor And &HFF0000) / &H10000
  dR = (sR - eR) / Y2
  dG = (sG - eG) / Y2
  dB = (sB - eB) / Y2

  For ni = 0 To Y2
    APILine X, Y + ni, X2, Y + ni, RGB(eR + (ni * dR), eG + (ni * dG), eB + (ni * dB))
  Next 'ni

  Exit Sub

DrawVGradient_Error:
End Sub

Private Sub DrawVGradientEx(lhdcEx As Long, _
                            lEndColor As Long, _
                            lStartcolor As Long, _
                            ByVal X As Long, _
                            ByVal Y As Long, _
                            ByVal X2 As Long, _
                            ByVal Y2 As Long)
  ''Draw a Vertical Gradient in the current HDC
  On Error GoTo DrawVGradientEx_Error

  Dim dR As Single, dG As Single, dB As Single
  Dim sR As Single, sG As Single, sB As Single
  Dim eR As Single, eG As Single, eB As Single
  Dim ni As Long
  'lh = UserControl.ScaleHeight
  'lw = UserControl.ScaleWidth
  sR = (lStartcolor And &HFF)
  sG = (lStartcolor \ &H100) And &HFF
  sB = (lStartcolor And &HFF0000) / &H10000
  eR = (lEndColor And &HFF)
  eG = (lEndColor \ &H100) And &HFF
  eB = (lEndColor And &HFF0000) / &H10000
  dR = (sR - eR) / Y2
  dG = (sG - eG) / Y2
  dB = (sB - eB) / Y2

  For ni = 0 To Y2
    APILineEx lhdcEx, X, Y + ni, X2, Y + ni, RGB(eR + (ni * dR), eG + (ni * dG), eB + (ni * dB))
  Next 'ni

  Exit Sub

DrawVGradientEx_Error:
End Sub

Private Sub DrawHGradient(lEndColor As Long, _
                          lStartcolor As Long, _
                          ByVal X As Long, _
                          ByVal Y As Long, _
                          ByVal X2 As Long, _
                          ByVal Y2 As Long)
  ''Draw a Horizontal Gradient in the current HDC
  On Error GoTo DrawHGradient_Error

  Dim dR As Single, dG As Single, dB As Single
  Dim sR As Single, sG As Single, sB As Single
  Dim eR As Single, eG As Single, eB As Single
  Dim lh As Long, lw As Long
  Dim ni As Long
  lh = Y2 - Y
  lw = X2 - X
  sR = (lStartcolor And &HFF)
  sG = (lStartcolor \ &H100) And &HFF
  sB = (lStartcolor And &HFF0000) / &H10000
  eR = (lEndColor And &HFF)
  eG = (lEndColor \ &H100) And &HFF
  eB = (lEndColor And &HFF0000) / &H10000
  dR = (sR - eR) / lw
  dG = (sG - eG) / lw
  dB = (sB - eB) / lw

  For ni = 0 To lw
    APILine X + ni, Y, X + ni, Y2, RGB(eR + (ni * dR), eG + (ni * dG), eB + (ni * dB))
  Next 'ni

  Exit Sub

DrawHGradient_Error:
End Sub

Private Sub DrawJavaBorder(ByVal X As Long, _
                           ByVal Y As Long, _
                           ByVal w As Long, _
                           ByVal H As Long, _
                           ByVal lColorShadow As Long, _
                           ByVal lColorLight As Long, _
                           ByVal lColorBack As Long)
  On Error GoTo DrawJavaBorder_Error

  ApiRectangle UserControl.hDC, X, Y, w - 1, H - 1, lColorShadow
  ApiRectangle UserControl.hDC, X + 1, Y + 1, w - 1, H - 1, lColorLight
  SetPixelV UserControl.hDC, X, Y + H, lColorBack
  SetPixelV UserControl.hDC, X + w, Y, lColorBack
  SetPixelV UserControl.hDC, X + 1, Y + H - 1, BlendColors(lColorLight, lColorShadow)
  SetPixelV UserControl.hDC, X + w - 1, Y + 1, BlendColors(lColorLight, lColorShadow)
  Exit Sub

DrawJavaBorder_Error:
End Sub
    
Private Function DrawTheme(sClass As String, _
                           ByVal iPart As Long, _
                           ByVal iState As Long) As Boolean
  Dim hTheme As Long
  Dim lResult As Long
  Dim m_btnRect2 As RECT
  Dim hRgn As Long
  On Error GoTo NoXP

  hTheme = OpenThemeData(UserControl.hwnd, StrPtr(sClass))

    If hTheme Then
        If m_bRoundedBordersByTheme Then
            '<--Rounded Region as requested for some themes:
            'Thanks to Dana Seaman-->
            SetRect m_btnRect2, m_btnRect.Left - 1, m_btnRect.Top - 1, m_btnRect.Right + 1, m_btnRect.Bottom + 1
            lResult = GetThemeBackgroundRegion(hTheme, UserControl.hDC, iPart, iState, m_btnRect2, hRgn)
            SetWindowRgn hwnd, hRgn, True
            'free the memory.
            DeleteObject hRgn
        End If
        lResult = DrawThemeBackground(hTheme, UserControl.hDC, iPart, iState, m_btnRect, m_btnRect)
        DrawTheme = IIf(lResult, False, True)
    Else
        DrawTheme = False
    End If

  Exit Function

NoXP:
  DrawTheme = False
End Function

Private Function CreateWinXPregion() As Long
  On Error GoTo CreateWinXPRegion_Error

  Dim pPoligon(8) As POINT
  Dim cpPoligon(1) As Long
  Dim lw As Long, lh As Long
  lw = UserControl.ScaleWidth
  lh = UserControl.ScaleHeight
  cpPoligon(0) = 5
  cpPoligon(1) = 5
  pPoligon(0).X = 0: pPoligon(0).Y = 1
  pPoligon(1).X = 1: pPoligon(1).Y = 0
  pPoligon(2).X = lw - 1: pPoligon(2).Y = 0
  pPoligon(3).X = lw: pPoligon(3).Y = 1
  pPoligon(4).X = lw: pPoligon(4).Y = lh - 2
  pPoligon(5).X = lw - 2: pPoligon(5).Y = lh
  pPoligon(6).X = 2: pPoligon(6).Y = lh
  pPoligon(7).X = 0: pPoligon(7).Y = lh - 2
  'pPoligon(8).x = 0: pPoligon(8).y = lh - 2
  CreateWinXPregion = CreatePolygonRgn(pPoligon(0), 8, ALTERNATE)
  Exit Function

CreateWinXPRegion_Error:
End Function

Private Function CreateGalaxyRegion() As Long
  On Error GoTo CreateGalaxyRegion_Error

  Dim pPoligon(8) As POINT
  Dim cpPoligon(1) As Long
  Dim lw As Long, lh As Long
  lw = UserControl.ScaleWidth
  lh = UserControl.ScaleHeight
  cpPoligon(0) = 5
  cpPoligon(1) = 5
  pPoligon(0).X = 0: pPoligon(0).Y = 2
  pPoligon(1).X = 2: pPoligon(1).Y = 0
  pPoligon(2).X = lw - 3: pPoligon(2).Y = 0
  pPoligon(3).X = lw: pPoligon(3).Y = 3
  pPoligon(4).X = lw: pPoligon(4).Y = lh - 3
  pPoligon(5).X = lw - 3: pPoligon(5).Y = lh
  pPoligon(6).X = 4: pPoligon(6).Y = lh
  pPoligon(7).X = 0: pPoligon(7).Y = lh - 4
  'pPoligon(8).x = 0: pPoligon(8).y = lh - 2
  CreateGalaxyRegion = CreatePolygonRgn(pPoligon(0), 8, ALTERNATE)
  Exit Function

CreateGalaxyRegion_Error:
End Function

Private Function CreateMacOSXButtonRegion() As Long
  'MsgBox "MACOS?"
  On Error GoTo CreateMacOSXButtonRegion_Error

  CreateMacOSXButtonRegion = CreateRoundRectRgn(0, 0, UserControl.ScaleWidth + 1, UserControl.ScaleHeight + 1, 18, 18)
  Exit Function

CreateMacOSXButtonRegion_Error:
End Function

Public Sub About()
  On Error GoTo About_Error

  m_About.Visible = True
  SetWindowLong m_About.hwnd, GWL_STYLE, lPrevStyle + WS_CAPTION + WS_THICKFRAME + WS_MINIMIZEBOX
  SetWindowPos m_About.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW 'Or SWP_NOACTIVATE
  SetWindowPos m_About.hwnd, 0, 0, 0, 0, 0, SWP_REFRESH
  SetWindowText m_About.hwnd, "About MyButton " & strCurrentVersion
  SetWindowPos m_About.hwnd, 0, 0, 0, 0, 0, SWP_REFRESH
  SetParent m_About.hwnd, 0
  ''This is the ocx version about dialog
  'frmAbout.Show vbModal
  Exit Sub

About_Error:
End Sub

'****************************************************************
'
'   Procedures
'
'****************************************************************
Private Sub DrawWinXPButton(Mode As isState)
  '' This Sub Draws the XPStyle Button
  On Error GoTo DrawWinXPButton_Error

  Dim lhdc As Long
  Dim tempColor As Long
  Dim lh As Long, lw As Long
  Dim lcw As Long, lch As Long
  Dim lStep As Single
  lw = UserControl.ScaleWidth
  lh = UserControl.ScaleHeight
  lhdc = UserControl.hDC
  lcw = m_btnRect.Left + lw / 2 + 1
  lch = m_btnRect.Top + lh / 2
  lStep = 25 / lh
  UserControl.BackColor = GetSysColor(COLOR_BTNFACE)

  Select Case Mode
    Case statenormal, stateHot:
      'Main
      DrawVGradient &HFBFCFC, &HF0F0F0, 1, 1, lw - 2, 4
      DrawVGradient &HF9FAFA, &HEAF0F0, 1, 4, lw - 2, lh - 8
      DrawVGradient &HE6EBEB, &HC5D0D6, 1, lh - 4, lw - 2, 3
      'right
      DrawVGradient &HFAFBFB, &HDAE2E4, lw - 3, 3, lw - 2, lh - 5
      DrawVGradient &HF2F4F5, &HCDD7DB, lw - 2, 3, lw - 1, lh - 5
      'Border
      APILine 1, 0, lw - 1, 0, &H743C00
      APILine 0, 1, 0, lh - 1, &H743C00
      APILine lw - 1, 1, lw - 1, lh - 1, &H743C00
      APILine 1, lh - 1, lw - 1, lh - 1, &H743C00
      'Corners
      SetPixelV lhdc, 1, 1, &H906E48
      SetPixelV lhdc, 1, lh - 2, &H906E48
      SetPixelV lhdc, lw - 2, 1, &H906E48
      SetPixelV lhdc, lw - 2, lh - 2, &H906E48
      'External Borders
      SetPixelV lhdc, 0, 1, &HA28B6A
      SetPixelV lhdc, 1, 0, &HA28B6A
      SetPixelV lhdc, 1, lh - 1, &HA28B6A
      SetPixelV lhdc, 0, lh - 2, &HA28B6A
      SetPixelV lhdc, lw - 1, lh - 2, &HA28B6A
      SetPixelV lhdc, lw - 2, lh - 1, &HA28B6A
      SetPixelV lhdc, lw - 2, 0, &HA28B6A
      SetPixelV lhdc, lw - 1, 1, &HA28B6A
      'Internal Soft
      SetPixelV lhdc, 1, 2, &HCAC7BF
      SetPixelV lhdc, 2, 1, &HCAC7BF
      SetPixelV lhdc, 2, lh - 2, &HCAC7BF
      SetPixelV lhdc, 1, lh - 3, &HCAC7BF
      SetPixelV lhdc, lw - 2, lh - 3, &HCAC7BF
      SetPixelV lhdc, lw - 3, lh - 2, &HCAC7BF
      SetPixelV lhdc, lw - 3, 1, &HCAC7BF
      SetPixelV lhdc, lw - 2, 2, &HCAC7BF

      If Mode = stateHot Then
        APILine 2, 1, lw - 2, 1, &HCFF0FF
        APILine 2, 2, lw - 2, 2, &H89D8FD
        APILine 2, lh - 3, lw - 2, lh - 3, &H30B3F8
        APILine 2, lh - 2, lw - 2, lh - 2, &H1097E5
        DrawVGradient &H89D8FD, &H30B3F8, 1, 2, 3, lh - 5
        DrawVGradient &H89D8FD, &H30B3F8, lw - 3, 2, lw - 1, lh - 5
      ElseIf (Mode = statenormal And m_bFocused) Or Ambient.DisplayAsDefault Then
        APILine 2, lh - 2, lw - 2, lh - 2, &HEE8269
        APILine 2, 1, lw - 2, 1, &HFFE7CE
        APILine 2, 2, lw - 2, 2, &HF6D4BC
        APILine 2, lh - 3, lw - 2, lh - 3, &HE4AD89
        DrawVGradient &HF6D4BC, &HE4AD89, 1, 2, 3, lh - 5
        DrawVGradient &HF6D4BC, &HE4AD89, lw - 3, 2, lw - 1, lh - 5
      End If

    Case statePressed:
      ' &HC1ccD1 - &HDBE2E3   -&HDCE3E4