指定行の文字列を取得
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
複数行テキストボックスの指定行の文字列を取得する。　　　（０７７）
　　 以前　テキストボックスの総行数・現在行・現在桁の取得 を修正していて見つけたEM_GETLINE　を見つけたので試して見ました。
フォームに　テキストボックス　　　２個
　　　　　　ラベルコントロール　　２個
　　　　　　コマンドボタン　　　　３個
を貼り付けておいて下さい。

Option Explicit
'指定のウィンドウにメッセージを送る（750)
Private Declare Function SendMessage Lib "user32" _
　 Alias "SendMessageA" (ByVal hwnd As Long, _
　 ByVal wMsg As Long, ByVal wParam As Long, _
　 lParam As Any) As Long
'メモリブロックをコピーする(1008)
Private Declare Sub CopyMemory Lib "kernel32.dll" _
　 Alias "RtlMoveMemory" (Destination As Any, Source As Any, _
　 ByVal Length As Long)

'複数行テキストボックスにおいてテキストの行数を取得する（799)
Private Const EM_GETLINECOUNT = &HBA
'　　〃　　　　指定行の先頭の文字インデックスを取得する（803)
Private Const EM_LINEINDEX = &HBB
'指定の行を取得する
Private Const EM_GETLINE = &HC4
'　　〃　　　　指定の文字インデックスを含む行インデックスを取得（802)
Private Const EM_LINEFROMCHAR = &HC9
'　　〃　　　　指定した行インデックスの一つ前の行までのバイト数を取得(803)
Private Const EM_LINELENGTH = &HC1

'総行数を格納する変数
Dim lngMaxRow As Long
'指定行を格納する変数
Dim LineNo As Long

'指定行の文字列を取得するプロシージャ
Private Sub AppointRowStr()
'　 Dim strBuffer As String, BufSize As Integer, lngLen As Long
'　 BufSize = 256
'　 'バッファーの最初の2バイトに最大バイト数を設定する
'　 '第1バイトに最大バイト数の下位バイト、第2バイトに上位バイトを指定する
'　 strBuffer = Chr(BufSize And &HFF) & Chr(BufSize / &H100) & _
'　　　　　　　　　　　　　　　　　　String(BufSize - 2, vbNullChar)
'　 '半角１バイト・全角２バイト換算での取得バイト数と文字列を取得
'　 lngLen = SendMessage(Text1.hwnd, EM_GETLINE, LineNo, ByVal strBuffer)
'　 'バッファー内の取得した文字列を取り出す
'　 Label1.Caption = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)

'上記でも特に問題ないとは思うのだが、魔界の仮面弁士さんの忠告もあって
'http://hanatyan.sakura.ne.jp/vb60bbs/wforum.cgi?mode=allread&no=10299&page=0
'下記に変更しておきます。


'---------------------------------------------------------------------
　 Dim Buffer()　 As Byte　'取得する文字列のバッファー
　 Dim LineLength As Long　'1行当たりのバイト数
　 Dim LineIndex　As Long　'指定行の先頭の文字インデックス

'　同じバイト数を２度も取得するのは無駄な気もするので、下記のように予め
'　大き目のバッファーを用意して取得してもいいかとは思うのですが
'　 ReDim Buffer(1024)

　 'バッファーのサイズ用に１行当たりのバイト数を事前に取得
　 '指定行の先頭の文字インデックスを取得
　 LineIndex = SendMessage(Text1.hwnd, EM_LINEINDEX, LineNo, ByVal 0&)
　 '指定行のバイト数を求める
　 LineLength = SendMessage(Text1.hwnd, EM_LINELENGTH, LineIndex, ByVal 0&)
　 If LineLength < 1 Then
　　　Label1.Caption = ""
　　　Exit Sub　'改行のみ場合等は、処理を抜ける
　 End If
　 ReDim Buffer(LineLength - 1)
　 'バッファーの最初の2バイトに最大バイト数を設定する
　 CopyMemory Buffer(0), LineLength, 2
　 '半角１バイト・全角２バイト換算での取得バイト数と文字列を取得
　 '(ここで取得するバイト数は、上記で取得するバイト数と同じになります。)
　 LineLength = SendMessage(Text1.hwnd, EM_GETLINE, LineNo, Buffer(0))
　 'バッファーより指定バイト数分の文字を取り出し Unicode に変換
　 Label1.Caption = StrConv(LeftB$(Buffer, LineLength), vbUnicode)
End Sub

'複数行表示するテキストボックス
Private Sub Text1_Change()
　 'テキストボックスの内容が変更されたら総行数を再取得
　 lngMaxRow = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
End Sub

Private Sub Text1_Click()
'現在行を取得してその内容を表示
　 LineNo = SendMessage(Text1.hwnd, EM_LINEFROMCHAR, -1&, 0&)
　 If LineNo >= 0 And LineNo <= lngMaxRow Then
　　　'指定行の文字列取得へ
　　　Call AppointRowStr
　 End If
End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
'現在行を取得してその行の内容を表示
　 LineNo = SendMessage(Text1.hwnd, EM_LINEFROMCHAR, -1&, 0&)
　 If LineNo >= 0 And LineNo <= lngMaxRow Then
　　　'指定行の文字列取得へ
　　　Call AppointRowStr
　 End If
End Sub

'指定行を入力するテキストボックス
Private Sub Text2_GotFocus()
　 Label2.Caption = "指定行を１〜" & lngMaxRow & "の範囲で指定して下さい"
End Sub

'指定行を入力するテキストボックス
Private Sub Text2_KeyPress(KeyAscii As Integer)
　 On Error GoTo ErrorHandler
　 If KeyAscii = vbKeyReturn Then
　　　KeyAscii = 0
　　　'指定行から１行分引く
　　　LineNo = CLng(Text2.Text) - 1
　　　If LineNo >= 0 And LineNo <= lngMaxRow Then
　　　　 '指定行の文字列取得へ
　　　　 Call AppointRowStr
　　　Else
　　　　 Beep
　　　　 Text2.Text = ""
　　　End If
　 End If
　 Exit Sub
ErrorHandler:
　 Beep
　 Text2.Text = ""
End Sub



ついでにファイルの入出力関係を　　　（０７７）

'丸ごと保存のコマンドボタンに記入
Private Sub Command1_Click()
　 If Len(Text1.Text) < 1 Then
　　　MsgBox "保存するテキストがありません。"
　　　Exit Sub
　 End If

　 Dim Ret As Long
　 Ret = InStr(Text1.Text, Chr$(34))
　 If Ret = 0 Then
　　　Ret = InStr(Text1.Text, Chr$(-32408))
　 End If
　 If Ret Then
　　　Text1.SelStart = Ret - 1
　　　Text1.SelLength = 1
　　　Text1.SetFocus
　 End If
　 If Ret > 0 Then
　　　Dim strMsg As String
　　　strMsg = "文中に " & Chr$(34) & " が含まれています 保存しますか"
　　　Ret = 0
　　　Ret = MsgBox(strMsg, vbYesNo)
　　　If Ret = vbNo Then
　　　　 Exit Sub
　　　End If
　 End If

　 'テキストボックスの内容を丸ごと保存
　 '　”区切りで保存されるので文書中には　”は使用不可。
　 Dim lngFileNo As Long
　 lngFileNo = FreeFile
　 Open "..\test.txt" For Output As #lngFileNo
　 Write #lngFileNo, Text1.Text
　 Close #lngFileNo
End Sub

'行ごと読み込みのコマンドボタンに記入
Private Sub Command2_Click()
　 'Line Input で行ごとの読み込み
　 Dim Mystring As String
　 Dim lngFileNo As Long
　 lngFileNo = FreeFile
　 Text1.Text = ""
　 DoEvents
　 Open "..\test.txt" For Input As #lngFileNo
　 Do Until EOF(lngFileNo)
　　　Line Input #lngFileNo, Mystring
　　　Text1.Text = Text1.Text & Mystring & vbCrLf
　 Loop
　 Close #lngFileNo
　 Text2.SetFocus
End Sub

'丸ごと読み込みのコマンドボタンに記入
Private Sub Command3_Click()
　 'ファイル丸ごと読み込み（高速）
　 Dim Mystring As String
　 Text1.Text = ""
　 DoEvents
　 Dim lngFileNo As Long
　 lngFileNo = FreeFile
　 Open "..\test.txt" For Input As #lngFileNo
　 Input #lngFileNo, Mystring
　 Text1.Text = Mystring
　 Close #lngFileNo
　 Text2.SetFocus
End Sub
　
テキストボックスの総行数・現在行・現在桁の取得　も参考にして下さい。
複数行テキストボックスの総行数・指定行の文字列等が取得でき、テキストファイルを扱う場合便利かと思います。行ごとの文字列が簡単に扱えるので読み込み時変数等に保管する必要もなく、ファイルの保存もテキストファイルを丸ごと保存でき処理が簡単にすみます。
読み込みも丸ごと読み込みが出来３２KB位のファイルで０．２秒位で読み込み表示ができます。
行ごとに読み込みますと １４秒位かかります。但し、丸ごと読み込むため　”　は文書中には使えません。（ ” 区切りで保存のため）

尚、最初にテキストファイルを読み込むには行ごと読み込みを使って下さい。
文書中に ” があれば表示したテキストボックス中で削除し、丸ごと保存で保存して下さい。
丸ごと保存で保存したファイルだけが、丸ごと読み込みで読み込めます。
テキストファイルは適当な Readme.txt 等をコピーして使って下さい。



2007/10/03