Keskustelu: Ohjelmointikysymykset: VB6: Napin fontin väri?

Option Explicit

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

Private Const DT_SINGLELINE& = &H20
Private Const DT_CENTER& = &H1
Private Const DT_VCENTER& = &H4
Private Const TRANSPARENT& = 1
Private Declare Function SetBkMode& Lib "gdi32" (ByVal hdc As Long,  _
ByVal nBkMode As Long)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function DrawText& Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long)

Private Sub Command1_GotFocus()
  Timer1.Enabled = True
End Sub

Private Sub Command1_LostFocus()
  Timer1.Enabled = True
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer,  _
x As Single, y As Single)
  PaintCaption Command1, 2, 2, vbRed
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, _
x As Single, y As Single)
  PaintCaption Command1, 0, 0, vbRed
End Sub

Private Sub Form_Paint()
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  PaintCaption Command1, 0, 0, vbRed
  Timer1.Enabled = False
End Sub

Private Sub PaintCaption(btn As CommandButton, ByVal x As Long, _
ByVal y As Long, clr As Long)
  Dim dc As Long, re As RECT
  dc = GetDC(btn.hwnd)
  SetTextColor dc, clr
  SetBkMode dc, TRANSPARENT
  re.Left = x
  re.Top = y
  re.Bottom = btn.Height
  re.Right = btn.Width
  DrawText dc, btn.Tag, -1, re, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE

End Sub