两组可通过的代码,为什么合并后就出问题了?
代码一:四个按钮双状态代码;Private cmdflag As Byte
Private Sub Command1_Click()
If cmdflag Then
Command1.Caption = "否"
cmdflag = 0
Else
Command1.Caption = "是"
cmdflag = 1
End If
Filenum = FreeFile
Open "flag1.dat" For Output As Filenum
Print #Filenum, Format(cmdflag, 0)
Close Filenum
End Sub
Private Sub Command2_Click()
If cmdflag Then
Command2.Caption = "否"
cmdflag = 0
Else
Command2.Caption = "是"
cmdflag = 1
End If
Filenum = FreeFile
Open "flag2.dat" For Output As Filenum
Print #Filenum, Format(cmdflag, 0)
Close Filenum
End Sub
Private Sub Command3_Click()
If cmdflag Then
Command3.Caption = "否"
cmdflag = 0
Else
Command3.Caption = "是"
cmdflag = 1
End If
Filenum = FreeFile
Open "flag3.dat" For Output As Filenum
Print #Filenum, Format(cmdflag, 0)
Close Filenum
End Sub
Private Sub Command4_Click()
If cmdflag Then
Command4.Caption = "否"
cmdflag = 0
Else
Command4.Caption = "是"
cmdflag = 1
End If
Filenum = FreeFile
Open "flag4.dat" For Output As Filenum
Print #Filenum, Format(cmdflag, 0)
Close Filenum
End Sub
Private Sub Form_Load()
'***************其他次Form_Load用代码****************
Filenum = FreeFile
Open "flag1.dat" For Input As Filenum
cmdflag = Input(1, Filenum)
Close Filenum
If cmdflag Then
Command1.Caption = "是"
Else
Command1.Caption = "否"
End If
Filenum = FreeFile
Open "flag2.dat" For Input As Filenum
cmdflag = Input(1, Filenum)
Close Filenum
If cmdflag Then
Command2.Caption = "是"
Else
Command2.Caption = "否"
End If
Filenum = FreeFile
Open "flag3.dat" For Input As Filenum
cmdflag = Input(1, Filenum)
Close Filenum
If cmdflag Then
Command3.Caption = "是"
Else
Command3.Caption = "否"
End If
Filenum = FreeFile
Open "flag4.dat" For Input As Filenum
cmdflag = Input(1, Filenum)
Close Filenum
If cmdflag Then
Command4.Caption = "是"
Else
Command4.Caption = "否"
End If
End Sub
本组代码的四个flag1.dat文件内容:0或1
代码二:有十一个留言框的代码;
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, temp_e As String, temp_f As String, temp_g As String, temp_h As String, temp_i As String, temp_j As String, temp_k As String
Dim t1 As String, t2 As String, t3 As String, t4 As String, t5 As String, t6 As String, t7 As String, t8 As String, t9 As String, t10 As String, t11 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 Command30_Click()
Unload Me
End
End Sub
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
Text5.Text = t5
Text6.Text = t6
Text7.Text = t7
Text8.Text = t8
Text9.Text = t9
Text10.Text = t10
Text11.Text = t11
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 Text5_click()
tags = 5
Call myInput(tags)
End Sub
Private Sub Text6_click()
tags = 6
Call myInput(tags)
End Sub
Private Sub Text7_click()
tags = 7
Call myInput(tags)
End Sub
Private Sub Text8_click()
tags = 8
Call myInput(tags)
End Sub
Private Sub Text9_click()
tags = 9
Call myInput(tags)
End Sub
Private Sub Text10_click()
tags = 10
Call myInput(tags)
End Sub
Private Sub Text11_click()
tags = 11
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")
temp_e = GetINI(FN, "GueseBook", "No5")
temp_f = GetINI(FN, "GueseBook", "No6")
temp_g = GetINI(FN, "GueseBook", "No7")
temp_h = GetINI(FN, "GueseBook", "No8")
temp_i = GetINI(FN, "GueseBook", "No9")
temp_j = GetINI(FN, "GueseBook", "No10")
temp_k = GetINI(FN, "GueseBook", "No11")
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)
t5 = Mid(temp_e, 1, InStr(temp_e, "||") - 1)
t6 = Mid(temp_f, 1, InStr(temp_f, "||") - 1)
t7 = Mid(temp_g, 1, InStr(temp_g, "||") - 1)
t8 = Mid(temp_h, 1, InStr(temp_h, "||") - 1)
t9 = Mid(temp_i, 1, InStr(temp_i, "||") - 1)
t10 = Mid(temp_j, 1, InStr(temp_j, "||") - 1)
t11 = Mid(temp_k, 1, InStr(temp_k, "||") - 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
Case 5
WritePrivateProfileString "GueseBook", "No5", myValue & "||" & temp_a, App.Path & "\" & FN
Text5.Text = myValue
Case 6
WritePrivateProfileString "GueseBook", "No6", myValue & "||" & temp_b, App.Path & "\" & FN
Text6.Text = myValue
Case 7
WritePrivateProfileString "GueseBook", "No7", myValue & "||" & temp_c, App.Path & "\" & FN
Text7.Text = myValue
Case 8
WritePrivateProfileString "GueseBook", "No8", myValue & "||" & temp_d, App.Path & "\" & FN
Text8.Text = myValue
Case 9
WritePrivateProfileString "GueseBook", "No9", myValue & "||" & temp_a, App.Path & "\" & FN
Text9.Text = myValue
Case 10
WritePrivateProfileString "GueseBook", "No10", myValue & "||" & temp_b, App.Path & "\" & FN
Text10.Text = myValue
Case 11
WritePrivateProfileString "GueseBook", "No11", myValue & "||" & temp_c, App.Path & "\" & FN
Text11.Text = myValue
End Select
End Sub
Public Function GetINI(ByRef inifile As String, ByVal section As String, ByVal key As String, Optional ByVal defvalue As String = vbNullString) As String
'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
本组代码TXT文本:my.txt
[GueseBook]
No1=第一个留言||
No2=第二个留言||
No3=第三个留言||
No4=第四个留言||
No5=第五个留言||
No6=第六个留言||
No7=第七个留言||
No8=第八个留言||
No9=第九个留言||
No10=第十个留言||
No11=第十一个留言||
将上面二个代码合并就通不过,不知何故?请高手指正;
[ 本帖最后由 jrs123 于 2012-11-26 11:31 编辑 ]