frmdatagrid.frm

我编的学分管理程序,安装包原代码都有!VB入门的好东西

     Data1.Recordset.MoveNext
      Next i
    Data1.Refresh
  
   End If
     msSortCol = "排名"
     cmdSortClick
Else
  For i = 1 To flxgd1.Rows - 2 '==为SQL语言连接的表排序用
   flxgd1.Row = i
   flxgd1.Text = i
   Next i
End If

Me.SetFocus
Exit Sub
end1:
flxgd1.Refresh
End Sub

Private Sub flxgd1_LostFocus()
  flxgd1.BackColor = vbWhite
End Sub

Private Sub flxgd1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
flxgd1.MousePointer = 1

End Sub

Private Sub Form_Load()
    Dim bParmQry As Integer
    Dim qdfTmp As QueryDef
    Dim id As Integer
    Dim fdname As String
    Dim rdtemp As Recordset
    On Error GoTo LoadErr
    
   '要做的事情：
    'gsDatabase 是一个全局字符串，
    '它需要在启动子过程中为应用程序设置好。
   ' Data1.DatabaseName = gsDatabase
    'gsRecordSource 是一个全局字符串，
    '它需要在加载此窗体的子过程中设置好。
   ' Data1.RecordSource = gsRecordsource
   ' Data1.RecordsetType = 1     '动态集
   ' Data1.Options = 0
   ' Data1.Refresh

    'If Len(Data1.RecordSource) > 50 Then
    '    Me.Caption = "SQL 语句"
   ' Else
    '    Me.Caption = Data1.RecordSource
    'End If
    flxgd1.Font.Bold = True
    flxgd1.Font.Size = 10
    
    
    flxgd1.ColWidth(0) = 500
 
 flxgd1.ColWidth(1) = 880

 flxgd1.Width = 1480
  If Len(Gnm) <= 20 Then 'ifaa
  biaox = 1 '打印用
  
   
    
   rdHave = scoretab.RecordCount '??

   fdHave = scoretab.Fields.Count
 
flxgd1.Cols = fdHave + 1
flxgd1.Rows = rdHave + 1
For id = 2 To fdHave - 1

fdname = scoretab.Fields(id).Name
DoEvents
If Len(fdname) > 3 Then
frmDataGrid.flxgd1.ColWidth(id) = Len(fdname) * 190

Else
frmDataGrid.flxgd1.ColWidth(id) = 700

End If
frmDataGrid.flxgd1.Width = flxgd1.Width + flxgd1.ColWidth(id)

Next id



Else 'ifaa
 biaox = 2 '打印用 定义第一列宽

Data1.DatabaseName = dbname.Name
Data1.RecordSource = Gnm
Gnm = vbNull
Data1.Refresh
Set rdtemp = Data1.Recordset
fdHave = flxgd1.Cols
flxgd1.ColWidth(0) = 1130


 flxgd1.Width = 1160
For id = 1 To fdHave - 1
fdname = rdtemp.Fields(id).Name
DoEvents
If Len(fdname) > 3 Then
frmDataGrid.flxgd1.ColWidth(id) = Len(fdname) * 198

Else
frmDataGrid.flxgd1.ColWidth(id) = 740

End If
frmDataGrid.flxgd1.Width = flxgd1.Width + flxgd1.ColWidth(id) + 20

Next id
'rdtemp.MoveFirst
'rdtemp.Delete
'flxgd1.Cols = rdtemp.Fields.Count
'flxgd1.Rows = rdtemp.RecordCount
Label1.Caption = Xq & "学分表"
DoEvents
Me.Top = 10
DoEvents
DoEvents
Me.Left = 10
DoEvents

End If 'ifaa
flxgd1.Height = flxgd1.Rows * 301 + 120


DoEvents
DoEvents

DoEvents
DoEvents
frmDataGrid.Width = coverFrm.Width - 300
If Me.Width <= flxgd1.Width Then
Me.Width = flxgd1.Width + 200
Else
flxgd1.Left = Me.Width / 2 - flxgd1.Width / 2
End If
frmDataGrid.Height = coverFrm.Height - 500
If Me.Height <= flxgd1.Height Then
Me.Height = flxgd1.Height + 1150
End If

frmDataGrid.Pic.Top = flxgd1.Height + flxgd1.Top + 150
If frmDataGrid.Pic.Width * 1.8 < frmDataGrid.Width Then  'if 1
frmDataGrid.Pic.Left = frmDataGrid.Width / 2 - 160
DoEvents

Else
frmDataGrid.Pic.Left = 20
End If ' if1

Label1.Left = 10
Label1.Width = Me.Width - 10
Label1.Top = 20
DoEvents
DoEvents

Timer1.Enabled = True
DoEvents
DoEvents
 
  kaishifrm.Hide
    Exit Sub

LoadErr:
If Err.Number = 3061 Then
 MsgBox "成绩不全!"
Unload Me
 Exit Sub
 End If
MsgBox "错误：" & Err & "，" & Err.Description
Unload Me
 Exit Sub
End Sub

Private Sub Form_Resize()
'保留
'On Error Resume Next
  ' coverFrm.Width = Me.Width + 200
  ' coverFrm.Height = Me.Height + 450
End Sub
'=========================

Private Sub flxgd1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 2 Then
frmDataGrid.PopupMenu mnufile
   End If
End Sub

Private Sub flxgd1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mbCtrlKey = Shift
End Sub

Private Sub Form_Unload(Cancel As Integer)
DoEvents


'==调整 coverfrm的大小
'coverFrm.WindowState = 0
'coverFrm.Width = 7900

DoEvents
DoEvents
DoEvents
coverFrm.WindowState = 2
'coverFrm.SetFocus

DoEvents
'kaishifrm.Text2(1).SetFocus
kaishifrm.Show


DoEvents
DoEvents
End Sub

Private Sub mnuclose_Click()
 Unload Me
End Sub

Private Sub MNUprint_Click()
On Error GoTo noprint
Dim paperI As Integer
Dim b As Integer



    CmdPrint_Click
    DoEvents
    'Timer2.Enabled = True
    'DoEvents
   

    Exit Sub
noprint:
MsgBox "没有有效的打印机!请安装打印机!"
End Sub
 Sub cmdSortClick()
    On Error GoTo SortErr

    Dim recRecordset1 As Recordset, recRecordset2 As Recordset
    Dim SortStr As String

    If Data1.RecordsetType = vbRSTypeTable Then
        Beep
        MsgBox "不能对表记录集排序！", 48
        Exit Sub
    End If

Data1.Refresh
    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
    
    Screen.MousePointer = vbDefault
    DoEvents
    Pic.SetFocus
 
    Exit Sub
    
SortErr:
    Screen.MousePointer = vbDefault
    MsgBox "错误：" & Err & "，" & Err.Description
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
DoEvents
DoEvents


DoEvents
DoEvents


Pic.SetFocus
End Sub
Sub 打印flxgd1行(hnG As Single)

Dim lie As Integer
Dim l As Integer
Dim Liewidth As Integer
If hnG = 0 Then flxgd1.Row = 0
Printer.Line (150, 280 * hnG + 800)-(Me.Width - 150, 280 * hnG + 800)
For l = 0 To flxgd1.Cols - 1
Printer.CurrentY = 280 * hnG + 800
flxgd1.Col = l
Select Case l
Case 0
Printer.CurrentX = 200
Liewidth = 200
Case Else
Liewidth = 200
For lie = 0 To l - 1
Liewidth = Liewidth + flxgd1.ColWidth(lie)
Next lie
Printer.CurrentX = Liewidth
End Select
DoEvents
Printer.FontName = Me.FontName
Printer.FontSize = 10
DoEvents
Printer.Print flxgd1.Text


Next l
End Sub

Private Sub Timer2_Timer()
DoEvents
Timer2.Enabled = False

DoEvents
End Sub