?? frmdatagrid.frm
字號:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmDataGrid
BackColor = &H00C0C0C0&
Caption = "成績庫全屏瀏覽"
ClientHeight = 6795
ClientLeft = 1650
ClientTop = 1545
ClientWidth = 9480
Icon = "frmDataGrid.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 6795
ScaleMode = 0 'User
ScaleWidth = 9480
StartUpPosition = 2 'CenterScreen
Begin MSFlexGridLib.MSFlexGrid GrdDATAGRID
Bindings = "frmDataGrid.frx":030A
Height = 6015
Left = 30
TabIndex = 6
Top = 360
Width = 9375
_ExtentX = 16536
_ExtentY = 10610
_Version = 327680
FixedCols = 0
AllowUserResizing= 3
End
Begin ComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 5
Top = 6420
Width = 9480
_ExtentX = 16722
_ExtentY = 661
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 3
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Style = 6
Alignment = 1
AutoSize = 2
TextSave = "1998-09-28"
Key = ""
Object.Tag = ""
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Style = 5
Alignment = 1
AutoSize = 2
TextSave = "22:55"
Key = ""
Object.Tag = ""
EndProperty
BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 11033
Key = ""
Object.Tag = ""
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.PictureBox picButtons
Align = 1 'Align Top
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 330
Left = 0
ScaleHeight = 330
ScaleWidth = 9480
TabIndex = 0
TabStop = 0 'False
Top = 0
Width = 9480
Begin VB.CommandButton cmdClose
Caption = "關閉(&C)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 4398
TabIndex = 4
Tag = "&Close"
Top = 0
Width = 1437
End
Begin VB.CommandButton cmdFilter
Caption = "過濾器(&F)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 2924
TabIndex = 3
Tag = "&Filter"
Top = 0
Width = 1462
End
Begin VB.CommandButton cmdSort
Caption = "排序(&S)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 1462
TabIndex = 2
Tag = "&Sort"
Top = 0
Width = 1462
End
Begin VB.CommandButton cmdRefresh
Caption = "刷新(&R)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 0
TabIndex = 1
Tag = "&Refresh"
Top = 0
Width = 1462
End
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 3150
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 6240
Visible = 0 'False
Width = 1140
End
End
Attribute VB_Name = "frmDataGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim msSortCol As String
Dim mbCtrlKey As Integer
Dim SortStr As String
Sub cmdClose_Click()
FRMKCDW_ID = True
If Data1.Recordset.BOF And Data1.Recordset.EOF Then Unload Me: Exit Sub
Data1.Recordset.MoveFirst
'Data1.Recordset.Close
Unload Me
End Sub
Private Sub cmdFilter_Click()
On Error GoTo FilterErr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
Dim sFilterStr As String
If Data1.RecordsetType = vbRSTypeTable Then
Beep
MsgBox "不能過濾表記錄集！", 48
Exit Sub
End If
Set recRecordset1 = Data1.Recordset '復制記錄集
sFilterStr = InputBox("輸入過濾器表達式(如:課程名稱='高等數學')：")
If Len(sFilterStr) = 0 Then Exit Sub
'Screen.MousePointer = vbHourglass
recRecordset1.Filter = sFilterStr
Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type) '建立過濾器
Set Data1.Recordset = recRecordset2 '賦值為初始記錄集對象
RED
Screen.MousePointer = vbDefault
Exit Sub
FilterErr:
Screen.MousePointer = vbDefault
MsgBox "錯誤：" & err & "，" & err.Description
End Sub
Private Sub cmdRefresh_Click()
On Error GoTo RefErr
Data1.Recordset.Requery
RED
Exit Sub
RefErr:
MsgBox "錯誤：" & err & "，" & err.Description
End Sub
Private Sub cmdSort_Click()
On Error GoTo sorterr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
If Data1.RecordsetType = vbRSTypeTable Then
Beep
MsgBox "不能對表記錄集排序！", 48
Exit Sub
End If
Set recRecordset1 = Data1.Recordset '復制記錄集
If Len(msSortCol) = 0 Then
SortStr = InputBox("輸入排序的列名(不用任何標點符號)：")
If Len(SortStr) = 0 Then Exit Sub
Else
SortStr = msSortCol
End If
'Screen.MousePointer = vbHourglass
recRecordset1.sort = SortStr
'建立排序
Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type)
Set Data1.Recordset = recRecordset2
RESET
RED
Screen.MousePointer = vbDefault
Exit Sub
sorterr:
Screen.MousePointer = vbDefault
MsgBox "錯誤：" & err & "，" & err.Description
End Sub
Private Sub Form_Activate()
'Label1.Visible = True
Dim I As Integer
For I = 0 To Data1.Recordset.Fields.Count - 1
GrdDATAGRID.ColWidth(I) = 1100
Next I
If Data1.Recordset.BOF And Data1.Recordset.EOF Then Exit Sub
RED
StatusBar1.Panels.Item(3).Text = "表中共有" & Data1.Recordset.RecordCount & "條記錄!"
End Sub
Private Sub Form_Load()
Dim bParmQry As Integer
Dim qdfTmp As QueryDef
On Error GoTo LoadErr
'要做的事情：
'gsDatabase 是一個全局字符串，
'它需要在啟動子過程中為應用程序設置好。
'Data1.DatabaseName = GSDATABASE
'gsRecordSource 是一個全局字符串，
'它需要在加載此窗體的子過程中設置好。
'Data1.RecordSource = GSRECORDSOURCE
Data1.RecordsetType = 1 '動態集
Data1.Options = 0
Data1.Refresh
Exit Sub
LoadErr:
MsgBox "錯誤：" & err & "，" & err.Description
Unload Me
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState <> 1 Then
GrdDATAGRID.Height = Me.Height - (425 + picButtons.Height + StatusBar1.Height)
GrdDATAGRID.Width = Me.Width - 150
End If
End Sub
Private Sub grdDataGrid_BeforeDelete(Cancel As Integer)
If MsgBox("刪除當前行嗎？", vbYesNo + vbQuestion) <> vbYes Then
Cancel = True
End If
End Sub
Private Sub grdDataGrid_BeforeUpdate(Cancel As Integer)
If MsgBox("提交改變嗎？", vbYesNo + vbQuestion) <> vbYes Then
Cancel = True
End If
End Sub
'Private Sub grdDataGrid_HeadClick(ByVal ColIndex As Integer)
' '按該列排序
' If Data1.RecordsetType = vbRSTypeTable Then Exit Sub
'
' '檢查是否使用了用于降序排序的 ctrl 鍵
' If mbCtrlKey Then
' msSortCol = "[" & Data1.Recordset(ColIndex).Name & "] desc"
' mbCtrlKey = 0 '復位
' Else
' msSortCol = "[" & Data1.Recordset(ColIndex).Name & "]"
' End If
' cmdSort_Click
' msSortCol = vbNullString '復位
' Dim I As Integer
' For I = 0 To Data1.Recordset.Fields.Count - 1
' GrdDATAGRID.Columns(I).Width = 1100
' Next I
'End Sub
Private Sub grdDataGrid_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
mbCtrlKey = Shift
End Sub
Private Function RED()
Dim RECDATA As Recordset
Set RECDATA = Data1.Recordset
Dim I, J As Integer
Dim NUMDATA As Long
RECDATA.MoveLast
RECDATA.MoveFirst
NUMDATA = RECDATA.Fields.Count
For I = 1 To RECDATA.RecordCount
GrdDATAGRID.Row = I
For J = 4 To NUMDATA - 1
GrdDATAGRID.col = J
If RECDATA.Fields(J).Value < 60 And RECDATA.Fields(J).Value <> 0 And Len(Trim(STR(RECDATA.Fields(J).Value))) <= 5 Then GrdDATAGRID.CellForeColor = &HFF
If RECDATA.Fields(J).Value = 0 Then GrdDATAGRID.CellForeColor = &HFF0000
If Len(Trim(STR(RECDATA.Fields(J).Value))) > 5 Then GrdDATAGRID.CellForeColor = &HFF00FF
Next J
RECDATA.MoveNext
Next I
' For I = 2 To flexResult.Rows
' flexResult.Row = I - 1
' flexResult.col = 5
' flexResult.CellBackColor = &HFFFF00
' Next I
End Function
Function RESET()
'按該列排序
If Data1.RecordsetType = vbRSTypeTable Then Exit Function
'檢查是否使用了用于降序排序的 ctrl 鍵
If mbCtrlKey Then
msSortCol = "[" & SortStr & "] desc"
mbCtrlKey = 0 '復位
Else
msSortCol = "[" & SortStr & "] DESC" 'Data1.Recordset(ColIndex).Name & "]"
End If
'cmdSort_Click
msSortCol = vbNullString
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -