VB6 ADO ListView数据库分页显示 |
|
Dimlink1AsNewADODB.Connection DimrsAsNewADODB.Recordset DimpageAsInteger DimpubdatapathAsString Subopendatabase(datapathAsString)' 打开数据库函数 page=1'首次定义 打开时的页码为1 Iflink1.State=1Then'假如以衔接过，则关闭，初始化下次事务 link1.Close:list2.ListItems.Clear:list2.ColumnHeaders.Clear:c.Clear:list1.ListItems.Clear EndIf link1.ConnectionString="Provider=microsoft.jet.oledb.4.0;datasource="&datapath link1.Open pubdatapath=datapath Setbiaoming=link1.OpenSchema(adSchemaColumns)' 缔造数据库记录集 tablename="" DoUntilbiaoming.EOF Ifbiaoming("table_name")<>tablenameThen'列出全部表 tablename=biaoming("table_name") list1.ListItems.Add,,tablename EndIf biaoming.MoveNext Loop Setbiaoming=Nothing menu1.Enabled=True list1_MouseUp1,0,10,10 EndSub PrivateSubCommand1_Click()' 打开数据库 d.DialogTitle=" 打开一个数据库文件进行阅读" d.InitDir=App.Path d.FileName="" d.Filter="Access数据库(mdb后缀,推举 格局) *.mdb" d.ShowOpen Ifd.FileName=""ThenExitSub opendatabased.FileName EndSub
PrivateSubCommand4_Click() str1=InputBox("请输入一个1-5000中间的数字","重设",Text1.Text) Ifstr1=Text1.TextOrstr1=""ThenExitSub IfIsNumeric(str1)=FalseThenExitSub Ifstr1>5000Orstr1<1ThenExitSub Text1.Text=str1 Iflist1.ListItems.Count=0ThenExitSubElselist1_MouseUp1,0,10,10 EndSub PrivateSubdown_Click()' 性能，下一页 page=page 1:list1_MouseUp1,0,10,10 EndSub PrivateSubfindstr_Click()' 查问数据 IfInStr(Text2.Text,"'")<>0ThenMsgBox" 查问时 要害字不同意包括'符号",vbCritical,"无效字符":ExitSub Ifrs.State=1Thenrs.Close rs.Open"select"&c.Text&"from"&list1.SelectedItem.Text&"where"&c.Text&"like'"&Text2.Text&"'", link1,adOpenStatic,adLockReadOnly Ifrs.EOFThenMsgBox"没有符号条件的记录,请从新搜索",vbCritical,"未发现记录":ExitSub DoWhileNotrs.EOF i=i 1 str1=str1&i&"："&rs(0)&vbCrLf rs.MoveNext Loop MsgBoxstr1,vbExclamation," 查问 后果-"&rs.RecordCount&"匹配" EndSub
PrivateSubForm_Resize() list1.ColumnHeaders(1).Width=list1.Width-80 list2.Width=Me.ScaleWidth-list2.Left-30 list1.Height=Me.ScaleHeight-list1.Top-30 list2.Height=Me.ScaleHeight-(Me.ScaleHeight-down.Top)-150 EndSub PrivateSubForm_Unload(CancelAsInteger) Ifrs.State=1Thenrs.Close Iflink1.State=1Thenlink1.Close Setrs=Nothing:Setlink1=Nothing EndSub PrivateSublist1_MouseUp(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)'切换表 OnErrorResumeNext Iflist1.ListItems.Count=0ThenExitSub Ifrs.State=1Thenrs.Close list2.ListItems.Clear:list2.ColumnHeaders.Clear:c.Clear rs.Open"select*from"&list1.SelectedItem.Text,link1,adOpenStatic,adLockReadOnly IfErr.Number<>0Then MsgBox"该数据表不能 支撑的游标模式",vbCritical,"不 规定的 格局":ExitSub EndIf rs.PageSize=Text1.Text rslen=rs.RecordCount Ifrs.PageCount<pageThenpage=1 Label3.Caption="共"&rslen&"条记录,共"&rs.PageCount&"页,目前页码"&page Ifrs.PageCount>pageThendown.Enabled=TrueElsedown.Enabled=False Ifpage<>1Thenup.Enabled=TrueElseup.Enabled=False Setziduan=rs.Fields'定义字段记录集 Fori=0Toziduan.Count-1 list2.ColumnHeaders.Add,,ziduan(i).Name'依据字段指定视图列 c.AddItemziduan(i).Name rs.MoveFirst'记录到尾后填充下一列 rs.AbsolutePage=page'定义记录集的绝对页码 Forr=0Tors.PageSize-1 Ifrs.EOFThenExitFor rstext=rs(i) Ifi=0Then'首次直接填充第一列 list2.ListItems.Add,,rstext Else'非首次填充下一下 Ifrstext<>EmptyThenlist2.ListItems(r 1).ListSubItems.Add,,rstextElselist2.ListItems(r 1).ListSubItems.Add,,"" EndIf rs.MoveNext Next Next Ifc.ListCount<>0Thenc.ListIndex=0:findstr.Enabled=TrueElsefindstr.Enabled=False Setziduan=Nothing EndSub PrivateSubmenu01_Click(IndexAsInteger) SelectCaseIndex Case1:'建新表演示 str1=1 Fori=1Tolist1.ListItems.Count IfInStr(list1.ListItems(i).Text,"新建表")=1Thenstr1=str1 1 Next link1.Execute"createtable新建表"&str1&"(会员名Text,密码Varchar(8),年龄intnotnull, 教训值"&_ "integer,加入日期DateTimenull)" link1.Execute"insertinto新建表"&str1&"(会员名,密码,年龄, 教训值,加入日期)values('风云舞','12345678'"&_ ",18,365,'"&Now&"')" link1.Execute"insertinto新建表"&str1&"(会员名,密码,年龄, 教训值,加入日期)values('Lshdic','87654321'"&_ ",18,365,'"&Now&"')" opendatabasepubdatapath'刷新重装载列表 Case2:'刷新——重装载 opendatabasepubdatapath Case3:'删除 Ifrs.State=1Thenrs.Close link1.Execute"Droptable"&list1.SelectedItem.Text opendatabasepubdatapath Case4:'表属性 Ifrs.State=1Thenrs.Close rs.Open"select*from"&list1.SelectedItem.Text,link1,adOpenStatic,adLockReadOnly Fori=0Tors.Fields.Count-1 str1=str1&rs.Fields(i).Name&"," str2=str2&rs.Fields(i).Type&"," str3=str3&rs.Fields(i).ActualSize&"," str4=str4&rs.Fields(i).DefinedSize&"," Next MsgBox"包括字段:"&str1&vbCrLf&vbCrLf&"字段类型:"&str2&vbCrLf&vbCrLf&"第一行数据大小:"&_ str3&vbCrLf&vbCrLf&"每行数据预设容量:"&str4,vbExclamation,"表属性" EndSelect EndSub PrivateSuBText2_GotFocus() IfText2.Text="搜索 要害字..."ThenText2.Text="" EndSub PrivateSuBText2_LostFocus() IfText2.Text=""ThenText2.Text="搜索 要害字..." EndSub PrivateSubup_Click()' 性能，上一页 page=page-1:list1_MouseUp1,0,10,10 EndSub |
