📄 formnewprj.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FormNewPrj
BorderStyle = 1 'Fixed Single
Caption = "Dest"
ClientHeight = 5880
ClientLeft = 2250
ClientTop = 1530
ClientWidth = 7455
LinkTopic = "Form2"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5880
ScaleWidth = 7455
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000001&
BorderStyle = 0 'None
FillStyle = 0 'Solid
FontTransparent = 0 'False
ForeColor = &H80000008&
Height = 735
Left = 2040
ScaleHeight = 735
ScaleWidth = 5415
TabIndex = 14
Top = 0
Width = 5415
End
Begin MSComDlg.CommonDialog dlgCommonDialog
Left = 3480
Top = 3840
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3480
Top = 1560
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.ListView ListViewKB
Height = 2895
Left = 360
TabIndex = 1
Top = 1320
Width = 2895
_ExtentX = 5106
_ExtentY = 5106
View = 2
LabelWrap = -1 'True
HideSelection = -1 'True
Checkboxes = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.CommandButton Cancel
Caption = "取消"
Height = 372
Left = 6120
TabIndex = 10
Top = 5040
Width = 972
End
Begin VB.CommandButton OK
Caption = "确定"
Height = 372
Left = 6120
TabIndex = 9
Top = 4440
Width = 972
End
Begin VB.CommandButton DelKB
Caption = "删除"
Height = 372
Left = 3360
TabIndex = 8
Top = 2760
Width = 732
End
Begin VB.CommandButton FindKB
Caption = "查找..."
Height = 372
Left = 3360
TabIndex = 7
Top = 3360
Width = 732
End
Begin VB.CommandButton AddKB
Caption = "添加"
Height = 372
Left = 3360
TabIndex = 6
Top = 2160
Width = 732
End
Begin VB.CommandButton Explore
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 585
Left = 5280
Picture = "FormNewPrj.frx":0000
Style = 1 'Graphical
TabIndex = 3
ToolTipText = "选择工程路径"
Top = 4920
Width = 735
End
Begin VB.TextBox FileLocation
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 1440
TabIndex = 2
Top = 5040
Width = 3735
End
Begin VB.TextBox PrjName
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 1440
TabIndex = 0
Text = "new"
ToolTipText = "输入新工程的名称"
Top = 4440
Width = 4452
End
Begin MSComctlLib.ListView PrjList
Height = 2895
Left = 4200
TabIndex = 13
Top = 1320
Width = 2895
_ExtentX = 5106
_ExtentY = 5106
View = 2
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Label Label1
Caption = "系统会以工程名称在所选位置建立相应目录"
ForeColor = &H8000000D&
Height = 255
Left = 360
TabIndex = 17
Top = 5520
Width = 4095
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "新建工程"
BeginProperty Font
Name = "华文新魏"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 375
Left = 120
TabIndex = 15
Top = 240
Width = 1335
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H80000001&
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 0
TabIndex = 16
Top = 0
Width = 2055
End
Begin VB.Label Label6
Caption = "新工程"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4200
TabIndex = 12
Top = 960
Width = 2895
End
Begin VB.Label Label5
Caption = "知识库"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 11
Top = 960
Width = 2895
End
Begin VB.Label Label8
Caption = "位置："
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 5
Top = 5040
Width = 1095
End
Begin VB.Label Label7
Caption = "工程名称："
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 4
Top = 4560
Width = 1095
End
End
Attribute VB_Name = "FormNewPrj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim kbFile As Integer
Dim kbDir(10) As String
Dim kbName(10) As String
Public bNewprj As Boolean
Private Sub AddKB_Click()
Dim i As Integer
Dim item As ListItem
For i = 1 To kbFile
If ListViewKB.ListItems(i).checked = True Then
Set item = PrjList.ListItems.Add()
item.Text = ListViewKB.ListItems(i).Text
End If
Next
PrjList.Refresh
End Sub
Private Sub Cancel_Click()
bNewprj = False
Unload Me
End Sub
Private Sub DelKB_Click()
If (PrjList.ListItems.count > 0) Then
PrjList.ListItems.Remove (PrjList.SelectedItem.Index)
End If
End Sub
Private Sub Explore_Click()
Dim frmdir1 As New frmDir
frmdir1.Show vbModal
FormNewPrj.FileLocation.Text = frmdir1.returnpath
End Sub
Private Sub FindKB_Click()
Static FindKBNum As Integer
With dlgCommonDialog
.InitDir = App.path
.DialogTitle = "添加 xml文件"
.CancelError = False
'ToDo: set the flags and attributes of the common dialog control
.Filter = "Project Files (*.xml)|*.xml|All Files (*.*)|*.*"
.ShowOpen
If Len(.filename) = 0 Then
Exit Sub
End If
kbDir(FindKBNum) = .filename
kbName(FindKBNum) = .FileTitle
PrjList.ListItems.Add , , .FileTitle
FindKBNum = FindKBNum + 1
End With
End Sub
Private Sub Form_Load()
Dim MyPath, myname As String
Dim item As ListItem
Dim i As Integer
i = 0
kbFile = 0
MyPath = App.path + "\KB\" ' Set the path.
myname = Dir(MyPath + "*.xml") ' Retrieve the first entry.
Do While myname <> "" ' Start the loop.
Set item = ListViewKB.ListItems.Add()
item.Text = myname
i = i + 1
myname = Dir ' Get next entry.
Loop
kbFile = i
FileLocation.Text = App.path + "\"
End Sub
Private Sub OK_Click()
Dim PrjItem As ListItem
Dim KBitem As ListItem
Dim myname As String
Dim nSaveQuery As Integer
Dim fsoSave As Scripting.FileSystemObject
Set fsoSave = CreateObject("Scripting.FileSystemObject")
If fsoSave.FolderExists(Me.FileLocation.Text + Me.PrjName.Text) = True Then
nSaveQuery = MsgBox("工程" + Me.FileLocation.Text + Me.PrjName.Text + "已存在，覆盖吗？", vbYesNo + vbInformation, "Dest3.0")
Select Case nSaveQuery
Case vbYes
If Dir(Me.FileLocation.Text + Me.PrjName.Text + "\" + ".") <> "" Then _
Kill FormNewPrj.FileLocation.Text + FormNewPrj.PrjName.Text + "\*.*"
Case vbNo
Exit Sub
End Select
End If
Prj_Location = Me.FileLocation.Text + Me.PrjName.Text + "\" '记录工程路径
Prj_Name = PrjName.Text + ".prj" '记录工程名
With FormNewPrj
If (nSaveQuery <> vbYes) Then
MkDir .FileLocation.Text + .PrjName.Text
End If
For Each PrjItem In .PrjList.ListItems()
For Each KBitem In .ListViewKB.ListItems()
If PrjItem.Text = KBitem.Text Then
FileCopy App.path + "\KB\" + KBitem.Text, .FileLocation.Text + .PrjName.Text + "\" + PrjItem.Text
End If
Next KBitem
For i = 0 To 10
If PrjItem = kbDir(i) Then
FileCopy kbDir(i), .FileLocation.Text + .PrjName.Text + "\" + PrjItem.Text
End If
Next
Next PrjItem
FileCopy App.path + "\KB\" + "template.dtd", Prj_Location + "template.dtd" '复制DTD文件
'写入工程文件
Open Prj_Location + .PrjName.Text + ".prj" For Output As #1
myname = Dir(Prj_Location + "*.xml") ' Retrieve the first entry.选定所有的xml文件
Do While myname <> "" ' Start the loop.
Write #1, myname
myname = Dir ' Get next entry.
Loop
Close #1
sPrj = Prj_Location + Prj_Name
End With
bNewprj = True
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -