📄 frmdatagrid.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmDataGrid
AutoRedraw = -1 'True
BorderStyle = 0 'None
ClientHeight = 6810
ClientLeft = 2865
ClientTop = 1380
ClientWidth = 9165
ClipControls = 0 'False
ControlBox = 0 'False
LinkTopic = "Form1"
MDIChild = -1 'True
PaletteMode = 2 'Custom
ScaleHeight = 6810
ScaleMode = 0 'User
ScaleWidth = 9165
ShowInTaskbar = 0 'False
Begin VB.CommandButton CmdWide
Caption = "放大列宽"
Height = 330
Left = 1035
TabIndex = 6
Top = 135
Width = 915
End
Begin VB.CommandButton CMDthin
Caption = "缩小列宽"
Height = 330
Left = 120
TabIndex = 5
Top = 135
Width = 915
End
Begin VB.Timer Timer2
Interval = 5000
Left = 2025
Top = 2925
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 100
Left = 360
Top = 2790
End
Begin MSFlexGridLib.MSFlexGrid flxgd1
Bindings = "frmDataGrid.frx":0000
Height = 1575
Left = 45
TabIndex = 3
Top = 510
Width = 6105
_ExtentX = 10769
_ExtentY = 2778
_Version = 327680
Rows = 5
Cols = 6
FixedCols = 0
RowHeightMin = 300
BackColor = 16777215
BackColorFixed = 16777215
ForeColorFixed = 0
BackColorSel = 16777215
ForeColorSel = -2147483646
BackColorBkg = 16777215
GridColor = 0
FocusRect = 2
HighLight = 2
FillStyle = 1
GridLinesFixed = 1
ScrollBars = 2
AllowUserResizing= 3
MousePointer = 1
FormatString = " "
End
Begin VB.PictureBox Pic
Height = 435
Left = 3930
ScaleHeight = 375
ScaleWidth = 2085
TabIndex = 0
Top = 2550
Width = 2145
Begin VB.CommandButton CmdExit
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 1050
TabIndex = 2
Top = 15
Width = 1035
End
Begin VB.CommandButton CmdPrint
Caption = "打印"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = -15
TabIndex = 1
Top = 15
Width = 1035
End
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 300
Left = 2505
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 2175
Visible = 0 'False
Width = 1140
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "Label1"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = -15
TabIndex = 4
Top = -15
Width = 8760
End
Begin VB.Menu mnufile
Caption = "1"
Visible = 0 'False
Begin VB.Menu mnuprint
Caption = "打印&D"
End
Begin VB.Menu mnuL
Caption = "-"
End
Begin VB.Menu mnuclose
Caption = "退出&T"
End
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 biaox As Integer
Dim fdHave As Integer
Dim rdHave As Integer
Dim msSortCol As String
Dim mbCtrlKey As Integer
Dim Yinshen As Single
Dim fuyuanP As Single
Dim fuyuanF As Single
Dim PbarVal As Integer 'progressbar 的值
Private Sub cmdRefresh_Click()
On Error GoTo RefErr
Data1.Recordset.Requery
Exit Sub
RefErr:
MsgBox "错误：" & Err & "，" & Err.Description
End Sub
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdPrint_Click()
Dim SHIJIAN As String
Dim iwait2 As Integer
Dim h As Single
'==============
Dim h1 As Integer
Dim h2 As Integer '50- 一循环
Dim h2Ys As Single
Dim r As Integer
DoEvents
If Me.Width > 4000 Then
Printer.CurrentX = Me.Width / 3 - 200
Else
Printer.CurrentX = 200
End If
Printer.CurrentY = 200
Printer.FontBold = True
DoEvents
Printer.Print Label1.Caption
DoEvents
DoEvents
'MsgBox "请稍等,正在打印!"
Printer.Line (150, 480)-(Me.Width - 150, 480)
'========以下打印 够40(x 将来希望可以自由设定) 行
h2 = Int((flxgd1.Rows - 1) / 50) '够h2个40行
h2Ys = flxgd1.Rows - 1 - h2 * 50 '余下多少行
DoEvents
For h1 = 1 To h2 '够40一循环
For h = 0 To 50 '打印 40 行
flxgd1.Row = h + (h1 - 1) * 50 'flxgd1中的每40行的第一行
'==子程序
Call 打印flxgd1行(h)
Next h
Printer.EndDoc '40行打印一回
Next h1
'===========Ys--print 打印 余下的 和 收尾
For h = 0 To h2Ys
flxgd1.Row = h + h2 * 50
'=子程序
Call 打印flxgd1行(h)
Next h
Printer.FontSize = 10
DoEvents
If biaox = 1 Then
Printer.CurrentY = Printer.CurrentY + 300
Printer.CurrentX = Me.Width / 2
Printer.Print " '/'右边位补考后的成绩,统计以补考前的成绩记!"
End If
Printer.CurrentY = Printer.CurrentY + 400
Printer.CurrentX = Me.Width / 2
DoEvents
Printer.FontName = Me.FontName
DoEvents
Printer.FontSize = 12
DoEvents
SHIJIAN = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日"
DoEvents
DoEvents
Printer.Print SHIJIAN
Printer.EndDoc
End Sub
Private Sub CMDthin_Click()
For i = 0 To flxgd1.Cols - 1
flxgd1.ColWidth(i) = flxgd1.ColWidth(i) * 0.98
flxgd1.Refresh
Next i
End Sub
Private Sub CmdWide_Click()
For i = 0 To flxgd1.Cols - 1
flxgd1.ColWidth(i) = flxgd1.ColWidth(i) / 0.98
flxgd1.Refresh
Next i
End Sub
Private Sub flxgd1_GotFocus()
Dim str As String
Dim fld As Field
Dim fdname As String
On Error GoTo end1
If flxgd1.Row <> 1 Or Right(Trim(Data1.Recordset(flxgd1.Col).Name), 1) = ")" Then
Pic.SetFocus
GoTo end1
End If
If Data1.RecordsetType = vbRSTypeTable Then Exit Sub
For i = 1 To 4
flxgd1.CellBackColor = vbBlue
DoEvents
Next i
'检查是否使用了用于降序排序的 ctrl 键
If mbCtrlKey Then
msSortCol = "[" & Data1.Recordset(flxgd1.Col).Name & "] desc"
mbCtrlKey = 0 '复位
Else
msSortCol = "[" & Data1.Recordset(flxgd1.Col).Name & "] desc"
End If
fdname = Data1.Recordset(flxgd1.Col).Name '按谁排的名
cmdSortClick
msSortCol = vbNullString '复位
'============
flxgd1.Row = 0
For i = 2 To flxgd1.Cols - 1
DoEvents
DoEvents
flxgd1.Col = i
If flxgd1.Text = "排名" Then
Exit For
End If
Next
If flxgd1.Text <> "排名" Then
MsgBox "要想显示排名,请重新统计毕业表!"
Exit Sub
End If
Data1.Recordset.MoveFirst
If Len(Data1.RecordSource) < 20 Then
If fdname = "学分" Or fdname = "平均分" Or fdname = "总分" Then '平均分是为毕业表留的
For i = 1 To flxgd1.Rows - 2
Data1.Recordset.Edit
Data1.Recordset.Fields("排名").Value = i
Data1.Recordset.Update
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -