?? cjb1.bas
字號:
Attribute VB_Name = "Module1"
'***** 丹青閣電腦工作室 楊富城 編寫代碼 *****
'***** *****
'***** 學生成績管理系統全局模塊 *****
'***** *****
'**********************************************************
'存儲關于子窗體信息的用戶自定義類型
Type formstate
Deleted As Integer
Dirty As Integer
Color As Long
End Type
Public FState() As formstate '用戶自定義數組
Public Doc() As New frmBG '子窗體對象數組
Public Const ThisApp = "管理系統" '定義 ThisApp 函數
Public Const ThisKey = "Recent Files" '定義 ThisKey 函數
Sub Main() '啟動窗體
frmSplash.Show
frmSplash.Refresh
End Sub
Function AnyPadsLeft() As Integer
'檢測是否還有打開的子窗體
Dim i As Integer
For i = 1 To UBound(Doc)
If Not FState(i).Deleted Then
AnyPadsLeft = True
Exit Function
End If
Next
End Function
Sub FileNew() '新建文件過程
Dim fIndex As Integer
'找到下一個可用的索引并顯示該子窗體
fIndex = FindFreeIndex()
Doc(fIndex).Tag = fIndex
Doc(fIndex).Caption = "新成績表:" & fIndex
Doc(fIndex).Show
End Sub
Function FindFreeIndex() As Integer '空文件索引檢索過程
Dim i As Integer
Dim ArrayCount As Integer
ArrayCount = UBound(Doc)
For i = 1 To ArrayCount
If FState(i).Deleted Then
FindFreeIndex = i
FState(i).Deleted = False
Exit Function
End If
Next
'如果子窗體對象數組中沒有一個元素被刪除,
'文檔數組與狀態數組均加 1 并返回新元素的索引(Index)。
ReDim Preserve Doc(ArrayCount + 1)
ReDim Preserve FState(ArrayCount + 1)
FindFreeIndex = UBound(Doc)
End Function
Sub GetRecentFiles() '讀注冊表數據,更新“文件”菜單
Dim i, j As Integer
Dim VarFiles As Variant
'用 Getallsettings 語句從注冊表中返回最近使用過的文件
'常數 ThisApp 和 ThisKey 已在模塊中定義
If GetSetting(ThisApp, ThisKey, "Recentfile1") = Empty Then Exit Sub
VarFiles = GetAllSettings(ThisApp, ThisKey)
For i = 0 To UBound(VarFiles, 1)
frmMain.mnuRecentFile(0).Visible = True
frmMain.mnuRecentFile(i).Caption = VarFiles(i, 1)
frmMain.mnuRecentFile(i).Visible = True
'更新所有子窗體的“文件”菜單
For j = 1 To UBound(Doc)
If Not FState(j).Deleted Then
Doc(j).mnuRecentFile(0).Visible = True
Doc(j).mnuRecentFile(i + 1).Caption = VarFiles(i, 1)
Doc(j).mnuRecentFile(i + 1).Visible = True
End If
Next j
Next i
End Sub
Sub WriteRecentFiles(OpenFileName) '寫注冊表數據
'本過程使用 SaveSettings 語句將最近使用的文件名寫入系統注冊表
Dim i, j As Integer
Dim strFile, Key As String
' 將文件 RecentFile1 復制給 RecentFile2 等等
For i = 3 To 1 Step -1
Key = "RecentFile" & i
strFile = GetSetting(ThisApp, ThisKey, Key)
If strFile <> "" Then
Key = "RecentFile" & (i + 1)
SaveSetting ThisApp, ThisKey, Key, strFile
End If
Next i
'將正在打開的文件寫到最近使用的文件列表的第一項
SaveSetting ThisApp, ThisKey, "RecentFile1", OpenFileName
End Sub
Function Fgi(r As Integer, c As Integer) As Integer
'表格單元值函數
Fgi = c + frmMain.ActiveForm.ChengJB.Cols * r
End Function
Sub CopyThing(a, b, c, d As Integer) '復制過程
Dim i, j As Integer
Dim CopyText As String
CopyText = ""
With frmMain.ActiveForm
For i = a To b
For j = c To d
CopyText = CopyText & .ChengJB.TextArray(Fgi((i), (j)))
If j <> d Then
CopyText = CopyText & vbTab
End If
Next j
If i <> b Then
CopyText = CopyText & vbCrLf
End If
Next i
Clipboard.Clear
Clipboard.SetText CopyText
End With
End Sub
Sub FontChang(s As String) '字體變化過程
With frmMain.ActiveForm
Dim Abc
Abc = .ChengJB.Font.Size + s
If Abc > 0 Then .ChengJB.Font.Size = Abc
For i = 2 To 17
.ChengJB.ColWidth(i) = .ChengJB.ColWidth(1) * 7 / 8
Next
.ChengJB.ColWidth(18) = .ChengJB.ColWidth(1) * 5 / 8
.txtedit.Font.Size = .ChengJB.Font.Size
FState(.Tag).Dirty = True
frmMain.sbStatusBar.Panels(3).Text = "當前表格字號 " & .ChengJB.Font.Size
End With
End Sub
Sub Chushi()
'初始化主窗體狀態欄
With frmMain.ActiveForm
If .TextShuxing(1).Text <> "Text1" Then
frmMain.sbStatusBar.Panels(1).Text = _
"班級:" & .TextShuxing(1).Text & " " & .TextShuxing(2).Text
.ChengJB.ToolTipText = ""
Else
frmMain.sbStatusBar.Panels(1).Text = _
"未知班級 請單擊“文件”菜單下的“屬性”項,設置屬性"
End If
End With
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -