
Attribute VB_Name = "Module1"
Enum BS
None = 0
[Fixed Single] = 1
End Enum
Dim m_CanGrow As Boolean
Dim m_RightMargin As Integer
Dim m_LeftMargin As Integer
Dim m_TopMargin As Integer
Dim m_BottomMargin As Integer
Dim m_Text As String
Dim LineNo As Integer
Event Click()
Event DblClick()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Const m_def_CanGrow = False

Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
UserControl.BackColor = New_BackColor
Text1.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property

Public Property Get ForeColor() As OLE_COLOR
ForeColor = Text1.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
Text1.ForeColor() = New_ForeColor
PropertyChanged "ForeColor"
End Property

Public Property Get Enabled() As Boolean
Enabled = Text1.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
Text1.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property

Public Property Get Font() As Font
Set Font = Text1.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set Text1.Font = New_Font
PropertyChanged "Font"
Text1.Text = GetJustText
End Property

Public Property Get BorderStyle() As BS
BorderStyle = UserControl.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As BS)
UserControl.BorderStyle() = New_BorderStyle
PropertyChanged "BorderStyle"
End Property

Public Sub Refresh()
UserControl_Resize
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_LostFocus()
If WithOutK(m_Text) <> WithOutK(Text1.Text) Then m_Text = WithOutK(Text1.Text)
UserControl_Show
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

Public Property Get Text() As String
Text = m_Text
End Property

Public Property Let Text(ByVal New_Text As String)
m_Text = New_Text
PropertyChanged "Text"
Text1.Text = GetJustText
End Property

Public Property Get FontBold() As Boolean
FontBold = Text1.FontBold
End Property

Public Property Let FontBold(ByVal New_FontBold As Boolean)
Text1.FontBold() = New_FontBold
PropertyChanged "FontBold"
Text1.Text = GetJustText
End Property

Public Property Get FontItalic() As Boolean
FontItalic = Text1.FontItalic
End Property

Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
Text1.FontItalic() = New_FontItalic
PropertyChanged "FontItalic"
Text1.Text = GetJustText
End Property

Public Property Get FontName() As String
FontName = Text1.FontName
End Property

Public Property Let FontName(ByVal New_FontName As String)
Text1.FontName() = New_FontName
PropertyChanged "FontName"
Text1.Text = GetJustText
End Property

Public Property Get FontSize() As Single
FontSize = Text1.FontSize
End Property

Public Property Let FontSize(ByVal New_FontSize As Single)
Text1.FontSize() = New_FontSize
PropertyChanged "FontSize"
Text1.Text = GetJustText
End Property

Public Property Get FontUnderline() As Boolean
FontUnderline = Text1.FontUnderline
End Property

Public Property Let FontUnderline(ByVal New_FontUnderline As Boolean)
Text1.FontUnderline() = New_FontUnderline
PropertyChanged "FontUnderline"
End Property

Public Property Get Alignment() As AlignmentConstants
Alignment = Text1.Alignment
End Property

Public Property Let Alignment(ByVal New_Alignment As AlignmentConstants)
Text1.Alignment() = New_Alignment
PropertyChanged "Alignment"
End Property

Public Property Get Programmed_By() As String
Programmed_By = " "
End Property

Private Sub UserControl_InitProperties()
m_Text = " "
m_CanGrow = m_def_CanGrow
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

Text1.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
Text1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
Text1.Enabled = PropBag.ReadProperty("Enabled", True)
Set Text1.Font = PropBag.ReadProperty("Font", Ambient.Font)
UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
m_Text = PropBag.ReadProperty("Text", " ")
Text1.FontBold = PropBag.ReadProperty("FontBold", False)
Text1.FontItalic = PropBag.ReadProperty("FontItalic", False)
Text1.FontName = PropBag.ReadProperty("FontName", Text1.FontName)
Text1.FontSize = PropBag.ReadProperty("FontSize", Text1.FontSize)
Text1.FontUnderline = PropBag.ReadProperty("FontUnderline", False)
Text1.Alignment = PropBag.ReadProperty("Alignment", 1)
m_Programmed_By = PropBag.ReadProperty("Programmed_By", " ")
m_LeftMargin = PropBag.ReadProperty("LeftMargin", 0)
m_TopMargin = PropBag.ReadProperty("TopMargin", 0)
m_BottomMargin = PropBag.ReadProperty("BottomMargin", 0)
m_RightMargin = PropBag.ReadProperty("RightMargin", 0)
m_CanGrow = PropBag.ReadProperty("CanGrow", m_def_CanGrow)
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
Text1.Left = LeftMargin * 15
Text1.Top = TopMargin * 15
Text1.Width = UserControl.ScaleWidth - 15 * RightMargin - Text1.Left
Text1.Height = UserControl.ScaleHeight - 15 * BottomMargin - Text1.Top
Text1.Text = GetJustText
End Sub
Private Sub UserControl_Show()
Dim Di As Integer
UserControl_Resize
Di = TextHeight("") * LineNo
If m_CanGrow And Di > Text1.Height Then
Text1.Height = Di
End If
UserControl.Height = Text1.Height + 15 * BottomMargin + Text1.Top
End Sub

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", Text1.Enabled, True)
Call PropBag.WriteProperty("Font", Text1.Font, Ambient.Font)
Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 1)
Call PropBag.WriteProperty("Text", m_Text, " ")
Call PropBag.WriteProperty("FontBold", Text1.FontBold, False)
Call PropBag.WriteProperty("FontItalic", Text1.FontItalic, False)
Call PropBag.WriteProperty("FontName", Text1.FontName, Text1.FontName)
Call PropBag.WriteProperty("FontSize", Text1.FontSize, Text1.FontSize)
Call PropBag.WriteProperty("FontUnderline", Text1.FontUnderline, False)
Call PropBag.WriteProperty("Alignment", Text1.Alignment, 1)
Call PropBag.WriteProperty("Programmed_By", " ", " ")
Call PropBag.WriteProperty("LeftMargin", m_LeftMargin, 0)
Call PropBag.WriteProperty("TopMargin", m_TopMargin, 0)
Call PropBag.WriteProperty("BottomMargin", m_BottomMargin, 0)
Call PropBag.WriteProperty("RightMargin", m_RightMargin, 0)
Call PropBag.WriteProperty("CanGrow", m_CanGrow, m_def_CanGrow)
End Sub

Public Property Get RightMargin() As Integer
RightMargin = m_RightMargin
End Property

Public Property Let RightMargin(ByVal New_RightMargin As Integer)
If New_RightMargin * 15 > UserControl.ScaleWidth / 4 Then
New_RightMargin = Int(UserControl.ScaleWidth / 60)
End If
m_RightMargin = New_RightMargin
PropertyChanged "RightMargin"
UserControl_Resize
End Property


Public Property Get LeftMargin() As Integer
LeftMargin = m_LeftMargin
End Property

Public Property Let LeftMargin(ByVal New_LeftMargin As Integer)
If New_LeftMargin * 15 > UserControl.ScaleWidth / 4 Then
New_LeftMargin = Int(UserControl.ScaleWidth / 60)
End If
m_LeftMargin = New_LeftMargin
PropertyChanged "LeftMargin"
UserControl_Resize
End Property
'

Public Property Get TopMargin() As Integer
TopMargin = m_TopMargin
End Property

Public Property Let TopMargin(ByVal New_TopMargin As Integer)
If New_TopMargin * 15 > UserControl.ScaleHeight / 4 Then
New_TopMargin = Int(UserControl.ScaleHeight / 60)
End If
m_TopMargin = New_TopMargin
PropertyChanged "TopMargin"
UserControl_Resize
End Property

Public Property Get BottomMargin() As Integer
BottomMargin = m_BottomMargin
End Property

Public Property Let BottomMargin(ByVal New_BottomMargin As Integer)
If New_BottomMargin * 15 > UserControl.ScaleHeight / 4 Then
New_BottomMargin = Int(UserControl.ScaleHeight / 60)
End If
m_BottomMargin = New_BottomMargin
PropertyChanged "BottomMargin"
UserControl_Resize
End Property

Public Function GetProperlyText()
GetProperlyText = Text1.Text
End Function

Private Function GetJustText() As String
Dim R As Integer, I As Integer, N As Integer, n1 As Integer
Dim L(100) As String, S As String, WK As Integer
LineNo = 0
N = 0
Set UserControl.Font = Text1.Font
WK = TextWidth("")
S = WithOutK(m_Text)
' ********     ********
Do
I = InStr(1, S, Chr(13))
If I > 0 Then
L(N) = Left(S, I - 1)
S = Mid(S, I + 1)
N = N + 1
Else
L(N) = S
S = ""
End If
Loop Until Trim(S) = ""
' ********       ********
For R = 0 To N
S = S + GetJustPara(L(R), Text1.Width, WK) + Chr(13)
Next
GetJustText = Left(S, Len(S) - 1)
End Function
Private Function GetJustPara(F As String, LPARA As Integer, WK As Integer) As String
Dim N As Integer, I As Integer, M As Integer, M1 As Integer, R As Integer, ALE As Byte
Dim W(1000) As String, T As String, ActAdd As Boolean, ExitDO As Boolean, OS As String
' ********     ********
OS = F
N = 0
M1 = 0
Do
I = InStr(1, F, " ")
If I > 0 Then
W(N) = Left(F, I - 1)
F = Mid(F, I + 1)
N = N + 1
Else
W(N) = F
F = ""
End If
Loop Until Trim(F) = ""
' ********      ********
M = -1
M1 = 0
T = ""
Do
M = M + 1
T = T + W(M) + " "
If TextWidth(Trim(T)) > LPARA Then
' ********    ********
If M - M1 <= 1 Then LineNo = LineNo + Abs(Int(-TextWidth(W(M)) / LPARA)): GoTo Fin
LineNo = LineNo + 1
M = M - 1
T = ""
For R = M1 To M
T = T + W(R) + " "
Next
I = M1
ActAdd = False
ExitDO = False
ALE = 1
Do Until (TextWidth(Trim(T)) > LPARA - WK) Or ExitDO
If (Len(W(I)) - Len(WithOutK(W(I))) < Len(W(I)) * ALE) And WMWidth(W(I)) Then
ActAdd = True
T = ""
For R = M1 To M
T = T + W(R) + " "
Next
End If
I = I + 1
If I > M Then
I = M1
If Not ActAdd Then
If ALE = 1 Then
ALE = 10
Else
ExitDO = True
End If
Else
ActAdd = False
End If
End If
Loop
Fin: T = ""
M1 = M + 1
End If
Loop Until M >= N
T = ""
For R = 0 To N
T = T + W(R) + " "
Next
LineNo = LineNo + 1
GetJustPara = Trim(T)
End Function

Private Function WMWidth(ByRef W As String) As Boolean
On Error Resume Next
Dim R As Integer, L As Byte, TempW As String, S1 As String, S2 As String, USP As Byte
Dim OLtr1 As String, Oltr2 As String, G As Byte
OLtr1 = ""
Oltr2 = ""
USP = 0
L = Len(W)
WMWidth = False
AW: For R = L To 2 Step -1
S1 = Mid(W, R, 1)
G = R
Do
G = G - 1
S2 = Mid(W, G, 1)
Loop Until (InStr(1, "", S2) = 0) Or (G = 1)
If InStr(1, OLtr1, S1) > 0 And InStr(1, Oltr2, S2) > 0 Then
If Not (S2 = "" And InStr(1, "", S1) > 0) Then
W = Left(W, R - 1) & "" & Mid(W, R)
WMWidth = True
R = 2
End If
End If
Next
If Not WMWidth And USP < 2 Then
If USP = 0 Then
Oltr2 = ""
Else
Oltr2 = Oltr2 + ""
End If
USP = USP + 1
GoTo AW
End If
End Function
Private Function WithOutK(T As String, Optional K As String, Optional RPL As String) As String
Dim R As Integer, S As String, L As Byte
If K = "" Then K = ""
S = T
L = Len(K)
For R = Len(S) To 1 Step -1
If Mid(S, R, 1) = K Then
S = Left(S, R - 1) & RPL & Mid(S, R + L)
End If
Next
WithOutK = S
End Function

Public Sub SpellCheck()
On Error Resume Next
Dim Word As Object, RetText$

On Error Resume Next

Set Word = CreateObject("Word.Basic")


Word.AppShow
Word.FileNew
Word.Insert m_Text

Word.ToolsSpelling
Word.EditSelectAll


m_Text = WithOutK(Word.Selection$(), vbCr, Chr(13) + Chr(10))


Word.FileClose 2
Word.AppHide
UserControl_Resize


Set Word = Nothing

End Sub

Public Property Get CanGrow() As Boolean
CanGrow = m_CanGrow
End Property

Public Property Let CanGrow(ByVal New_CanGrow As Boolean)
m_CanGrow = New_CanGrow
PropertyChanged "CanGrow"
End Property
