GDI/图象编程

开发平台：
Visual Basic

AeroTextBox.ctl：源码内容
							VERSION 5.00
Begin VB.UserControl AeroTextBox 
   BackColor       =   &H00B2ACA5&
   ClientHeight    =   1740
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2910
   BeginProperty Font 
      Name            =   "Segoe UI"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ScaleHeight     =   116
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   194
   ToolboxBitmap   =   "AeroTextBox.ctx":0000
   Begin VB.TextBox Text1 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   840
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   600
      Width           =   1215
   End
End
Attribute VB_Name = "AeroTextBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'Default Property Values:
Const m_def_BorderStyle = 1
'Property Variables:
Dim m_BorderStyle As Integer
'Event Declarations:
Event Click() 'MappingInfo=Text1,Text1,-1,Click
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
Event DblClick() 'MappingInfo=Text1,Text1,-1,DblClick
Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=Text1,Text1,-1,KeyDown
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=Text1,Text1,-1,KeyPress
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=Text1,Text1,-1,KeyUp
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Text1,Text1,-1,MouseDown
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Text1,Text1,-1,MouseMove
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Text1,Text1,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
Event Change() 'MappingInfo=Text1,Text1,-1,Change
Attribute Change.VB_Description = "Occurs when the contents of a control have changed."
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  BackColor = Text1.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  Text1.BackColor() = New_BackColor
  PropertyChanged "BackColor"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  ForeColor = Text1.ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  Text1.ForeColor() = New_ForeColor
  PropertyChanged "ForeColor"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
  UserControl.Enabled() = New_Enabled
  PropertyChanged "Enabled"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
  Set Font = Text1.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
  Set Text1.Font = New_Font
  PropertyChanged "Font"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  Text1.Refresh
End Sub
Private Sub Text1_Click()
  RaiseEvent Click
End Sub
Private Sub Text1_DblClick()
  RaiseEvent DblClick
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
  RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,Alignment
Public Property Get Alignment() As Integer
Attribute Alignment.VB_Description = "Returns/sets the alignment of a CheckBox or OptionButton, or a control's text."
  Alignment = Text1.Alignment
End Property
Public Property Let Alignment(ByVal New_Alignment As Integer)
  Text1.Alignment() = New_Alignment
  PropertyChanged "Alignment"
End Property
Private Sub Text1_Change()
  RaiseEvent Change
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hWnd
Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
  hWnd = UserControl.hWnd
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,MaxLength
Public Property Get maxLength() As Long
Attribute maxLength.VB_Description = "Returns/sets the maximum number of characters that can be entered in a control."
  maxLength = Text1.maxLength
End Property
Public Property Let maxLength(ByVal New_MaxLength As Long)
  Text1.maxLength() = New_MaxLength
  PropertyChanged "MaxLength"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,PasswordChar
Public Property Get PasswordChar() As String
Attribute PasswordChar.VB_Description = "Returns/sets a value that determines whether characters typed by a user or placeholder characters are displayed in a control."
  PasswordChar = Text1.PasswordChar
End Property
Public Property Let PasswordChar(ByVal New_PasswordChar As String)
  Text1.PasswordChar() = New_PasswordChar
  PropertyChanged "PasswordChar"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,SelLength
Public Property Get SelLength() As Long
Attribute SelLength.VB_Description = "Returns/sets the number of characters selected."
  SelLength = Text1.SelLength
End Property
Public Property Let SelLength(ByVal New_SelLength As Long)
  Text1.SelLength() = New_SelLength
  PropertyChanged "SelLength"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,SelStart
Public Property Get SelStart() As Long
Attribute SelStart.VB_Description = "Returns/sets the starting point of text selected."
  SelStart = Text1.SelStart
End Property
Public Property Let SelStart(ByVal New_SelStart As Long)
  Text1.SelStart() = New_SelStart
  PropertyChanged "SelStart"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,SelText
Public Property Get SelText() As String
Attribute SelText.VB_Description = "Returns/sets the string containing the currently selected text."
  SelText = Text1.SelText
End Property
Public Property Let SelText(ByVal New_SelText As String)
  Text1.SelText() = New_SelText
  PropertyChanged "SelText"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Text1,Text1,-1,Text
Public Property Get Text() As String
Attribute Text.VB_Description = "Returns/sets the text contained in the control."
  Text = Text1.Text
End Property
Public Property Let Text(ByVal New_Text As String)
  Text1.Text() = New_Text
  PropertyChanged "Text"
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
  m_BorderStyle = m_def_BorderStyle
  Text1.Text = Ambient.DisplayName
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  Text1.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
  Text1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
  UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  Set Text1.Font = PropBag.ReadProperty("Font", Ambient.Font)
  Text1.Alignment = PropBag.ReadProperty("Alignment", 0)
  Text1.maxLength = PropBag.ReadProperty("MaxLength", 0)
  Text1.PasswordChar = PropBag.ReadProperty("PasswordChar", "")
  Text1.SelLength = PropBag.ReadProperty("SelLength", 0)
  Text1.SelStart = PropBag.ReadProperty("SelStart", 0)
  Text1.SelText = PropBag.ReadProperty("SelText", "")
  Text1.Text = PropBag.ReadProperty("Text", Ambient.DisplayName)
  m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  UserControl_Resize
End Sub
Private Sub UserControl_Resize()
  Text1.Move m_BorderStyle, m_BorderStyle, ScaleWidth - (m_BorderStyle * 2), ScaleHeight - (m_BorderStyle * 2)
  Height = (Text1.Height + (m_BorderStyle * 2)) * Screen.TwipsPerPixelY
  SetWindowRgn hWnd, CreateRoundRectRgn(0, 0, ScaleWidth + 1, ScaleHeight + 1, 2, 2), True
End Sub
Private Sub UserControl_Show()
  UserControl_Resize
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Call PropBag.WriteProperty("BackColor", Text1.BackColor, &H80000005)
  Call PropBag.WriteProperty("ForeColor", Text1.ForeColor, &H80000008)
  Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  Call PropBag.WriteProperty("Font", Text1.Font, Ambient.Font)
  Call PropBag.WriteProperty("Alignment", Text1.Alignment, 0)
  Call PropBag.WriteProperty("MaxLength", Text1.maxLength, 0)
  Call PropBag.WriteProperty("PasswordChar", Text1.PasswordChar, "")
  Call PropBag.WriteProperty("SelLength", Text1.SelLength, 0)
  Call PropBag.WriteProperty("SelStart", Text1.SelStart, 0)
  Call PropBag.WriteProperty("SelText", Text1.SelText, "")
  Call PropBag.WriteProperty("Text", Text1.Text, Ambient.DisplayName)
  Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,1
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  BorderStyle = m_BorderStyle
End Property
Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  m_BorderStyle = New_BorderStyle
  PropertyChanged "BorderStyle"
End Property

						