科研项目管理系统程序代码-VB编程毕业设计

1、1 dlgConnectSetup 连接设置2 dlgSaveSymbol 储存代码3 dlgSymbolSetup 代码设置4 filequiry 文件查询5 frmMachineQuery 设备查询界面6 frmMain 主界面7 frmMeetArtiQuery 会议论文查询模块8 frmPeriodArtiQuery 期刊论文查询模块9 frmProjectQuery 项目查询模块10 frmRecordInput 录入模块11 MachineQuery 设备查询12 moneyquery 经费查询13 cwbhquery 财务编号查询14 ProjectQuery 项目查询15 mo

2、dMain 初始化模块16 clsDataSource 类模块17 drpMachine 设备统计报表18 drpMeetArticle 会议论文统计19 drpPeriodArticle 期刊论文统计20XX drpProArchieve 项目成果报表21 drpProjFinancial 项目经费22 drpProjOverview 项目总览dlgConnectSetupOption ExplicitPrivate Sub CancelButton_Click()Unload MeEnd SubPrivate Sub cmdHelp_Click()frmMain.Hhopen1.OpenH

3、elp App.HelpFile, Connect.htmlEnd SubPrivate Sub Form_Load() Me.Move (Screen.Width - Me.Width) 2, (Screen.Height - Me.Height) 2 txtServerName.Text = GetSetting(科研项目管理系统, Connection, ServerName, ) txtDatabaseName.Text = GetSetting(科研项目管理系统, Connection, DatabaseName, )End SubPrivate Sub OKButton_Click

4、()If Trim(txtServerName.Text) And Trim(txtDatabaseName.Text) Then SaveSetting 科研项目管理系统, Connection, ServerName, Trim(txtServerName.Text) SaveSetting 科研项目管理系统, Connection, DatabaseName, Trim(txtDatabaseName.Text) Unload Me MsgBox 注意:必须重新启动应用程序才能使设置生效。, vbExclamation, 连接设置 Else MsgBox 输入不完全！, vbExclam

5、ation, 错误End IfEnd SubPrivate Sub txtServerName_GotFocus()With txtServerName.SelStart = 0.SelLength = Len(.Text)End WithEnd SubPrivate Sub txtdatabaseName_GotFocus()With txtDatabaseName.SelStart = 0.SelLength = Len(.Text)End WithEnd SubdlgSaveSymbolOption ExplicitPrivate Sub CancelButton_Click()Unlo

6、ad MeEnd SubPrivate Sub OKButton_Click()Dim RegKey As StringIf Trim(txtString.Text) Then Select Case dlgSaveSymbol.Caption Case 添加项目性质代号 RegKey = SymbolProjectQuality SaveSetting 科研项目管理系统, RegKey, txtNumber.Text, txtString.Text SaveSetting 科研项目管理系统, RegKey, Count, txtNumber.Text Case 编辑项目性质代号 RegKey

7、 = SymbolProjectQuality SaveSetting 科研项目管理系统, RegKey, txtNumber.Text, txtString.Text Case 添加论文范围代号 RegKey = SymbolArticleRange SaveSetting 科研项目管理系统, RegKey, txtNumber.Text, txtString.Text SaveSetting 科研项目管理系统, RegKey, Count, txtNumber.Text Case 编辑论文范围代号 RegKey = SymbolArticleRange SaveSetting 科研项目管理

8、系统, RegKey, txtNumber.Text, txtString.Text Case 添加检索源代号 RegKey = SymbolArticleRetrieveSource SaveSetting 科研项目管理系统, RegKey, txtNumber.Text, txtString.Text SaveSetting 科研项目管理系统, RegKey, Count, txtNumber.Text Case 编辑检索源代号 RegKey = SymbolArticleRetrieveSource SaveSetting 科研项目管理系统, RegKey, txtNumber.Text

9、, txtString.Text End Select Unload Me dlgSymbolSetup.ReloadRegElse MsgBox 没有输入！, , 错误 txtString.SetFocusEnd IfEnd SubdlgSymbolSetupOption ExplicitDim CountQuality As IntegerDim Countrange As IntegerDim CountRetrieve As IntegerDim CurrentListBox As ListBoxDim dlgSaveCaption As StringPrivate Sub cmdCl

10、ose_Click()Unload MeEnd SubPrivate Sub cmdAdd_Click()Select Case SSTab1.TabCase 0 Set CurrentListBox = lstQuality dlgSaveCaption = 添加项目性质代号Case 1 Set CurrentListBox = lstRange dlgSaveCaption = 添加论文范围代号Case 2 Set CurrentListBox = lstRetrieve dlgSaveCaption = 添加检索源代号End SelectWith dlgSaveSymbol.txtNum

11、ber.Text = CStr(CurrentListBox.ListCount).Caption = dlgSaveCaption.Show vbModalEnd WithEnd SubPrivate Sub cmdDelete_Click()Dim msg As IntegerDim RegKey As StringSelect Case SSTab1.TabCase 0 Set CurrentListBox = lstQuality RegKey = SymbolProjectQualityCase 1 Set CurrentListBox = lstRange RegKey = Sym

12、bolArticleRangeCase 2 Set CurrentListBox = lstRetrieve RegKey = SymbolArticleRetrieveSourceEnd SelectIf CurrentListBox.ListIndex 0 Then 如果选择的不是第一项 If CurrentListBox.ListIndex -1 Then msg = MsgBox(警告:如果您删除的是数据库中已存在的代号, & vbCrLf & _ 可能引起不可预料的后果。您确定要删除该代号吗？, _ vbExclamation Or vbOKCancel, 删除确认) If msg

13、= vbOK Then SaveSetting 科研项目管理系统, RegKey, Count, CStr(CurrentListBox.ListIndex - 1) DeleteSetting 科研项目管理系统, RegKey, CStr(CurrentListBox.ListIndex) ReloadReg cmdDelete.Enabled = False End If End IfElse MsgBox 不能删除第一项！, , 错误 End IfEnd SubPrivate Sub cmdEdit_Click()Select Case SSTab1.TabCase 0 Set Curr

14、entListBox = lstQuality dlgSaveCaption = 编辑项目性质代号Case 1 Set CurrentListBox = lstRange dlgSaveCaption = 编辑论文范围代号Case 2 Set CurrentListBox = lstRetrieve dlgSaveCaption = 编辑检索源代号End SelectWith dlgSaveSymbol.txtNumber.Text = CStr(CurrentListBox.ListIndex).txtString.Text = Mid(CurrentListBox.List(Current

15、ListBox.ListIndex), Len(CStr(CurrentListBox.ListIndex) + 2).Caption = dlgSaveCaption.Show vbModalEnd WithEnd SubPublic Sub ReloadReg()Dim intSettings As IntegerOn Error Resume NextCountQuality = CInt(GetSetting(科研项目管理系统, SymbolProjectQuality, Count)Countrange = CInt(GetSetting(科研项目管理系统, SymbolArticl

16、eRange, Count)CountRetrieve = CInt(GetSetting(科研项目管理系统, SymbolArticleRetrieveSource, Count) lstQuality.Clear lstRange.Clear lstRetrieve.ClearcmdEdit.Enabled = FalsecmdDelete.Enabled = FalseFor intSettings = 0 To CountQualitylstQuality.AddItem CStr(intSettings) & - & GetSetting(科研项目管理系统, SymbolProjec

17、tQuality, CStr(intSettings), 未设置)Next intSettings 从注册表中得到性质代号For intSettings = 0 To CountrangelstRange.AddItem CStr(intSettings) & - & GetSetting(科研项目管理系统, SymbolArticleRange, CStr(intSettings), 未设置)Next intSettings 从注册表中得到性质代号For intSettings = 0 To CountRetrievelstRetrieve.AddItem CStr(intSettings)

18、 & - & GetSetting(科研项目管理系统, SymbolArticleRetrieveSource, CStr(intSettings), 未设置)Next intSettings 从注册表中得到性质代号End SubPrivate Sub cmdHelp_Click()frmMain.Hhopen1.OpenHelp App.HelpFile, Symbol.htmlEnd SubPrivate Sub Form_Load()Me.Move (Screen.Width - Me.Width) 2, (Screen.Height - Me.Height) 2ReloadRegSST

19、ab1.Tab = 0End SubPrivate Sub lstQuality_Click()If lstQuality.ListIndex 0 Then 如果选择的不是第一项则可以进行删除操作 cmdDelete.Enabled = TrueElse cmdDelete.Enabled = FalseEnd IfIf lstQuality.ListIndex -1 Then 如果选中任意一项 cmdEdit.Enabled = TrueElse cmdEdit.Enabled = FalseEnd IfEnd SubPrivate Sub lstQuality_DblClick()cmdE

20、dit_ClickEnd SubPrivate Sub lstQuality_KeyPress(KeyAscii As Integer)If KeyAscii = 13 And lstQuality.ListIndex -1 Then cmdEdit_ClickEnd SubPrivate Sub lstRange_Click()If lstRange.ListIndex 0 Then 如果选择的不是第一项则可以进行删除操作 cmdDelete.Enabled = TrueElse cmdDelete.Enabled = FalseEnd IfIf lstRange.ListIndex -1

21、Then 如果选中任意一项 cmdEdit.Enabled = TrueElse cmdEdit.Enabled = FalseEnd IfEnd SubPrivate Sub lstRange_DblClick()cmdEdit_ClickEnd SubPrivate Sub lstRange_KeyPress(KeyAscii As Integer)If KeyAscii = 13 And lstRange.ListIndex -1 Then cmdEdit_ClickEnd SubPrivate Sub lstRetrieve_Click()If lstRetrieve.ListInde

22、x 0 Then 如果选择的不是第一项则可以进行删除操作 cmdDelete.Enabled = TrueElse cmdDelete.Enabled = FalseEnd IfIf lstRetrieve.ListIndex -1 Then 如果选中任意一项 cmdEdit.Enabled = TrueElse cmdEdit.Enabled = FalseEnd IfEnd SubPrivate Sub lstRetrieve_DblClick()cmdEdit_ClickEnd SubPrivate Sub lstRetrieve_KeyPress(KeyAscii As Integer

23、)If KeyAscii = 13 And lstRetrieve.ListIndex -1 Then cmdEdit_Click Enter KeyEnd SubPrivate Sub SSTab1_Click(PreviousTab As Integer) cmdDelete.Enabled = False lstQuality.ListIndex = -1 lstRange.ListIndex = -1 lstRetrieve.ListIndex = -1End SubFilequiryPrivate BeginDate As StringPrivate EndDate As Strin

24、gPrivate Sub Check1_Click()If Check1.Value = 1 ThenLabel5.Enabled = TrueLabel6.Enabled = TrueLabel7.Enabled = TrueLabel8.Enabled = TrueLabel9.Enabled = TrueUpDown1.Enabled = TrueUpDown2.Enabled = TrueCombo1.Enabled = TrueCombo2.Enabled = TrueText2.Enabled = TrueText3.Enabled = TrueElse: Label5.Enabl

25、ed = FalseLabel6.Enabled = FalseLabel7.Enabled = FalseLabel8.Enabled = FalseLabel9.Enabled = FalseUpDown1.Enabled = FalseUpDown2.Enabled = FalseCombo1.Enabled = FalseCombo2.Enabled = FalseText2.Enabled = FalseText3.Enabled = FalseEnd IfEnd SubPrivate Sub Check2_Click()If Check2.Value = 1 ThenLabel3.

26、Enabled = TrueCombo3.Enabled = TrueElse: Label3.Enabled = FalseCombo3.Enabled = FalseEnd IfEnd SubPrivate Sub Check3_Click()If Check3.Value = 1 ThenCombo4.Enabled = Truelabel4.Enabled = TrueElse: Combo4.Enabled = Falselabel4.Enabled = FalseEnd IfEnd SubPrivate Sub Command1_Click()Dim ssql As StringD

27、im sdate As StringDim smeetname As StringDim swriter As StringDim query As CommandDim filterstring As StringOn Error Resume NextIf frmPeriodArtiQsel = 0 Thenssql = SELECT * from 会议论文表 WHERE (范围=0) If Trim(Text1.Text) Then ssql = ssql & and (论文名称 LIKE % & Trim(Text1.Text) & %)End IfIf Check1.

28、Value = 1 ThenBeginDate = Right(Text2.Text, 2) & Combo1.TextEndDate = Right(Text3.Text, 2) & Combo2.Text If CDate(Left(BeginDate, 2) & / & Right(BeginDate, 2) & /1) =# & BeginDate & # and 会议时间= & BeginDate & and 会议时间= & EndDate & )ElseMsgBox 开始日期必须小于结束日期！, , 输入错误End IfEnd IfIf Trim(Text4.Text) Then

29、ssql = ssql & and (作者1 like % & Trim(Text4.Text) & %or & _ 作者2 like % & Trim(Text4.Text) & % or & _ 作者3 like % & Trim(Text4.Text) & % or & _ 作者4 like % & Trim(Text4.Text) & % or & _ 作者5 like % & Trim(Text4.Text) & % or & _ 作者6 like % & Trim(Text4.Text) & % )End IfIf Check2.Value = 1 Thenssql = ssql

30、& and 范围= & Combo3.ListIndexEnd Ifssql = ssql & order by 会议时间 Set query = New Command With query .ActiveConnection = frmProjectQn1 .CommandText = ssql .CommandType = adCmdText End With Set frmMeetArtiQuery.rsmaresult = query.Execute With frmMeetArtiQuery.dbdMeetArtiQuery Set .DataSource = frm

31、MeetArtiQuery.rsmaresult .WrapCellPointer = True .TabAction = dbgGridNavigation End With frmMeetArtiQuery.dbdMeetArticleResize frmMeetArtiQuery.DateFormatfrmMain.StatusBar1.SimpleText = 找到 & frmMeetArtiQuery.rsmaresult.RecordCount & 条记录frmMeetArtiQuery.ShowEnd IfIf frmPeriodArtiQsel = 1 Then

32、ssql = SELECT * from 期刊论文表 WHERE (范围=0) If Trim(Text1.Text) Then ssql = ssql & and (论文名称 LIKE % & Trim(Text1.Text) & %)End IfIf Check1.Value = 1 ThenBeginDate = Right(Text2.Text, 2) & Combo1.TextEndDate = Right(Text3.Text, 2) & Combo2.Text If CDate(Left(BeginDate, 2) & / & Right(BeginDate, 2) & /1)

33、=# & BeginDate & # and 发表日期=# & EndDate & #)ElseMsgBox 开始日期必须小于结束日期！, , 输入错误End IfEnd IfIf Trim(Text4.Text) Then ssql = ssql & and (作者1 like % & Trim(Text4.Text) & %or & _ 作者2 like % & Trim(Text4.Text) & % or & _ 作者3 like % & Trim(Text4.Text) & % or & _ 作者4 like % & Trim(Text4.Text) & % or & _ 作者5 l

34、ike % & Trim(Text4.Text) & % or & _ 作者6 like % & Trim(Text4.Text) & % )End IfIf Check2.Value = 1 Thenssql = ssql & and 范围= & Combo3.ListIndexEnd IfIf Check3.Value = 1 Thenssql = ssql & and 检索源= & Combo4.ListIndexEnd Ifssql = ssql & order by 发表日期 Set query = New Command With query .ActiveConnection =

35、 frmProjectQn1 .CommandText = ssql .CommandType = adCmdText End With Set frmPeriodArtiQuery.rsparesult = query.Execute With frmPeriodArtiQuery.dbdPeriodArtiQuery Set .DataSource = frmPeriodArtiQuery.rsparesult .WrapCellPointer = True .TabAction = dbgGridNavigation End With frmPeriodArtiQuery.

36、dbdPeriodArticleResize frmPeriodArtiQuery.DateFormatfrmMain.StatusBar1.SimpleText = 找到 & frmPeriodArtiQuery.rsparesult.RecordCount & 条记录frmPeriodQuery.ShowEnd IfUnload MeEnd SubPrivate Sub Command3_Click()Unload MeEnd SubPrivate Sub Form_Load()BeginDate = EndDate = Me.Move (Screen.Width - Me.Width)

37、2, (Screen.Height - Me.Height) 2Dim intSettings As IntegerFor intSettings = 0 To CInt(GetSetting(科研项目管理系统, SymbolArticleRange, Count)Combo3.AddItem CStr(intSettings) & - & GetSetting(科研项目管理系统, SymbolArticleRange, CStr(intSettings), 未设置)Next intSettings 从注册表中得到检索源代号, Count)Combo3.ListIndex = 0If frmP

38、eriodArtiQsel = 1 ThenCombo4.Visible = True For intSettings = 0 To CInt(GetSetting(科研项目管理系统, SymbolArticleRetrieveSource, Count) Combo4.AddItem CStr(intSettings) & - & GetSetting(科研项目管理系统, SymbolArticleRetrieveSource, CStr(intSettings), 未设置) Next intSettings 从注册表中得到检索源代号, Count)Combo4.ListIn

39、dex = 0label4.Visible = TrueCheck3.Visible = TrueEnd IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)frmPeriodArtiQsel = 0End SubfrmMachineQueryOption ExplicitDim SortField As StringPublic rsmcresult As RecordsetPublic Sub DateFormat() 设置日期格式With dbMaQuery.Columns Set .Item(7).DataFormat

40、= SmallDateFormatEnd WithEnd SubPrivate Sub dbMaquery_HeadClick(ByVal ColIndex As Integer) 得到当前单击列的字段名称SortField = Trim(dbMaQuery.Columns.Item(ColIndex).Caption)End SubPrivate Sub dbMaquery_KeyDown(KeyCode As Integer, Shift As Integer)If Shift = 0 And KeyCode = 112 Then mnuContent_Click 当处于编辑模式时也能调出

41、帮助End SubPrivate Sub Form_Unload(Cancel As Integer)frmMain.StatusBar1.SimpleText = 清空状态栏End SubPrivate Sub mnuBack_Click() Unload frmMain.ActiveForm ReportDateString = End SubPrivate Sub mnuClear_Click()On Error Resume NextSet rsmcresult = New RecordsetfrmProjectQuery.connectrsmcresult.Open select *

42、 from 设备表, frmProjectQn1, adOpenStatic, adLockBatchOptimisticWith dbMaQuery Set .DataSource = rsmcresult 设置数据源 .WrapCellPointer = True .TabAction = dbgGridNavigation 使TAB键能跳到下一行End WithdbmaqueryResizeDateFormatfrmMain.StatusBar1.SimpleText = End SubPrivate Sub mnuContent_Click()frmMain.Hhopen

43、1.OpenHelp App.HelpFile, generalquery.htmlEnd SubPrivate Sub mnuPrint_Click()drpMachine.ShowDataReportMaterial.ShowEnd SubPrivate Sub mnuQuery_Click()Load machinequerymachinequery.ShowEnd SubPrivate Sub mnuSortAsc_Click()If SortField Thenrsmcresult.Sort = SortField & ascfrmMain.StatusBar1.SimpleText

44、 = 按 & SortField & 升序排列End IfEnd SubPrivate Sub mnuSortDesc_Click()If SortField Thenrsmcresult.Sort = SortField & descEnd IffrmMain.StatusBar1.SimpleText = 按 & SortField & 降序排列End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComCtlLib.Button) On Error Resume Next Select Case Button.Key Case

45、 升序排列 mnuSortAsc_Click Case 降序排列 mnuSortDesc_Click Case 清除 mnuClear_Click Case 帮助 mnuContent_Click Case 返回 mnuBack_Click End SelectEnd SubPrivate Sub dbmaquery_RowColChange(LastRow As Variant, ByVal LastCol As Integer)On Error Resume NextfrmMain.StatusBar1.SimpleText = dbMaQuery.Columns.Item(2).Text 将项目名称显示在状态栏上,以使用户在录入后面位置字段时清楚正在录入哪个记录End SubPublic Sub