サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.0 用 トップページ
- 日時： 2007/08/20 19:40
- 名前： GOD
- ***********************************************************************************
* カテゴリー：[文字列処理][基本コード][] *
* キーワード：文字列連結,文字をつなぐ,,,, *
***********************************************************************************
-----------------------------------------------------------------------------------
投稿者：GOD - 文字列連結用クラス(VB6.0) 2007/08/20 19:40
-----------------------------------------------------------------------------------
文字連結(&連結)は回数を重ねると非常に重くなるので作ってみました。
'--- StringEx.cls
Option Explicit
'******************************************************************************
'【概要】
' 文字列連結用クラス
'【作成】
' Ver.1.00 GOD
'【履歴】
' Ver.1.01 GOD
' ・MemAdjust() 関数
' 必要な領域値よりも多くの領域を確保していたので修正
' Ver.1.02 GOD
' ・AddForward() 関数
' "" の連結回避
' ・AddRear() 関数
' "" の連結回避
'******************************************************************************
'文字列の増加値
Private Const ADDNUM As Long = 1024
'管理文字列
Private mStr As String
'管理中の文字列の長さ
Private mlngCnt As Long
'領域内の位置
Private mlngForwardPos As Long
'文字列領域のサイズ
Private mlngForwardCntMax As Long
'領域内の位置
Private mlngRearPos As Long
'文字列領域のサイズ
Private mlngRearCntMax As Long
'------------------------------------------------------------------------------
' インスタンス処理
'------------------------------------------------------------------------------
'******************************************************************************
'【概要】
' 変数の初期化を行う
'【引数】
' なし
'【返値】
' なし
'【作成】
' Ver.1.00 GOD
'【履歴】
'******************************************************************************
Private Sub Class_Initialize()
Call Init
End Sub
'------------------------------------------------------------------------------
' プロパティ
'------------------------------------------------------------------------------
'******************************************************************************
'【概要】
' 文字列を取得/設定する
'【引数】
' Value ：文字列
'【返値】
' 文字列
'【作成】
' Ver.1.00 GOD
'【履歴】
'******************************************************************************
Public Property Get Text() As String
Text = Mid$(mStr, mlngForwardPos, mlngCnt)
End Property
Public Property Let Text(Value As String)
Call Init
Call AddRear(Value)
End Property
'------------------------------------------------------------------------------
' メソッド
'------------------------------------------------------------------------------
'******************************************************************************
'【概要】
' 文字列を連結する
'【引数】
' FStr ：前方に連結する文字列
' RStr ：後方に連結する文字列
'【返値】
' なし
'【作成】
' Ver.1.00 GOD
'【履歴】
'******************************************************************************
Public Sub AddString(Optional FStr As String, _
Optional RStr As String)
If FStr <> "" Then
Call AddForward(FStr)
End If
If RStr <> "" Then
Call AddRear(RStr)
End If
End Sub
'******************************************************************************
'【概要】
' 前方に文字列を連結する
'【引数】
' AddStr ：連結文字列
'【返値】
' なし
'【作成】
' Ver.1.00 GOD
'【履歴】
' Ver.1.02 GOD
' "" に対応
'******************************************************************************
Public Sub AddForward(AddStr As String)
Dim lngSize As Long
lngSize = Len(AddStr)
'↓ Ver.1.02 GOD ---"" の連結回避
' Call MemAdjust(lngSize, True)
' Mid(mStr, mlngForwardPos - lngSize, lngSize) = AddStr
' mlngForwardPos = mlngForwardPos - lngSize
' mlngCnt = mlngCnt + lngSize
If lngSize > 0 Then
Call MemAdjust(lngSize, True)
Mid(mStr, mlngForwardPos - lngSize, lngSize) = AddStr
mlngForwardPos = mlngForwardPos - lngSize
mlngCnt = mlngCnt + lngSize
End If
'↑ Ver.1.02 GOD ---"" の連結回避
End Sub
'******************************************************************************
'【概要】
' 後方に文字列を連結する
'【引数】
' AddStr ：連結文字列
'【返値】
' なし
'【作成】
' Ver.1.00 GOD
'【履歴】
' Ver.1.02 GOD
' "" に対応
'******************************************************************************
Public Sub AddRear(AddStr As String)
Dim lngSize As Long
lngSize = Len(AddStr)
'↓ Ver.1.02 GOD ---"" の連結回避
' Call MemAdjust(lngSize, False)
' Mid(mStr, mlngRearPos, lngSize) = AddStr
' mlngRearPos = mlngRearPos + lngSize
' mlngCnt = mlngCnt + lngSize
If lngSize > 0 Then
Call MemAdjust(lngSize, False)
Mid(mStr, mlngRearPos, lngSize) = AddStr
mlngRearPos = mlngRearPos + lngSize
mlngCnt = mlngCnt + lngSize
End If
'↑ Ver.1.02 GOD ---"" の連結回避
End Sub
'******************************************************************************
'【概要】
' 文字列の長さを取得する
'【引数】
' なし
'【返値】
' 文字列の長さ
'【作成】
' Ver.1.00 GOD
'【履歴】
'******************************************************************************
Public Function GetStrlen() As Long
GetStrlen = mlngCnt
End Function
'------------------------------------------------------------------------------
' 未公開メソッド
'------------------------------------------------------------------------------
'******************************************************************************
'【概要】
' 変数の初期化を行う
'【引数】
' なし
'【返値】
' なし
'【作成】
' Ver.1.00 GOD
'【履歴】
'******************************************************************************
Private Sub Init()
mStr = ""
mlngCnt = 0
mlngForwardPos = 1
mlngForwardCntMax = 0
mlngRearPos = 1
mlngRearCntMax = 0
End Sub
'******************************************************************************
'【概要】
' 領域の調整を行う
'【引数】
' Size ：追加サイズ
' Forward ：追加位置(True-前, False-後)
'【返値】
' なし
'【作成】
' Ver.1.00 GOD
'【履歴】
' Ver.1.01 GOD
' 必要な領域値よりも多くの領域を確保していたので修正
'******************************************************************************
Private Function MemAdjust(Size As Long, _
Optional Forward As Boolean = True) As Long
Dim lngNextSize As Long
Dim lngAddSize As Long
'↓ Ver.1.01 GOD ---必要な領域値の計算方法を変更
' lngNextSize = mlngCnt + Size
' If Forward Then
' If lngNextSize >= mlngForwardCntMax Then
' lngAddSize = ((lngNextSize) - mlngForwardCntMax) + _
' (ADDNUM - (lngNextSize Mod ADDNUM))
' mStr = String$(lngAddSize, vbNullChar) & mStr
' mlngForwardCntMax = mlngForwardCntMax + lngAddSize
' mlngForwardPos = mlngForwardPos + lngAddSize
' mlngRearPos = mlngRearPos + lngAddSize
' End If
' Else
' If lngNextSize >= mlngRearCntMax Then
' lngAddSize = ((lngNextSize) - mlngRearCntMax) + _
' (ADDNUM - (lngNextSize Mod ADDNUM))
' mStr = mStr & String$(lngAddSize, vbNullChar)
' mlngRearCntMax = mlngRearCntMax + lngAddSize
' End If
' End If
If Forward Then
lngNextSize = mlngCnt - ((mlngRearPos - 1) - mlngForwardCntMax) + Size
If lngNextSize > mlngForwardCntMax Then
lngAddSize = (lngNextSize - mlngForwardCntMax) + _
(ADDNUM - (lngNextSize Mod ADDNUM))
mStr = String$(lngAddSize, vbNullChar) & mStr
mlngForwardCntMax = mlngForwardCntMax + lngAddSize
mlngForwardPos = mlngForwardPos + lngAddSize
mlngRearPos = mlngRearPos + lngAddSize
End If
Else
lngNextSize = (mlngRearPos + Size - 1) - mlngForwardCntMax
If lngNextSize > mlngRearCntMax Then
lngAddSize = (lngNextSize - mlngRearCntMax) + _
(ADDNUM - (lngNextSize Mod ADDNUM))
mStr = mStr & String$(lngAddSize, vbNullChar)
mlngRearCntMax = mlngRearCntMax + lngAddSize
End If
End If
'↑ Ver.1.01 GOD --- 必要な領域値の計算方法を変更
End Function
'--- Form1.frm(速度比較用)
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Sub Command1_Click()
Dim lngCount As Long
Dim lngSTime As Long
Command1.Enabled = False
lngSTime = timeGetTime
Dim strTest As New StringEx
For lngCount = 0 To 20000
' Call strTest.AddForward(Chr(&H41 + lngCount Mod 26))
' Call strTest.AddRear(Chr(&H41 + lngCount Mod 26))
Call strTest.AddString(Chr(&H41 + lngCount Mod 26), _
Chr(&H41 + lngCount Mod 26))
Next
' Debug.Print strTest.Text
Debug.Print timeGetTime - lngSTime & "ms"
Command1.Enabled = True
End Sub
Private Sub Command2_Click()
Dim strTest As String
Dim lngCount As Long
Dim lngSTime As Long
Command2.Enabled = False
lngSTime = timeGetTime
For lngCount = 0 To 20000
strTest = (Chr(&H41 + lngCount Mod 26)) & strTest & _
(Chr(&H41 + lngCount Mod 26))
Next
' Debug.Print strTest
Debug.Print timeGetTime - lngSTime & "ms"
Command2.Enabled = True
End Sub
*** 2007/08/20 19:39 修正
Text プロパティに "" の代入を考慮して修正。
 |
