请问文本框内容如何再显 - 编程论坛

#2

Artless2012-11-14 12:20

在留言文本框的窗口_load里读my.txt内容到留言文本框

#3

jrs1232012-11-15 10:42

采用下面代码仍无法实现软件再启动后TEXT1框中出现的TXT文件内容（见图）；
请问高手如何改？
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
Dim n%, a
Open "\my.txt" For Binary As Text1
a = StrConv(InputB(LOF(1), 1), vbUnicode)
Close Text1
b = Split(a, vbCrLf)
n = Val(InputBox("你想读取第几行?"))
If n < 0 Or n > UBound(b) + 1 Then
MsgBox "行数有问题!!"
Exit Sub
End If
Print b(n - 1)
End Sub[attach]66310[/attach]
End Sub
[attach]66311[/attach][attach]66312[/attach]

只有本站会员才能查看附件，请登录

[ 本帖最后由 jrs123 于 2012-11-15 10:48 编辑 ]

#4

Artless2012-11-15 12:45

以下是引用Artless在2012-11-14 12:20:49的发言：

在留言文本框的窗口_load里读my.txt内容到留言文本框

#5

jrs1232012-11-15 15:32

以下是引用Artless在2012-11-15 12:45:07的发言：

请问版主，具体代码如何写？
这个可以吗？
Open App.Path & "\my.txt" For Output As #1

#6

jrs1232012-11-15 16:09

百度里能查到很多关于VB6读TXT文本的内容，但没找到一个能用的代码，不知在这里能否找到

#7

ccwu22012-11-15 18:32

在留言文本框的窗口_load里读my.txt内容到留言文本框

程序代码：

Option Explicit

Dim FN As String
Private Sub Command1_Click()
    If Text1.Text <> "" Then
        Call outputData
        Text1.Text = ""
    End If
End Sub

Private Sub outputData()
Dim FileNum As Integer
    FileNum = FreeFile
    Open FN For Append As #FileNum
        Print #FileNum, Text1.Text
    Close #FileNum
End Sub

Private Function IsFileExist(strFileName As String) As Boolean
Dim varFSO As Variant
    Set varFSO = CreateObject("Scripting.FileSystemObject")
    IsFileExist = varFSO.FileExists(strFileName)
    Set varFSO = Nothing
End Function

Private Sub Form_Initialize()
    FN = App.Path & "\my.txt"
End Sub

Private Sub Form_Load()
    If IsFileExist(FN) = True Then
        Call LoadData
    End If
End Sub

Private Sub LoadData()
Dim FileNum As Integer
Dim Temp As String
    FileNum = FreeFile
    Open FN For Input As #FileNum
        Do While Not EOF(FileNum)
            Line Input #FileNum, Temp
            If Temp <> "" Then Text1.Text = Temp
        Loop
    Close #FileNum
End Sub

#8

jrs1232012-11-15 18:56

回复 7楼 ccwu2

谢谢这位高手，可以了！

#9

jrs1232012-11-15 20:05

回复 7楼 ccwu2

如页面上有四个留言栏，本人就做了如下复制，虽输入了四次内容，但只显示最后一个框的留言；（见图）
因为本人不会编程只会代码的DIY，所以不知错在何处？还请你指正；
[attach]66321[/attach][attach]66322[/attach]
Option Explicit 'ccwu2显示留言内容——1

Dim FN As String
Private Sub Command1_Click() 'ccwu2显示留言内容——2
    If Text1.Text <> "" Then
        Call outputData
        Text1.Text = ""
    End If
    If Text2.Text <> "" Then
        Call outputData
        Text2.Text = ""
    End If
    If Text3.Text <> "" Then
        Call outputData
        Text3.Text = ""
    End If
    If Text4.Text <> "" Then
        Call outputData
        Text4.Text = ""
    End If
End Sub

Private Sub outputData() 'ccwu2显示留言内容——3
Dim FileNum As Integer
    FileNum = FreeFile
    Open FN For Append As #FileNum
        Print #FileNum, Text1.Text
    Close #FileNum

    FileNum = FreeFile
    Open FN For Append As #FileNum
        Print #FileNum, Text2.Text
    Close #FileNum

    FileNum = FreeFile
    Open FN For Append As #FileNum
        Print #FileNum, Text3.Text
    Close #FileNum

    FileNum = FreeFile
    Open FN For Append As #FileNum
        Print #FileNum, Text4.Text
    Close #FileNum
End Sub

Private Function IsFileExist(strFileName As String) As Boolean 'ccwu2显示留言内容——3
Dim varFSO As Variant
    Set varFSO = CreateObject("Scripting.FileSystemObject")
    IsFileExist = varFSO.FileExists(strFileName)
    Set varFSO = Nothing
End Function

Private Sub Form_Initialize() 'ccwu2显示留言内容——4
    FN = App.Path & "\my1.txt"
    FN = App.Path & "\my2.txt"
    FN = App.Path & "\my3.txt"
    FN = App.Path & "\my4.txt"
End Sub

Private Sub Form_Load() 'ccwu2显示留言内容——5
    If IsFileExist(FN) = True Then
        Call LoadData
    End If
End Sub

Private Sub LoadData() 'ccwu2显示留言内容——6
Dim FileNum As Integer
Dim Temp As String
    FileNum = FreeFile
    Open FN For Input As #FileNum
        Do While Not EOF(FileNum)
            Line Input #FileNum, Temp
            If Temp <> "" Then Text1.Text = Temp
        Loop
Close #FileNum

    FileNum = FreeFile
    Open FN For Input As #FileNum
        Do While Not EOF(FileNum)
            Line Input #FileNum, Temp
            If Temp <> "" Then Text2.Text = Temp
        Loop
Close #FileNum

    FileNum = FreeFile
    Open FN For Input As #FileNum
        Do While Not EOF(FileNum)
            Line Input #FileNum, Temp
            If Temp <> "" Then Text3.Text = Temp
        Loop
Close #FileNum

    FileNum = FreeFile
    Open FN For Input As #FileNum
        Do While Not EOF(FileNum)
            Line Input #FileNum, Temp
            If Temp <> "" Then Text4.Text = Temp
        Loop
Close #FileNum
End Sub

只有本站会员才能查看附件，请登录

[ 本帖最后由 jrs123 于 2012-11-15 20:07 编辑 ]

#10

yz10252012-11-15 20:28

这样写4次也太......

#11

yz10252012-11-15 21:14

写到Ñ次都是显是前4笔...

程序代码：

Option Explicit

Dim FN As String

Private Sub Command1_Click()
    If Text5.Text <> "" Then
        Call outputData
        Text5.Text = ""
    End If
End Sub

Private Sub outputData()
Dim FileNum As Integer
    FileNum = FreeFile
    Open FN For Append As #FileNum
        Print #FileNum, Text5.Text
    Close #FileNum
End Sub

Private Function IsFileExist(strFileName As String) As Boolean
Dim varFSO As Variant
    Set varFSO = CreateObject("Scripting.FileSystemObject")
    IsFileExist = varFSO.FileExists(strFileName)
    Set varFSO = Nothing
End Function

Private Sub Form_Initialize()
    FN = App.Path & "\my.txt"
End Sub

Private Sub Form_Load()
    If IsFileExist(FN) = True Then
        Call LoadData
    End If
    Frame1.Enabled = False
End Sub

Private Sub LoadData()
Dim FileNum As Integer, i As Integer
Dim Temp As String
    FileNum = FreeFile
    Open FN For Input As #FileNum
        Do While Not EOF(FileNum)
            Line Input #FileNum, Temp
            If Temp <> "" Then
                List1.AddItem Temp, i
                i = i + 1
            End If
        Loop
    Close #FileNum
    For i = 0 To 3
        If i = 0 Then
            Text1.Text = "First:" & List1.List(i)
        End If
        If i = 1 Then
            Text2.Text = "Second:" & List1.List(i)
        End If
        If i = 2 Then
            Text3.Text = "Third:" & List1.List(i)
        End If
        If i = 3 Then
            Text4.Text = "Fourth:" & List1.List(i)
        End If
    Next i
End Sub

#12

jrs1232012-11-15 21:56

回复 11楼 yz1025

谢谢你的代码，简练了很多，请问TXET5何用？没通过，点击框不会弹出输入框
输入框的代码：
Private Sub text1_click()
Dim message, title, defaultValue As String
Dim myValue As String
message = "请输入你的留言" '设置提示信息
title = "InputBox Demo" '设置标题
defaultValue = "" '设置默认值
myValue = InputBox(message, title, defaultValue, 100, 100)
'显示输入对话框
If myValue = "" Then
MsgBox "没有输入任何内容！", vbInformation + vbOKOnly, "提示"
Else
Text1.Text = myValue
End If
Open App.Path & "\my.txt" For Output As #1
Print #1, Text1.Text
Close #1
End Sub

Private Sub Text2_click()
Dim message, title, defaultValue As String
Dim myValue As String
message = "请输入你的留言" '设置提示信息
title = "InputBox Demo" '设置标题
defaultValue = "" '设置默认值
myValue = InputBox(message, title, defaultValue, 100, 100)
'显示输入对话框
If myValue = "" Then
MsgBox "没有输入任何内容！", vbInformation + vbOKOnly, "提示"
Else
Text2.Text = myValue
End If
Open App.Path & "\my.txt" For Output As #2
Print #2, Text.Text
Close #2
End Sub

Private Sub Text3_click()
Dim message, title, defaultValue As String
Dim myValue As String
message = "请输入你的留言" '设置提示信息
title = "InputBox Demo" '设置标题
defaultValue = "" '设置默认值
myValue = InputBox(message, title, defaultValue, 100, 100)
'显示输入对话框
If myValue = "" Then
MsgBox "没有输入任何内容！", vbInformation + vbOKOnly, "提示"
Else
Text3.Text = myValue
End If
Open App.Path & "\my.txt" For Output As #3
Print #3, Text3.Text
Close #3
End Sub

Private Sub Text4_click()
Dim message, title, defaultValue As String
Dim myValue As String
message = "请输入你的留言" '设置提示信息
title = "InputBox Demo" '设置标题
defaultValue = "" '设置默认值
myValue = InputBox(message, title, defaultValue, 100, 100)
'显示输入对话框
If myValue = "" Then
MsgBox "没有输入任何内容！", vbInformation + vbOKOnly, "提示"
Else
Text4.Text = myValue
End If
Open App.Path & "\my.txt" For Output As #4
Print #4, Text4.Text
Close #4
End Sub

[ 本帖最后由 jrs123 于 2012-11-15 21:58 编辑 ]

#13

jrs1232012-11-16 08:21

主要是这一段出问题，总是显示最后一行的数据；
Private Sub Form_Initialize() 'ccwu2显示留言内容——4
    FN = App.Path & "\my1.txt"
    FN = App.Path & "\my2.txt"
    FN = App.Path & "\my3.txt"
    FN = App.Path & "\my4.txt" ‘显示最后一行
End Sub
请问同时显示四行内容应该如何改？

#14

bczgvip2012-11-17 08:58

用INI不方便过么？

#15

jrs1232012-11-22 16:18

回复 11楼 yz1025

谢谢你的代码，不知为何未通过？
提示：变量未定义，请问应如何定义？

只有本站会员才能查看附件，请登录

#16

jrs1232012-11-22 22:48

这是原码打包：

只有本站会员才能查看附件，请登录

#17

ccwu22012-11-23 10:10

拉5个TextBox加一个ListBox
Text5:留言
Text1:显示
Text2:显示
Text3:显示
Text4:显示
List1:自动排序用(以防你以后又说要改成特定显示哪几行)
my.txt:储存读取资料用

#18

jrs1232012-11-23 11:52

回复 16楼 jrs123

一个可以通过的方案：谢谢这一高手的代码：
Option Explicit '快手改——1

Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal _
lpFileName As String) As Long

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal _
lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName _
As String) As Long

Dim tags As Integer
Dim FN As String
Dim temp_a As String, temp_b As String, temp_c As String, temp_d As String
Dim t1 As String, t2 As String, t3 As String, t4 As String

Private Function IsFileExist(strFileName As String) As Boolean '快手改——2
    Dim varFSO As Variant
    Set varFSO = CreateObject("Scripting.FileSystemObject")
    IsFileExist = varFSO.FileExists(strFileName)
    Set varFSO = Nothing
End Function

Private Sub Form_Initialize() '快手改——3
  FN = "my.txt"
End Sub

Private Sub Form_Load() '快手改——4
    If IsFileExist(FN) = True Then
        Call ReadData
    End If
    Text1.Text = t1
    Text2.Text = t2
    Text3.Text = t3
    Text4.Text = t4
End Sub

Private Sub text1_click() '快手改——5
  tags = 1
  Call myInput(tags)
End Sub

Private Sub Text2_click() '快手改——6
  tags = 2
  Call myInput(tags)
End Sub

Private Sub Text3_click() '快手改——7
  tags = 3
  Call myInput(tags)
End Sub

Private Sub Text4_click() '快手改——8
   tags = 4
   Call myInput(tags)
End Sub

'如下接收输入函数
Private Sub myInput(tags As Integer) '快手改——9

'获取输入
Dim message, title, defaultValue As String
Dim myValue As String
message = "请输入你的留言" '设置提示信息
title = "InputBox Demo" '设置标题
defaultValue = "" '设置默认值
myValue = InputBox(message, title, defaultValue, 100, 100)
'显示输入对话框

'判断并处理（保存）输入

If myValue = "" Then
   MsgBox "没有输入任何内容！", vbInformation + vbOKOnly, "提示"
Else
   '保存输入，留言间用特殊标示“||”隔开，不用逗号是因为留言中可能包含逗号，故尽可能避免分拆时错误

   '读出原始内容
   Call ReadData

   '合并保存并显示
   Call WriteData(tags, myValue)

End If

End Sub

'如下读取数据函数
Private Sub ReadData() '快手改——10

  temp_a = GetINI(FN, "GueseBook", "No1")
  temp_b = GetINI(FN, "GueseBook", "No2")
  temp_c = GetINI(FN, "GueseBook", "No3")
  temp_d = GetINI(FN, "GueseBook", "No4")
  t1 = Mid(temp_a, 1, InStr(temp_a, "||") - 1)
  t2 = Mid(temp_b, 1, InStr(temp_b, "||") - 1)
  t3 = Mid(temp_c, 1, InStr(temp_c, "||") - 1)
  t4 = Mid(temp_d, 1, InStr(temp_d, "||") - 1)

End Sub

'如下保存数据函数
Private Sub WriteData(tags As Integer, myValue As String) '快手改——11

   Call ReadData
   Select Case tags
      Case 1
         WritePrivateProfileString "GueseBook", "No1", myValue & "||" & temp_a, App.Path & "\" & FN
         Text1.Text = myValue
      Case 2
         WritePrivateProfileString "GueseBook", "No2", myValue & "||" & temp_b, App.Path & "\" & FN
         Text2.Text = myValue
      Case 3
         WritePrivateProfileString "GueseBook", "No3", myValue & "||" & temp_c, App.Path & "\" & FN
         Text3.Text = myValue
      Case 4
         WritePrivateProfileString "GueseBook", "No4", myValue & "||" & temp_d, App.Path & "\" & FN
         Text4.Text = myValue
   End Select

End Sub

'如下INI文件读取函数
Public Function GetINI(ByRef inifile As String, ByVal section As String, ByVal key As String, Optional ByVal defvalue As String = vbNullString) As String '快手改——12
  'inifile INI文件名， section 段落，key 关键字，defvalue 值
  Dim thisQU1 As String
  Dim QU1 As Long
  thisQU1 = Space$(256) '事先定义读取的字串宽度
  QU1 = GetPrivateProfileString(section, key, defvalue, thisQU1, 255, App.Path & "\" & inifile)
  GetINI = Left$(thisQU1, Len(Trim$(thisQU1)) - 1)         '名称
End Function

#19

jrs1232012-11-23 11:54

回复 17楼 ccwu2

请高手测试通过改后发包可以吗？