超级简化的unicode label 控件，没有句柄（hWnd)

imperialeast

超级简化的unicode label 控件，没有句柄（hWnd)
最简化unicode Label控件，没有HWND!!!!傻瓜式



VERSION 5.00
Begin VB.UserControl ULabel
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
ClientHeight = 3600
ClientLeft = 0
ClientTop = 0
ClientWidth = 4800
FillStyle = 0 'Solid
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
ScaleHeight = 240
ScaleMode = 3 'Pixel
ScaleWidth = 320
End
Attribute VB_Name = "ULabel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Type RECT ' 定义矩形区域结构
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hDC As Long, ByVal lpStr As Long, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_CENTER As Long = &H1
Private Const DT_SINGLELINE As Long = &H2
Private Const DT_RIGHT As Long = &H6
Private Const DT_LEFT As Long = &H0
Private m_Text As String, m_Align As Integer
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
Caption = .ReadProperty("Caption", m_Text)
BackColor = .ReadProperty("BackColor", UserControl.BackColor)
ForeColor = .ReadProperty("ForeColor", UserControl.ForeColor)
Set Font = .ReadProperty("Font", UserControl.Font)
Visible = .ReadProperty("Visible", UserControl.BackStyle)
TextAlign = .ReadProperty("TextAlign", m_Align)
End With
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
.WriteProperty "Caption", m_Text
.WriteProperty "BackColor", UserControl.BackColor
.WriteProperty "ForeColor", UserControl.ForeColor
.WriteProperty "Font", UserControl.Font
.WriteProperty "Visible", UserControl.BackStyle
.WriteProperty "TextAlign", m_Align
End With
End Sub
Public Property Get Caption() As String
Caption = m_Text
End Property
Public Property Let Caption(ByVal NewStr As String)
m_Text = NewStr
UserControl.Cls
Dim lRect As RECT
With lRect
.Left = 0
.Top = 0
.Right = UserControl.ScaleWidth
.Bottom = UserControl.ScaleHeight
End With
Select Case m_Align
Case 0
DrawText UserControl.hDC, StrPtr(m_Text), Len(m_Text), lRect, DT_LEFT ' DT_CENTER Or DT_SINGLELINE
Case 1
DrawText UserControl.hDC, StrPtr(m_Text), Len(m_Text), lRect, DT_CENTER
Case 2
DrawText UserControl.hDC, StrPtr(m_Text), Len(m_Text), lRect, DT_RIGHT
End Select
PropertyChanged "Caption"
End Property
Public Property Let BackColor(ByVal newColor As OLE_COLOR)
UserControl.BackColor = newColor
PropertyChanged "BackColor"
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property
Public Property Let ForeColor(ByVal newColor As OLE_COLOR)
' SendMessageW hDC, &H6, newColor, 0
UserControl.ForeColor = newColor
PropertyChanged "ForeColor"
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = UserControl.ForeColor
End Property
Public Property Get Visible() As Integer
Visible = UserControl.BackStyle
End Property
Public Property Let Visible(ByVal NewStyle As Integer)
UserControl.BackStyle = NewStyle
PropertyChanged "BackStyle"
End Property
Public Property Get Font() As Font
Set Font = UserControl.Font
End Property
Public Property Set Font(ByVal NewFont As StdFont)
Set UserControl.Font = NewFont
PropertyChanged "Font"
End Property
Public Property Let TextAlign(ByVal NewStyle As Integer)
m_Align = NewStyle
PropertyChanged "TextAlign"
End Property
Public Property Get TextAlign() As Integer
TextAlign = m_Align
End Property

YY菌

建议 Windowless 设为 True，不然 UserControl 仍然是带有 hWnd 的。

imperialeast

谢谢啊

imperialeast

用unicode控件的好像也不多