GFGetLineArrayThroughLineWidth/Mfrm.frm
VERSION 5.00
Begin VB.Form Mfrm
Caption = "Mfrm"
ClientHeight = 3185
ClientLeft = 65
ClientTop = 351
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3185
ScaleWidth = 4680
StartUpPosition = 3 'Windows‑Standard
Begin VB.CommandButton Command1
Caption = "Test"
Height = 315
Left = 3660
TabIndex = 2
Top = 2400
Width = 915
End
Begin VB.TextBox Text1
Height = 2655
Left = 60
MultiLine = ‑1 'True
TabIndex = 1
Text = "Mfrm.frx":0000
Top = 60
Width = 3495
End
Begin VB.PictureBox Picture1
Height = 315
Left = 60
ScaleHeight = 260
ScaleWidth = 143
TabIndex = 0
Top = 2820
Width = 195
End
End
Attribute VB_Name = "Mfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis.
'
'NOTE: this project contains two general functions:
'‑GFGetLineArrayThroughLineWidth() and
'‑GFGetLineArray()
'
'The difference between the two functions is that the first one
'verifies the returned lines are never longer than the desired
'line length, the second function breaks lines at the passed
'border char only.
'
Private Sub Form_Load()
'on error resume next
Dim Temp As Long
Mfrm.AutoRedraw = True
For Temp = (Picture1.Left + 2 * Screen.TwipsPerPixelX) To (Picture1.Left + 2 * Screen.TwipsPerPixelX + 100 * Screen.TwipsPerPixelX) Step 10 * Screen.TwipsPerPixelX
'markings every 10 pixels
Mfrm.Line (Temp, 0)‑(Temp, 5 * Screen.TwipsPerPixelY), 0
Next Temp
End Sub
Private Sub Command1_Click()
'on error resume next
Dim LineNumber As Integer
Dim LineArray() As String
Dim Temp As Long
'begin
Picture1.Font.Name = Text1.Font.Name
Picture1.Font.Size = Text1.Font.Size
Debug.Print GFGetLineArray(Text1.Text, 100 * Screen.TwipsPerPixelX, " ", LineArray(), LineNumber, Picture1)
For Temp = 1 To LineNumber
Debug.Print LineArray(Temp)
Next Temp
End Sub
Private Function GFGetLineArrayThroughLineWidth(ByVal InputString As String, ByVal LineWidthMax As Long, ByVal LineWidthOverflowMax As Long, ByVal LineBorderChar As String, ByRef LineArray() As String, ByRef LineNumber As Integer, ByRef LineWidthPicture As PictureBox) As Boolean
'on error resume next 'format: twips; use as general function to create a text block with defined width, words are broken if too long; function returns True for success or False for error
Dim Temp As Long
'
'NOTE: this function may contains bugs.
'
'preset
LineNumber = 0
ReDim LineArray(1 To 1) As String
'verify
If Not (Len(LineBorderChar) = 1) Then
GoTo Error:
End If
If InputString = "" Then
GFGetLineArrayThroughLineWidth = True 'ok
Exit Function
End If
'begin
Temp = 0 'reset
Do
Temp = Temp + 1
If Mid$(InputString, Temp, 2) = Chr$(13) + Chr$(10) Then
If Not (LineNumber = 32767) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ Temp ‑ 1)
Temp = 0 'reset
Else
If Mid$(InputString, Temp, 1) = LineBorderChar Then
Select Case LineWidthPicture.TextWidth(Left$(InputString, Temp ‑ 1))
Case Is < LineWidthMax
'do nothing
Case Is >= LineWidthMax
If Not (LineNumber = 32767) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ Temp + 0)
Temp = 0 'reset
End Select
Else
Select Case LineWidthPicture.TextWidth(Left$(InputString, Temp ‑ 1))
Case Is < LineWidthMax
'do nothing
Case Is >= (LineWidthMax + LineWidthOverflowMax)
If Not (LineNumber = 32767) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ Temp + 1)
Temp = 0 'reset
End Select
End If
End If
If Temp = Len(InputString) Then
If Not (LineNumber = 32767) Then 'verify
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = InputString
Exit Do 'finished
End If
Loop
GFGetLineArrayThroughLineWidth = True 'ok
Exit Function
Error:
GFGetLineArrayThroughLineWidth = False 'error
Exit Function
End Function
Private Function GFGetLineArray(ByVal InputString As String, ByVal LineWidthMax As Long, ByVal LineBorderChar As String, ByRef LineArray() As String, ByRef LineNumber As Integer, ByRef LineWidthPicture As PictureBox) As Boolean
'on error resume next 'breaks lines like a Command button (string is only broken at border chars), a word may not be completely visible; InputString must not contain Chr$(13) or Chr$(10)
Dim LineBorderCharPos As Long 'position of last line border char
Dim Temp As Long
'
'NOTE: this function may contains bugs.
'
'reset
LineNumber = 0 'reset
ReDim LineArray(1 To 1) As String 'reset
'preset
InputString = InputString + LineBorderChar 'add end sign (will be cut automatically)
'begin
Do
Temp = Temp + 1
If Mid$(InputString, Temp, 1) = LineBorderChar Then 'check for border char
If (LineWidthPicture.TextWidth(Left$(InputString, Temp)) > LineWidthMax) Then
If Not (LineNumber = 32767) Then
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
If LineBorderCharPos = 0 Then 'happens if a word is too large for one line
LineArray(LineNumber) = Left$(InputString, Temp ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ Temp)
Else
LineArray(LineNumber) = Left$(InputString, LineBorderCharPos ‑ 1)
InputString = Right$(InputString, Len(InputString) ‑ LineBorderCharPos)
End If
Temp = 0 'reset
End If
If Len(InputString) = 0 Then
Exit Do 'finished
Else
If Temp = Len(InputString) Then
If Not (LineNumber = 32767) Then
LineNumber = LineNumber + 1
Else
GoTo Error:
End If
ReDim Preserve LineArray(1 To LineNumber) As String
LineArray(LineNumber) = Left$(InputString, Len(InputString) ‑ 1) 'cut end sign
Exit Do 'finished
End If
End If
LineBorderCharPos = Temp
End If
Loop
GFGetLineArray = True 'ok
Exit Function
Error:
GFGetLineArray = False 'error
Exit Function
End Function
[END OF FILE]