造构成表.frm

计算机CAD图纸管理和预览

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form maketable 
   BackColor       =   &H80000005&
   Caption         =   "制作构成表"
   ClientHeight    =   10680
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   15240
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   10680
   ScaleWidth      =   15240
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin VB.CommandButton exitkey 
      Caption         =   "退出"
      Height          =   375
      Left            =   13800
      TabIndex        =   5
      Top             =   10200
      Width           =   1095
   End
   Begin VB.CommandButton PASTE 
      Caption         =   "PASTE"
      Height          =   375
      Left            =   6120
      TabIndex        =   4
      Top             =   10200
      Width           =   1575
   End
   Begin VB.CommandButton COPY 
      Caption         =   "COPY"
      Height          =   375
      Left            =   2160
      TabIndex        =   3
      Top             =   10080
      Width           =   1575
   End
   Begin VB.CommandButton DELETE 
      Caption         =   "DELETE"
      Height          =   375
      Left            =   4320
      TabIndex        =   2
      Top             =   10200
      Width           =   1575
   End
   Begin VB.CommandButton INSERT 
      Caption         =   "INSERT"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   10200
      Width           =   1575
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1 
      Height          =   9375
      Left            =   960
      TabIndex        =   0
      Top             =   0
      Width           =   10815
      _ExtentX        =   19076
      _ExtentY        =   16536
      _Version        =   393216
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin MSComctlLib.ImageList picTRee 
      Left            =   3480
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "造构成表.frx":0000
            Key             =   "unselect"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "造构成表.frx":0352
            Key             =   "root"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "造构成表.frx":06A4
            Key             =   "all"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "造构成表.frx":0C3E
            Key             =   "select"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "maketable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Public cn As ADODB.Connection  '公共连接对象
Public modelrs As New ADODB.Recordset  '定义一个记录集,表示部品表
Public Selectrow As Long
Public Copyrow As Long
Public Pasterow As Long



Private Sub COPY_Click()
    If Selectrow = Empty Then Exit Sub
    PASTE.Enabled = True
    Copyrow = Selectrow
    
End Sub



Private Sub PASTE_Click()
    Dim N As Integer
    If Selectrow = Empty Then Exit Sub
    Pasterow = Selectrow
    If Pasterow = Copyrow Then Exit Sub

    For N = 1 To MSHFlexGrid1.Cols - 1
         
       MSHFlexGrid1.TextMatrix(Pasterow, N) = MSHFlexGrid1.TextMatrix(Copyrow, N)
       MSHFlexGrid1.Col = N
       MSHFlexGrid1.CellBackColor = &HFFFF&

    Next N
           
End Sub



Private Sub DELETE_Click()
If Selectrow = Empty Then Exit Sub
If Selectrow = Copyrow Then
 PASTE.Enabled = False
End If
 MSHFlexGrid1.RemoveItem (Selectrow)
 Selectrow = Empty
 'MSHFlexGrid1.Refresh
End Sub

Private Sub INSERT_Click()
If Selectrow = Empty Then Exit Sub
MSHFlexGrid1.AddItem Date, Selectrow  'Date, Insertrow
For j = 1 To MSHFlexGrid1.Cols - 1
           MSHFlexGrid1.Col = j

           MSHFlexGrid1.CellBackColor = &HFFFF&

Next j
Selectrow = Empty
'MSHFlexGrid1.Refresh
End Sub

Private Sub Form_Load()
 ' Set cn = New ADODB.Connection
 ' With cn
 '       .CursorLocation = adUseClient
 '       .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                           "Persist Security Info=False;" & _
                           "Data Source=E:\menu\test\DataBase\技术项目管理.mdb"
 '      .Open
    
 ' End With
    
  MakeCenter Me
  modelrs.open "机型登记", cn, adOpenKeyset, adLockPessimistic
  Set MSHFlexGrid1.DataSource = modelrs
  
  Call modelShowGrid(modelrs, MSHFlexGrid1)
  
  Selectrow = Empty
  PASTE.Enabled = False
  
End Sub
Public Sub modelShowGrid(ByVal Recordset As ADODB.Recordset, ByVal flexGrid As MSHFlexGrid)
Dim i As Integer
  With flexGrid
        .SelectionMode = flexSelectionByRow
        .ScrollBars = flexScrollBarBoth
        .FillStyle = flexFillSingle
        .ScrollTrack = True
        .AllowUserResizing = flexResizeColumns
  
  
  
        .ColWidth(0) = 5
        .ColWidth(1) = 1
        .ColWidth(2) = 1800
        .ColWidth(3) = 5500
        .ColWidth(4) = 1000
        .ColWidth(5) = 1000
        .ColWidth(6) = 3000
        .ColWidth(7) = 1200
        .ColWidth(8) = 4000

       

        
        .ColAlignment(1) = 2
        .ColAlignment(2) = 2
        .ColAlignment(3) = 2    '水平居中，垂直居中对齐
        .ColAlignment(4) = 2
        .ColAlignment(5) = 4
        .ColAlignment(6) = 4
        .ColAlignment(7) = 4
        .ColAlignment(8) = 2
        
  
  End With
  
  For i = 1 To flexGrid.Rows - 1
       flexGrid.Row = i
       For j = 1 To flexGrid.Cols - 1
           flexGrid.Col = j
           If (flexGrid.Row Mod 2) = 0 Then
               flexGrid.CellBackColor = &HE0E0E0
           Else
               flexGrid.CellBackColor = vbWhite
           End If
       Next j
  Next i
  
  'flexGrid.Refresh
End Sub

Private Sub Form_Unload(Cancel As Integer)
 cn.Close
 Unload Me

End Sub



Private Sub MSHFlexGrid1_SelChange()
    If MSHFlexGrid1.Rows <= 0 Or MSHFlexGrid1.Cols <= 0 Or MSHFlexGrid1.Row = 0 Then
        Exit Sub
    End If
    Selectrow = MSHFlexGrid1.Row

End Sub



Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '在MSFlexGrid的实际应用中经常需要强制整行选并且还需要排序功能，
    '但是由于MSFlexGrid本身的缺陷，在正常情况下是无法实现两者兼得的。
    '唯一的变通方法就是使用MouseDown或MouseUp事件独有的"X","Y"坐标来
    '确定点击的列，再进行排序。
    '这个排序程序已经经过修改，可以实现升序和降序两种排序同时存在。
    Dim i As Long
    Dim j As Long
    Dim Cw As Long
    '如果Y坐标点击的是表头区域
    If y < MSHFlexGrid1.RowHeight(0) Then
        Cw = 0
    '用循环语句判断X在那一列，I代表列数
        For i = 0 To MSHFlexGrid1.Cols - 1
            Cw = Cw + MSHFlexGrid1.ColWidth(i)
            If x < Cw Then Exit For
        Next
        If i < MSHFlexGrid1.Cols Then
        '∧
            If Left(MSHFlexGrid1.TextMatrix(0, i), 1) <> "∨" Then
                For j = 0 To MSHFlexGrid1.Cols - 1
                    If Left(MSHFlexGrid1.TextMatrix(0, j), 1) = "∨" Or Left(MSHFlexGrid1.TextMatrix(0, j), 1) = "∧" Then MSHFlexGrid1.TextMatrix(0, j) = Mid(MSHFlexGrid1.TextMatrix(0, j), 2)
                Next
                MSHFlexGrid1.Col = i     '定位列坐标
                MSHFlexGrid1.Sort = 1    '进行升序排列
                MSHFlexGrid1.TextMatrix(0, i) = "∨" & MSHFlexGrid1.TextMatrix(0, i)
            Else
                For j = 0 To MSHFlexGrid1.Cols - 1
                    If Left(MSHFlexGrid1.TextMatrix(0, j), 1) = "∨" Or Left(MSHFlexGrid1.TextMatrix(0, j), 1) = "∧" Then MSHFlexGrid1.TextMatrix(0, j) = Mid(MSHFlexGrid1.TextMatrix(0, j), 2)
                Next
                MSHFlexGrid1.Col = i     '定位列坐标
                MSHFlexGrid1.Sort = 2    '进行升序排列
                MSHFlexGrid1.TextMatrix(0, i) = "∧" & MSHFlexGrid1.TextMatrix(0, i)
            End If
        End If
    End If
    'Call ShowGrid(modelrs, MSHFlexGrid1)
End Sub


Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim tmptext As String
If Shift = 2 Then
    Select Case KeyCode
        Case vbKeyC
            Clipboard.Clear
            Clipboard.SetText MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, MSHFlexGrid1.Col)
        Case vbKeyV
            If Clipboard.GetFormat(vbCFText) Then
            tmptext = Clipboard.GetText(vbCFText)
            MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, MSHFlexGrid1.Col) = tmptext ' Clipboard.GetData()
            End If
    End Select
End If
End Sub

 Sub BackupFile(Filename As String, Drive As String, Folder As String)
   Dim Fso As New FileSystemObject  '创建 FSO 对象实例
   Dim Dest_path As String, Counter As Long
   Counter = 0
   Do While Counter < 6  '如果驱动器没准备好，继续检测。共检测 6 秒
   Counter = Counter + 1
   Call Waitfor(1)  '间隔 1 秒
   If Fso.Drives(Drive).IsReady = True Then
   Exit Do
   End If
   Loop
   If Fso.Drives(Drive).IsReady = False Then  '6 秒后目标盘仍未准备就绪，退出
   MsgBox " 目标驱动器 " & Drive & " 没有准备好！ ", vbCritical
   Exit Sub
   End If
   If Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size Then
   MsgBox "目标驱动器空间太小！", vbCritical  '目标驱动器空间不够，退出
   Exit Sub
   End If
   If Right(Drive, 1) <> ":" Then
   Drive = Drive & ":"
   End If
   If Left(Folder, 1) <> "\\" Then
   Folder = "\\" & Folder
   End If
   If Right(Folder, 1) <> "\\" Then
   Folder = Folder & "\\"
   End If
   Dest_path = Drive & Folder
   If Not Fso.FolderExists(Dest_path) Then  '如果目标文件夹不存在，创建之
   Fso.CreateFolder Dest_path
   End If
   Fso.copyfile Filename, Dest_path & Fso.GetFileName(Filename), True
    '拷贝，直接覆盖同名文件
   MsgBox " 文件备份完毕。", vbOKOnly
   Set Fso = Nothing
   End Sub
   
   Private Sub Waitfor(Delay As Single)  '延时过程，Delay 单位约为 1 秒
   Dim StartTime As Single
   StartTime = Timer
   Do Until (Timer - StartTime) > Delay
   Loop
   End Sub