📄 vb50e.tmp
字号:
VERSION 5.00
Object = "{E491F001-98EC-11D1-9B3D-00C04FAD5AEC}#1.0#0"; "msceimagelist.dll"
Object = "{6556ED95-9838-11D1-80AE-00C04FAD5EFB}#1.0#0"; "mscelistview.dll"
Object = "{D863DA15-8C5B-11D1-86C0-00AA003EE054}#1.0#0"; "mscetreeview.dll"
Object = "{25C953A7-5464-11D1-A714-00AA0044064C}#1.0#0"; "MSCEFILE.DLL"
Object = "{338D5EA5-4BBD-11D1-9A7D-00C04FAD5AEC}#1.0#0"; "mscepicture.dll"
Object = "{F7DEA2C9-BA8F-446E-A292-B4840F3BD661}#1.0#0"; "mscemenubar.dll"
Begin VB.Form frmMain
Appearance = 0 'Flat
BackColor = &H80000001&
Caption = "项目管理"
ClientHeight = 4080
ClientLeft = 60
ClientTop = 840
ClientWidth = 3900
ForeColor = &H80000008&
ScaleHeight = 4080
ScaleWidth = 3900
Begin PictureBoxCtl.PictureBox arrowimg
Height = 135
Left = 1460
TabIndex = 2
Top = 1800
Width = 110
_cx = 212
_cy = 238
AutoSize = 0 'False
BackColor = -2147483647
BorderStyle = 0
DrawMode = 13
DrawStyle = 0
DrawWidth = 1
FillColor = -2147483640
FillStyle = 1
ForeColor = -2147483640
FontBold = 0 'False
FontItalic = 0 'False
FontStrikethru = 0 'False
FontUnderline = 0 'False
FontName = "Tahoma"
FontSize = 10
FontTransparent = -1 'True
Object.Height = 9
Object.Width = 8
Object.Left = 97
Object.Top = 120
Picture = ""
ScaleHeight = 135
ScaleWidth = 120
ScaleLeft = 0
ScaleTop = 0
ScaleMode = 1
Enabled = -1 'True
End
Begin MSCETREEVIEWLibCtl.TreeViewCtl DBTreeView
Height = 4055
Left = 0
TabIndex = 1
Top = 0
Width = 1455
_cx = 2566
_cy = 7153
FontBold = 0 'False
FontItalic = 0 'False
FontName = "Tahoma"
FontSize = 8
FontStrikethrough= 0 'False
FontUnderline = 0 'False
HideSelection = -1 'True
Indentation = 0
LabelEdit = 1
LineStyle = 0
PathSeparator = "\"
Style = 7
Enabled = -1 'True
End
Begin CEImageListCtl.ImageList treeImage
Left = 3360
Top = 0
_cx = 990
_cy = 990
ImageWidth = 0
ImageHeight = 0
End
Begin MenuBarLib.MenuBar mnuMenu
Left = 120
Top = 0
_cx = 1296
_cy = 873
Enabled = -1 'True
NewButton = 0 'False
End
Begin MSCELISTVIEWLibCtl.ListViewCtrl MsgInfoList
Height = 4055
Left = 1560
TabIndex = 0
Top = 0
Width = 2325
_cx = 4101
_cy = 7153
FontBold = 0 'False
FontItalic = 0 'False
FontName = "宋体"
FontSize = 9
FontStrikethrough= 0 'False
FontUnderline = 0 'False
HideColumnHeaders= 0 'False
HideSelection = -1 'True
LabelEdit = 1
LabelWrap = 0 'False
MultiSelect = 0 'False
Sorted = 0 'False
SortKey = 0
SortOrder = 0
View = 3
Enabled = -1 'True
End
Begin FILECTLCtl.FileSystem FileSystem1
Left = 0
Top = 0
_cx = 2200
_cy = 1400
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub arrowimg_Click()
Dim strPath As String
strPath = App.Path
If strPath = "\" Then
strPath = ""
End If
If InStr(arrowimg.Picture, "right.bmp") > 0 Then
DBTreeView.Visible = False
arrowimg.Left = DBTreeView.Left
MsgInfoList.Left = MsgInfoList.Left - DBTreeView.Width
MsgInfoList.Width = MsgInfoList.Width + DBTreeView.Width
arrowimg.Picture = strPath & "\left.bmp"
Else
DBTreeView.Visible = True
arrowimg.Left = DBTreeView.Left + DBTreeView.Width
MsgInfoList.Left = MsgInfoList.Left + DBTreeView.Width
MsgInfoList.Width = MsgInfoList.Width - DBTreeView.Width
arrowimg.Picture = strPath & "\right.bmp"
End If
End Sub
Private Sub DBTreeView_NodeClick(ByVal Index As Long)
Dim thekey As String
thekey = DBTreeView.Nodes(Index).Key
If Trim(thekey) = "Root" Then
Call initList
Else
On Error Resume Next
Dim mitem As ListItem
MsgInfoList.ListItems.Clear
Dim sql As String
Dim conn As ADOCE.Connection
Set conn = CreateObject("ADOCE.connection.3.1")
conn.ConnectionString = dbConnStr
conn.Open
sql = "select * from MsgInfo where MsgID=" & CInt(Mid(thekey, 6))
Dim myRec As ADOCE.Recordset
Set myRec = CreateObject("ADOCE.recordset.3.1")
myRec.Open sql, conn, adOpenStatic
Do While Not myRec.EOF
Set mitem = MsgInfoList.ListItems.Add(, "t" & myRec("msgID"), myRec("msgID"))
mitem.SubItems(1) = Trim(myRec("MsgName"))
mitem.SubItems(2) = Trim(myRec("MsgAuthor"))
mitem.SubItems(3) = Trim(myRec("MsgDate"))
mitem.SubItems(4) = Trim(myRec("MsgDetail"))
myRec.MoveNext
Loop
myRec.Close
Set myRec = Nothing
conn.Close
Set conn = Nothing
End If
End Sub
Private Sub Form_Load()
Dim strPath As String
strPath = App.Path
If strPath = "\" Then
strPath = ""
End If
InitReplRDA
Dim mnuFile As MenuBarLib.MenuBarMenu
Dim mnuEdit As MenuBarLib.MenuBarMenu
Dim mnuHelp As MenuBarLib.MenuBarMenu
Dim mnuSetup As MenuBarLib.MenuBarMenu
Dim mnuTool As MenuBarLib.MenuBarMenu
Set mnuFile = mnuMenu.Controls.AddMenu("操作", "mnuFile")
mnuFile.Items.Add 1, "mnuFileAddP", "新建"
mnuFile.Items.Add 2, "mnuFileupdP", "修改"
mnuFile.Items.Add 3, "mnuFileDelP", "删除"
mnuFile.Items.Add 4, "mnuFilsept2", "", mbrMenuSeparator
mnuFile.Items.Add 5, "mnuFileRef", "刷新"
mnuFile.Items.Add 6, "mnuFilsept3", "", mbrMenuSeparator
mnuFile.Items.Add 7, "mnuFileExit", "退出"
Set mnuEdit = mnuMenu.Controls.AddMenu("编辑", "mnuFind")
mnuEdit.Items.Add 1, "mnuCopy", "复制"
mnuEdit.Items.Add 2, "mnuPaste", "粘贴"
mnuEdit.Items.Add 3, "mnuEditsep1", "", mbrMenuSeparator
mnuEdit.Items.Add 4, "mnuEditFind", "查找"
Set mnuTool = mnuMenu.Controls.AddMenu("工具", "mnuTool")
mnuTool.Items.Add 1, "mnuReplication", "复制"
'mnuTool.Items(1).SubItems.Add 1, "mnuReplSynchronize", "同步"
'mnuTool.Items(1).SubItems.Add 2, "mnuReplAddSubscription", "订阅"
mnuTool.Items.Add 2, "mnuToolsep1", "", mbrMenuSeparator
mnuTool.Items.Add 3, "mnuRDA", "RDA"
Set mnuSetup = mnuMenu.Controls.AddMenu("设置", "mnuSetup")
mnuSetup.Items.Add 1, "mnuReplSetup", "复制属性"
'mnuSetup.Items.Add 2, "mnuSetupsep1", "", mbrMenuSeparator
'mnuSetup.Items.Add 3, "mnuRdaSetup", "RDA属性"
Set mnuHelp = mnuMenu.Controls.AddMenu("帮助", "mnuHelp")
mnuHelp.Items.Add 1, "mnuAbout", "关于"
'开始加载图片
treeImage.Add (strPath & "\root.bmp")
treeImage.Add (strPath & "\item.bmp")
arrowimg.Picture = strPath & "\right.bmp"
DBTreeView.ImageList = treeImage.hImageList
Call initListColu
If FileSystem1.Dir(strPath & "\ProjectInfo.sdf") = "" Then
'createDB
Else
Call initList
Call initTree
End If
End Sub
Private Sub mnuMenu_MenuClick(ByVal Item As MenuBarLib.Item)
mnuItem = Item.Key
Select Case Item.Key
Case "mnuFileAddP"
frmAdd.actionID.Caption = ""
frmAdd.MsgName.Text = ""
frmAdd.MsgAuthor.Text = ""
frmAdd.MsgDate.Text = FormatDateTime(Date, vbShortDate)
frmAdd.msgDetail.Text = ""
frmAdd.Show
Case "mnuFileupdP"
Call updProject
Case "mnuFileDelP"
'删除
Dim theResult As Integer
theResult = MsgBox("确认删除吗？", vbExclamation + vbYesNo, "删除")
If theResult = vbYes Then
If MsgInfoList.ListItems.Count > 0 Then
Dim conn As ADOCE.Connection
Set conn = CreateObject("ADOCE.connection.3.1")
conn.ConnectionString = dbConnStr
conn.Open
Dim sql As String
sql = "delete from MsgInfo where MsgID=" & CInt(MsgInfoList.SelectedItem.Text)
conn.Execute (sql)
conn.Close
Set conn = Nothing
Call DeleteRec(MsgInfoList.SelectedItem.Index)
End If
End If
Case "mnuFileRef"
Call initTree
Call initList
Case "mnuFileExit"
App.End
Case "mnuEditFind"
frmFind.Show
Case "mnuReplication"
'复制
startReplication
Case "mnuReplSetup"
frmReplAddSubscription.Show
Case "mnuRDA"
If FileSystem1.Dir(strPath & "\ProjectInfo.sdf") <> "" Then
'FileSystem1.Kill strPath & "\ProjectInfo.sdf"
End If
frmRDA.Show
Case "mnuRDAPush"
'Call createDB
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -