主菜单.frm

计算机CAD图纸管理和预览

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public tablename As String
Public rssupplier As New ADODB.Recordset
Public rsmodel As New ADODB.Recordset
Public Selectrow As Long
Public Copyrow As Long
Public Pasterow As Long
Public sqlselectmodel As String
Public rstable As New ADODB.Recordset





Private Sub dwgman_Click()
  dwgmanager.Show
  
End Sub

Private Sub Form_Load()

    MakeCenter 主菜单
    Me.Show
    mainStatusBar.Panels.Item(1).Text = mainStatusBar.Panels.Item(1).Text + loginuser
    
    If UserType = True Then
        Me.Caption = Me.Caption + "[技术人员:" + loginuser + "]"
    Else
        Me.Caption = Me.Caption + "[普通人员:" + loginuser + "]"
    End If
    
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
   
    menubar.Buttons("paste").Enabled = False
    mainGrid.Visible = False
    modelbar.Visible = False
    tablebar.Visible = False
    tableinbar.Visible = False
    tableinbar.Visible = 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

        .ColAlignmentFixed(1) = 4
        .ColAlignmentFixed(2) = 4     '设置表格标题的对齐方式
        .ColAlignmentFixed(3) = 4
        .ColAlignmentFixed(4) = 4
        .ColAlignmentFixed(5) = 4
        .ColAlignmentFixed(6) = 4
        .ColAlignmentFixed(7) = 4
        .ColAlignmentFixed(8) = 4
        
        .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)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    Dim frm As Form
    For Each frm In Forms '销毁所有窗口
        Unload frm
    Next frm

End Sub


Private Sub about_Click(index As Integer)
 frmAbout.Show
 
End Sub

Private Sub exit_Click(index As Integer)
    If MsgBox("您将要退出技术管理软件？", vbQuestion + vbYesNo, "提醒 " & loginuser) = vbYes Then
      
         Unload Me
    End If
End Sub




Private Sub supplier_Click()
 
  Dim sqlsupplier As String
  sqlsupplier = "SELECT * FROM 取引先"
 
  Call rssupplier.open(sqlsupplier, cn, adOpenKeyset, adLockOptimistic, -1)
  mainStatusBar.Panels(2).Text = "取引先" + ",总数: " + Trim(rssupplier.RecordCount)
  mainGrid.Visible = True
  Set mainGrid.DataSource = rssupplier
  
  Call supplierShowGrid(rssupplier, mainGrid)

  rssupplier.Close
  
End Sub
Public Sub supplierShowGrid(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) = 1000
        .ColWidth(3) = 1500
        .ColWidth(4) = 5000
        .ColWidth(5) = 1500
        .ColWidth(6) = 6000
        .ColWidth(7) = 2500
        .ColWidth(8) = 2500
        .ColWidth(9) = 800
        .ColWidth(10) = 800
        .ColWidth(11) = 1000
        .ColWidth(12) = 800
       
        .ColAlignmentFixed(1) = 4
        .ColAlignmentFixed(2) = 4     '设置表格标题的对齐方式
        .ColAlignmentFixed(3) = 4
        .ColAlignmentFixed(4) = 4
        .ColAlignmentFixed(5) = 4
        .ColAlignmentFixed(6) = 4
        .ColAlignmentFixed(7) = 4
        .ColAlignmentFixed(8) = 4
        .ColAlignmentFixed(9) = 4
        .ColAlignmentFixed(10) = 4
        .ColAlignmentFixed(11) = 4
        .ColAlignmentFixed(12) = 4
       
       
       
        .ColAlignment(1) = 2
        .ColAlignment(2) = 2
        .ColAlignment(3) = 2    '水平居中，垂直居中对齐
        .ColAlignment(4) = 2
        .ColAlignment(5) = 2
        .ColAlignment(6) = 2
        .ColAlignment(7) = 2
        .ColAlignment(8) = 4
        .ColAlignment(9) = 4
        .ColAlignment(10) = 4
        .ColAlignment(11) = 4
        .ColAlignment(12) = 4
        
  
  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 tablebar_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.Key
     Case "exit"
       mainGrid.Visible = False
       mainbar.Visible = False
       modelbar.Visible = True
       tablebar.Visible = False
       tableinbar.Visible = False
       Call modelshow
       
     Case "copy"
       If Selectrow = Empty Then
         MsgBox "您尚未选择被拷贝行", vbInformation, "提醒"
         Exit Sub
       End If
       tablebar.Buttons("paste").Enabled = True
       Copyrow = Selectrow
       Selectrow = Empty
     Case "paste"
        Dim n As Integer
        If Copyrow = Empty Then Exit Sub
        If Selectrow = Empty Then
          MsgBox "您尚未选择粘贴行", vbInformation, "提醒"
          Exit Sub
        End If
        Pasterow = Selectrow
        If Pasterow = Copyrow Then Exit Sub
    
        For n = 1 To mainGrid.Cols - 1
           If n > 2 Then
             mainGrid.TextMatrix(Pasterow, n) = mainGrid.TextMatrix(Copyrow, n)
           End If
           mainGrid.Col = n
           mainGrid.CellBackColor = &HFFFF&
    
        Next n
        Selectrow = Empty
        
     Case "delete"
       If Selectrow = Empty Then
         MsgBox "您尚未选择被删除行", vbInformation, "提醒"
         Exit Sub
       End If
       If Selectrow = Copyrow Then
         tablebar.Buttons("paste").Enabled = False
       End If
       mainGrid.RemoveItem (Selectrow)
       Selectrow = Empty
       
     Case "insert"
       If Selectrow = Empty Then
         MsgBox "您尚未选择插入行", vbInformation, "提醒"
         Exit Sub
       End If
       mainGrid.AddItem "", Selectrow  'Date, Insertrow
       For j = 1 To mainGrid.Cols - 1
           mainGrid.Col = j

           mainGrid.CellBackColor = &HFFFF&

       Next j
       Selectrow = Empty
     
     Case "modify"
       If Selectrow = Empty Then
         MsgBox "您尚未选择修改行", vbInformation, "提醒"
         Exit Sub
       End If
       '
       Selectrow = Empty
         
     Case "tablein"
        tableinbar.Visible = True
             
     
     Case "save"
     
  End Select
End Sub

Private Sub modelbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.Key
     Case "exit"
       mainGrid.Visible = False
       mainbar.Visible = True
       modelbar.Visible = False
       tablebar.Visible = False
       tableinbar.Visible = False
       mainStatusBar.Panels(2).Text = ""
       
     Case "allmodel"
       Call modelshow
       
     Case "newmodel"
       newmodel.Show
     Case "extend"
       If Selectrow = Empty Then
         MsgBox "您尚未选择机型", vbInformation, "提醒"
         Exit Sub
       End If
       Call extendtable
       Selectrow = Empty
     Case "tablein"
       If Selectrow = Empty Then
         MsgBox "您尚未选择机型", vbInformation, "提醒"
         Exit Sub
       End If
       savetablename = Trim(mainGrid.TextMatrix(Selectrow, 2))   '存储机型名称
       mainGrid.Visible = False
       mainbar.Visible = False
       modelbar.Visible = False
       tablebar.Visible = False
       tableinbar.Visible = True
       tableoption = 0
       tableinbar.Buttons("save").Enabled = False
       
     Case "tableout"
     
     
     
     Case "copy"
       If Selectrow = Empty Then
         MsgBox "您尚未选择被拷贝行", vbInformation, "提醒"
         Exit Sub
       End If
       modelbar.Buttons("paste").Enabled = True
       Copyrow = Selectrow
       Selectrow = Empty
     Case "paste"
        Dim n As Integer
        If Copyrow = Empty Then Exit Sub
        If Selectrow = Empty Then
          MsgBox "您尚未选择粘贴行", vbInformation, "提醒"
          Exit Sub
        End If
        Pasterow = Selectrow
        If Pasterow = Copyrow Then Exit Sub