VB API 之 第六课 字体应用三

直接上源码不做解释自己看吧

Option Explicit
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) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetBoundsRect Lib "gdi32" (ByVal hdc As Long, lprcBounds As RECT, ByVal flags As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Const DT_BOTTOM = &H8
Private Const DT_CALCRECT = &H400
Private Const DT_CENTER = &H1
Private Const DT_CHARSTREAM = 4
Private Const DT_DISPFILE = 6
Private Const DT_EXPANDTABS = &H40
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_INTERNAL = &H1000
Private Const DT_LEFT = &H0
Private Const DT_METAFILE = 5
Private Const DT_NOCLIP = &H100
Private Const DT_NOPREFIX = &H800
Private Const DT_RIGHT = &H2
Private Const DT_SINGLELINE = &H20
Private Const DT_TABSTOP = &H80
Private Const DT_TOP = &H0
Private Const DT_VCENTER = &H4
Private Const DT_WORDBREAK = &H10
Private Const DCB_RESET = &H1
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Dim ARR(4) As RECT
Dim str1, str2, str3 As String

Private Sub Form_Click()
    Dim A As Long
    Dim B As Long
    Dim C As Long
    
    
    ARR(0).Top = 0
    ARR(0).Left = 0
    ARR(0).Right = 70
    ARR(0).Bottom = 50
    B = GetDC(Me.Command1.hwnd)
    C = GetBoundsRect(B, ARR(0), DCB_RESET)
    SetTextColor B, RGB(255, 0, 0)
    SetBkMode B, 0
    str1 = "同志工作室"
    str2 = str1 + str1
    str3 = str1 + str2
    A = DrawText(B, str1 + Chr(13) + str2 + Chr(13) + str3, -1, ARR(0), DT_RIGHT)
End Sub

运行效果如图所示:

posted @ 2014-10-08 21:43  Delphi爱好者2014  阅读(297)  评论(0编辑  收藏  举报