⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmattribute.frm

📁 师兄做的一个利用VB结合mapx组件做的超市查询小系统
💻 FRM
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx"
Begin VB.Form frmAttribute 
   Caption         =   "属性数据"
   ClientHeight    =   6720
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   9750
   LinkTopic       =   "Form1"
   ScaleHeight     =   6720
   ScaleWidth      =   9750
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdOperation 
      Caption         =   "操作"
      Height          =   375
      Left            =   6960
      TabIndex        =   4
      Top             =   6240
      Width           =   1455
   End
   Begin VB.CommandButton cmdAll 
      Caption         =   "全部"
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   6240
      Width           =   1200
   End
   Begin VB.CommandButton cmdSelected 
      Caption         =   "选中"
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   6240
      Width           =   1200
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid 
      Height          =   6135
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   9735
      _ExtentX        =   17171
      _ExtentY        =   10821
      _Version        =   393216
      FixedCols       =   0
      BackColorBkg    =   16777215
      AllowUserResizing=   3
   End
   Begin VB.Label lblSelected 
      Height          =   300
      Left            =   120
      TabIndex        =   1
      Top             =   6360
      Width           =   2370
   End
   Begin VB.Menu mnuOperation 
      Caption         =   "操作"
      Begin VB.Menu mnuSQLSearch 
         Caption         =   "SQL查询"
      End
      Begin VB.Menu mnuExport 
         Caption         =   "输出"
      End
   End
   Begin VB.Menu mnuOperation1 
      Caption         =   "操作1"
      Begin VB.Menu mnuStatistic 
         Caption         =   "统计"
      End
   End
End
Attribute VB_Name = "frmAttribute"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim oLayer As MapXLib.Layer
Dim oDS As MapXLib.DataSet
Dim sFile As String
Dim Col As Integer


Private Sub cmdAll_Click()
  Call FillData
End Sub

Private Sub cmdOperation_Click()
  PopupMenu mnuOperation
End Sub

Private Sub cmdSelected_Click()
  Call FillSeletedData
  cmdAll.Enabled = True
End Sub

Private Sub Form_Load()
  cmdAll.Enabled = False
  mnuOperation.Visible = False
  Call FillData
End Sub

Private Sub Form_Resize()
  Me.MSFlexGrid.Top = 0
  Me.MSFlexGrid.Left = 0
  Me.MSFlexGrid.Width = Me.ScaleWidth
  Me.MSFlexGrid.Height = Me.ScaleHeight - 500
  
  Me.lblSelected.Top = Me.ScaleHeight - 400
  Me.lblSelected.Left = 0
  
  Me.cmdSelected.Left = Me.ScaleWidth * 0.3
  Me.cmdSelected.Top = Me.ScaleHeight - 400
  Me.cmdAll.Left = Me.ScaleWidth * 0.3 + 1500
  Me.cmdAll.Top = Me.ScaleHeight - 400
  
  Me.cmdOperation.Left = Me.ScaleWidth * 0.7
  Me.cmdOperation.Top = Me.ScaleHeight - 400
End Sub

Public Function FillData()
  Dim oFtr As MapXLib.Feature
  Dim oFtrs As MapXLib.Features
  Dim i As Integer, J As Integer
    
  Set oLayer = frmMain.MapDisp.Layers(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  Set oDS = frmMain.MapDisp.DataSets(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  
 
  Me.MSFlexGrid.Cols = oDS.fields.Count
  
  For i = 0 To oDS.fields.Count - 1
    Me.MSFlexGrid.TextMatrix(0, i) = oDS.fields(i + 1).Name
  Next i
  

    Set oFtrs = oLayer.AllFeatures
    Me.MSFlexGrid.Rows = oFtrs.Count + 1
    
    Screen.MousePointer = vbHourglass
    
    For i = 1 To oFtrs.Count
        Set oFtr = oFtrs.Item(1)
        For J = 1 To oDS.fields.Count
            Me.MSFlexGrid.TextMatrix(i, J - 1) = oDS.Value(i, J)
        Next J
    Next i
    
    Screen.MousePointer = vbDefault
    
    lblSelected.Caption = "共有" + CStr(oFtrs.Count) + "个记录," + CStr(oLayer.Selection.Count) + "个选中!"


  Set oLayer = Nothing
  Set oDS = Nothing

End Function
  
Public Function FillSeletedData()
  Dim oFtr As MapXLib.Feature
  Dim oFtrs As MapXLib.Features
  Dim i As Integer, J As Integer
    
  Set oLayer = frmMain.MapDisp.Layers(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  Set oDS = frmMain.MapDisp.DataSets(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  
 
  Me.MSFlexGrid.Cols = oDS.fields.Count
  
  For i = 0 To oDS.fields.Count - 1
    Me.MSFlexGrid.TextMatrix(0, i) = oDS.fields(i + 1).Name
  Next i
  
  Set oFtrs = oLayer.Selection
  Me.MSFlexGrid.Rows = oLayer.Selection.Count + 1
  
  Screen.MousePointer = vbHourglass

    For i = 1 To oLayer.Selection.Count
        Set oFtr = oLayer.Selection.Item(i)
        For J = 1 To oDS.fields.Count
            Me.MSFlexGrid.TextMatrix(i, J - 1) = oDS.Value(oFtr, J)
        Next J
    Next i

    Screen.MousePointer = vbDefault

  Set oLayer = Nothing
  Set oDS = Nothing

End Function

Private Sub mnuExport_Click()
  Dim sType As String
  
  frmMain.cdlTest.Filter = "(*.txt)|*.txt|(*.xls)|*.xls"
  frmMain.cdlTest.ShowSave
  sFile = frmMain.cdlTest.FileName
  
  If sFile = "" Then
    Exit Sub
  Else
    sType = Right(sFile, 3)
    
    Select Case sType
      Case "txt":
          Call ExportToTXT
      Case "xls":
          Call ExportToXLS
    End Select
  End If
End Sub

Private Sub mnuSQLSearch_Click()
  b_Select = True
  frmSearchSQL.Show
End Sub

Public Function ExportToTXT()
  Dim fso As New FileSystemObject, f As TextStream
  Dim i As Integer, J As Integer
  Dim strValue As String, t As String
  
  fso.CreateTextFile sFile
  Set f = fso.OpenTextFile(sFile, ForAppending, True, TristateFalse)
  
  For i = 0 To MSFlexGrid.Rows - 1
    For J = 0 To MSFlexGrid.Cols - 1
        sValue = MSFlexGrid.TextMatrix(i, J)
        sValue = sValue & "   "
        t = t + sValue
    Next J
    f.WriteLine (t)
    t = ""
  Next i
        
End Function

Public Function ExportToXLS()
  Dim xlApp As Excel.Application
  Dim i As Integer, J As Integer
  
  Set xlApp = New Excel.Application
  xlApp.Workbooks.Add (True)
  
  For i = 0 To Me.MSFlexGrid.Rows - 1
     For J = 0 To Me.MSFlexGrid.Cols - 1
       With xlApp
           .Cells(i + 1, J + 1) = Me.MSFlexGrid.TextMatrix(i, J)
       End With
     Next J
  Next i
  
   xlApp.Visible = True
  Set xlApp = Nothing
End Function

Private Sub mnuStatistic_Click()
    Dim i As Integer
    Dim RowCount As Integer
    Dim fData() As Single
    Dim fAve As Single
    Dim dSum As Double
    Dim fMax As Single
    Dim fMin As Single
    Dim strExpress As String
    Dim cls As clsStatistic
    
    RowCount = Me.MSFlexGrid.Rows - 1
    ReDim fData(1 To RowCount) As Single
    
    For i = 1 To RowCount
        fData(i) = CSng(Me.MSFlexGrid.TextMatrix(i, Col))
    Next i
    
    Set cls = New clsStatistic
    fAve = cls.GetAverage(fData(), RowCount)
    dSum = fAve * RowCount
    fMax = cls.GetMax(fData(), RowCount)
    fMin = cls.GetMin(fData(), RowCount)
    
    strExpress = Chr$(13) + Chr$(10) + " "
    strExpress = strExpress + "最大值:" + Str(fMax) + Chr$(13) + Chr$(10) + " "
    strExpress = strExpress + "最小值:" + Str(fMin) + Chr$(13) + Chr$(10) + " "
    strExpress = strExpress + "平均值:" + Str(fAve) + Chr$(13) + Chr$(10) + " "
    strExpress = strExpress + "总和  :" + Str(dSum) + Chr$(13) + Chr$(10) + " "
    
    MsgBox strExpress
End Sub

Private Sub MSFlexGrid_Click()
  Col = MSFlexGrid.ColSel
End Sub

Private Sub MSFlexGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = 2 Then
    PopupMenu mnuOperation1
  End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -