textcontrol.ctl

来自「VB圣经」· CTL 代码 · 共 79 行

VERSION 5.00
Begin VB.UserControl TextControl 
   ClientHeight    =   1080
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3195
   ScaleHeight     =   1080
   ScaleWidth      =   3195
   Begin VB.TextBox txtData 
      Height          =   615
      Left            =   180
      TabIndex        =   0
      Top             =   240
      Width           =   2595
   End
End
Attribute VB_Name = "TextControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'***************************************************************
Option Explicit
Implements IPersistHistory

'The three functions we care about simply defer to the
'IPersistStreamInit implementation
Private Sub IPersistHistory_GetClassID(ByVal pClassID As Long)
Dim pPSI As IPersistStreamInit
    Set pPSI = Me
    pPSI.GetClassID pClassID
End Sub
Private Sub IPersistHistory_LoadHistory( _
  ByVal pStream As Long, ByVal pbc As Long)
Dim pPSI As IPersistStreamInit
    Set pPSI = Me
    pPSI.Load pStream
End Sub
Private Sub IPersistHistory_SaveHistory(ByVal pStream As Long)
Dim pPSI As IPersistStreamInit
    Set pPSI = Me
    pPSI.Save pStream, 0
End Sub

'These both return E_NOTIMPL as indicated in MSDN
Private Sub IPersistHistory_SetPositionCookie(ByVal dwPositionCookie As Long)
    Err.Raise E_NOTIMPL
End Sub
Private Function IPersistHistory_GetPositionCookie() As Long
    Err.Raise E_NOTIMPL
End Function

'Property bag procedures are called by the control's native
'IPersistStreamInit implementation.
Private Sub UserControl_InitProperties()
    txtData.Text = "<No Data>"
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    txtData.Text = PropBag.ReadProperty("Data")
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Data", txtData.Text
End Sub

Private Sub UserControl_Resize()
    txtData.Move 0, 0, ScaleWidth, ScaleHeight
End Sub