UserName(7)=Format(Val(txtUserName(5))+Val(txtUserName(6)),"####0.00")
dcNum.Text=rst.Fields(1)
EndIf
rst.Close
Setrst=Nothing
EndSub
PrivateSubdcvalue_KeyPress(KeyAsciiAsInteger)
KeyAscii=0
EndSub
PrivateSubdel_Click()
frmdel.Show
EndSub
PrivateSubdhcb_Click()
usrcopyP.Show
EndSub
PrivateSubdhcp_Click()
frmCopyP.Show
EndSub
PrivateSubduohu_Click()
frmCuifei.muser1=2
frmCuifei.Show
EndSub
PrivateSubedit_Click()
frmEdit.Show
EndSub
PrivateSubexit_Click()
End
EndSub
PrivateSubinsert_Click()
frmInsert.Show1
EndSub
PrivateSubjiaonadianfei_Click()
frmFee.Show
EndSub
PrivateSubM_USERYTPE_Click()
FRMUSERTYPE.Show1
EndSub
PrivateSubMDIForm_Load()
loadAdd
EndSub
PublicSubloadAdd()
Ifrst.State=1Then
rst.Close
EndIf
rst.Open"select*frompanelinfowheredelflag<>true",gCnn,adOpenKeyset,adLockBatchOptimistic
Ifrst.RecordCount<>0Then
Setdcvalue.RowSource=rst
dcvalue.BoundColumn="holderID"
dcvalue.ListField="holder"
SetdcNum.DataSource=rst
SetdcNum.RowSource=rst
dcNum.ListField="holderid"
IfNotrst.EOFThen
dcNum.Text=rst.Fields!holderid
dcvalue.Text=rst.Fields(2)
txtUserName(0)=rst.Fields(1)
txtUserName(1)=rst.Fields!nowecount
txtUserName(2)=rst.Fields!cendcode
dtpwdate.Value=rst.Fields(4)
txtUserName(3)=Format(rst.Fields!lMoney,"##0.00")
txtUserName(4)=Format(rst.Fields!bmoney,"###.0.00")
txtUserName(6)=rst.Fields!lsFee
txtUserName(5)=Val(txtUserName(1))*Val(txtUserName(3))*(Val(rst.Fields!lightScale)/100)+Val(txtUserName(1))*Val(txtUserName(4))*(1-rst.Fields!lightScale/100)
txtUserName(8)=rst.Fields(9)
txtUserName(7)=Val(txtUserName(5))+Val(txtUserName(6))
rst.Fields!cFeeMoney=txtUserName(7)
rst.UpdateBatchadAffectCurrent
EndIf
EndIf
EndSub
PublicSubloadData(HidAsString)
DimrstAsNewADODB.Recordset
DimcnnAsNewADODB.Connection
DimAtimesAsInteger
DimsqlAddAsString
cnn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;JetOLEDB:databasepassword="&DbPassword&";DataSource="&_
App.Path&"\data\dbdb.mdb;PersistSecurityInfo=False"
cnn.CursorLocation=adUseClient
cnn.Open
IfTrim(Hid)<>""Then
rst.Open"select*frompanelinfowhereholderid='"&Hid&"'anddelflag<>true",cnn,adOpenStatic,adLockBatchOptimistic
Else
rst.Open"select*frompanelinfowheredelflag<>true",cnn,adOpenStatic,adLockBatchOptimistic
EndIf
IfNotrst.EOFThen
dcNum.Text=rst.Fields!holderid
dcvalue.Text=rst.Fields(2)
txtUserName(0)=rst.Fields(1)
txtUserName(1)=rst.Fields!nowecount
txtUserName(2)=rst.Fields!cendcode
dtpwdate.Value=rst.Fields(4)
txtUserName(3)=Format(rst.Fields!lMoney,"####0.00")
txtUserName(4)=Format(rst.Fields!bmoney,"####0.00")
txtUserName(6)=Format(rst.Fields!lsFee,"####0.00")
'txtUserName(5)=Format(txtUserName(1)*txtUserName(3)*(rst.Fields!lightScale/100)+txtUserName(1)*txtUserName(4)*(1-rst.Fields!lightScale/100),"####0.00")
Ifrst.Fields!Atimes=0Then
Atimes=1
Else
Atimes=rst.Fields!Atimes
EndIf
txtUserName(5)=Format(Val(txtUserName(1))*txtUserName(3)*Atimes,"####0.00")
txtUserName(8)=rst.Fields(9)
txtUserName(7)=Format(Val(txtUserName(5))+Val(txtUserName(6)),"####0.00")
rst.Fields!cFeeMoney=txtUserName(7)
rst.UpdateBatchadAffectCurrent
EndIf
rst.Close
cnn.Close
EndSub
PrivateSubMDIForm_Unload(CancelAsInteger)
gCnn.Close
Setgcon=Nothing
EndSub
PrivateSubmgcf_Click()
frmFeefind.Show
EndSub
PrivateSubmhf_Click()
frmdaoru.Show
EndSub
PrivateSubmsf_Click()
frmFind1.Show
EndSub
PrivateSubqianfeilm_Click()
frmList.qfFlg=True
frmList.Show
EndSub
PrivateSubToolbar1_Butt(ByValButtonAsMSComctlLib.Button)
SelectCaseTrim(Button.Key)
Case"a"
frmFee.Show1
Case"b"
frmCopyP.Show
Case"c"
frmFee.Show1
Case"d"
frmbeifen.Show1
Case"e"
frmdaoru.Show1
Case"f"
frmFeefind.Show1
Case"g"
frmFind1.Show1
Case"dhcb1"
Case"dbcb2"
Case"j"
X=MsgBox("真的要退出吗?",vbYesNo+vbQuestion,"警告")
IfX=vbYesThen
End
Else
EndIf
EndSelect
EndSub
PrivateSubToolbar1_ButtonMenuClick(ByValButtonMenuAsMSComctlLib.ButtonMenu)
SelectCaseButtonMenu.Key
Case"dhcb1"
frmCopyP.Show
Case"dhcb2"
usrcopyP.Show
EndSelect
EndSub
PrivateSubweihu_Click()
FRMYHSD.Show
EndSub
PrivateSubyihu_Click()
frmCuifei.muser1=1
frmCuifei.Show
EndSub
4.备份界面设计:
:
备份代码设计:
PrivateSubCommand1_Click()
DimaAsString
a=App.Path
a=a&"\"
b=Text1.Text
'GoToerrhandle:
DimfilenameAsString
filename=""&Text1.Text&"dbdb.mdb"
Ifa=Text1.TextThen
MsgBox"备份目录与原文件目录相同,请重新选择!"
ExitSub
EndIf
IfDir(""&b&"dbdb.mdb")<>""Then
DimllpAsString
llp=MsgBox("此目录下已有该文件,要覆盖吗?",vbYesNo,"备份文件")
Ifllp=vbYesThen
Kill(""&b&"dbdb.mdb")
FileCopy""&a&"\data\dbdb.mdb",""&b&"dbdb.mdb"
Diml
l=MsgBox("备份成功!",vbOKOnly,"提示")
Else
ExitSub
EndIf
Else
FileCopy""&a&"\data\dbdb.mdb",""&b&"dbdb.mdb"
Dimll
ll=MsgBox("备份成功!",vbOKOnly,"提示")
EndIf
ExitSub
'errhandle:
'MsgBox"出现错误,不能复制",vbOKOnly+vbCritical,"复制文件"
'ResumeNext
EndSub
PrivateSubCommand2_Click()
'dy
'Me.Hide
UnloadMe
EndSub
PrivateSubDir1_Change()
'Drive1.Drive=Dir1
IfRight(Dir1.Path,1)<>"\"Then
Text1.Text=Dir1.Path+"\"
Else
Text1.Text=Dir1.Path
EndIf
Command1.Enabled=True
EndSub
PrivateSubDir1_Click()
IfRight(Dir1.Path,1)<>"\"Then
Text1.Text=Dir1.Path+"\"
Else
Text1.Text=Dir1.Path
EndIf
Command1.Enabled=True
EndSub
PrivateSubDrive1_Change()
Dir1.Path=Drive1.Drive
EndSub
PrivateSubForm_Activate()
Command1.Enabled=False
gCnn.Close
ChDriveApp.Path
ChDirApp.Path
'Text1.SetFocus
'Text1.Text="c:\"
Text1.Text=CurDir()
Text1.Enabled=False
EndSub
PrivateSubForm_Load()
ChDriveApp.Path
ChDirApp.Path
EndSub
PrivateSubForm_QueryUnload(CancelAsInteger,UnloadModeAsInteger)
dy
EndSub
PrivateSubForm_Unload(CancelAsInteger)
IfgCnn.State=0Then
gCnn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;JetOLEDB:databasepassword="&DbPassword&";DataS
上一篇:
VB电脑销售系统(论文和程序)
下一篇:
月入5000,你有什么资格谈生活