📄 book_cli.frm
字号:
Style = 1 'Graphical
TabIndex = 30
Top = 240
Width = 1575
End
Begin VB.OptionButton optAnalysis
Height = 975
Index = 0
Left = 240
Picture = "BOOK_CLI.frx":29CE
Style = 1 'Graphical
TabIndex = 31
Top = 240
Width = 1575
End
End
Begin VB.CommandButton cmdClose
Caption = "关闭(&C)"
Height = 420
Left = 5520
TabIndex = 14
Top = 5025
Width = 1215
End
Begin VB.CommandButton cmdHelp
Caption = "帮助(&H)"
Height = 420
Left = 120
TabIndex = 13
Top = 5040
Width = 1215
End
Begin VB.CommandButton cmdExecute
Caption = "执行..."
Default = -1 'True
Height = 420
Left = 4080
TabIndex = 12
Top = 5040
Width = 1215
End
Begin VB.ComboBox cboBooks
Height = 315
Left = 2160
Sorted = -1 'True
TabIndex = 1
Top = 360
Width = 4620
End
Begin VB.ComboBox cboAuthors
Height = 315
Left = 80
Sorted = -1 'True
TabIndex = 0
Top = 360
Width = 1980
End
Begin MSComCtlLib.StatusBar sbrRev
Align = 2 'Align Bottom
Height = 315
Left = 0
TabIndex = 26
Top = 5565
Width = 6990
_ExtentX = 12330
_ExtentY = 556
Style = 1
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSComDlg.CommonDialog dlgFindDB
Left = 1695
Top = 4980
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FontSize = 1.73861e-39
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "图书:"
Height = 195
Index = 1
Left = 2160
TabIndex = 18
Top = 135
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "作者:"
Height = 195
Index = 0
Left = 90
TabIndex = 17
Top = 135
Width = 555
End
End
Attribute VB_Name = "frmRevenue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mSQL As String
Private Sub cboAuthors_Click()
GetTitles cboAuthors.Text
End Sub
Private Sub chkDiscount_Click()
Label2(4).Enabled = Not Label2(4).Enabled
Label2(5).Enabled = Not Label2(5).Enabled
Label2(6).Enabled = Not Label2(6).Enabled
txtRevParm(4).Enabled = Not txtRevParm(4).Enabled
txtRevParm(5).Enabled = Not txtRevParm(5).Enabled
txtRevParm(6).Enabled = Not txtRevParm(6).Enabled
udDiscount(4).Enabled = Not udDiscount(4).Enabled
udDiscount(5).Enabled = Not udDiscount(5).Enabled
udDiscount(6).Enabled = Not udDiscount(6).Enabled
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdCogs_Click()
goStatusPanel.Text = "决定货物的费用"
Load frmCogs
goStatusPanel.Text = ""
End Sub
Private Sub cmdHelp_Click()
Dim sHelpString As String
sHelpString = "1. 选择作者及书目。" & vbCrLf & _
"2. 选择销售模式。" & vbCrLf & _
"3. 单击选择按钮设置 COGS 价格。" & vbCrLf & _
"4. 输入广告费用的合计。" & vbCrLf & _
"5. 输入销售期的月数。" & vbCrLf & _
"6. 输入每月的单位销售数。" & vbCrLf & _
"7. 可选的, 单击增加折扣框来" & vbCrLf & _
" 添加对于此图书的销售晋级。" & vbCrLf & _
"8. 单击显示图表按钮来显示" & vbCrLf & _
" 出版商帐目及著作权图表。"
MsgBox sHelpString, vbInformation, "图书帐目帮助"
End Sub
Private Sub cmdExecute_Click()
If cboBooks.Text = "<None>" Or cboBooks.Text = "" Then
MsgBox "当没有可用的图书标题时不能创建图表。", _
vbExclamation, "创建图表错误"
Exit Sub
End If
goStatusPanel.Text = "正在创建图表..."
Load frmChart
frmChart.Show
End Sub
Private Function GetBooksale() As String
' 返回 booksale.mdb 的路径。
' 如果 booksale.mdb 不在默认的位置，
' 给最终用户提供一个标准对话框
' 提示用户查找数据库。
On Error GoTo ErrHandler
With dlgFindDB
.DialogTitle = "请查找 Booksale.mdb"
.InitDir = App.Path
.FileName = gDBName
.Filter = "Access (*.mdb)| *.mdb"
.CancelError = True '如果用户单击取消，则导致一个错误
.ShowOpen
End With
Do While UCase(Right(Trim(dlgFindDB.FileName), Len("booksale.mdb"))) <> "BOOKSALE.MDB"
MsgBox "不存在于 BOOKSALE.MDB 相符的文件名。"
dlgFindDB.ShowOpen
Loop
GetBooksale = dlgFindDB.FileName
Exit Function
ErrHandler:
If Err = 32755 Then '取消将导致错误
MsgBox "正在退出应用程序"
End
End If
End Function
Private Sub LoadDB()
' 加载 booksale.mdb。如果文件不在所说的位置，
' 则提供一个标准对话框控件，让最终用户查找此文件。
gDBName = "booksale.mdb"
On Error GoTo LoadDBError
Set gCN = New ADODB.Connection ' 全局连接对象。
' 为连接对象设置连接字符串。
gCN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
Left(App.Path, Len(App.Path) - Len("client")) & gDBName
gCN.Open ' 打开连接。
Load frmRevenue
Exit Sub
LoadDBError:
Select Case Err.Number
Case -2147467259
' 不能找到文件, 使用标准对话框来查找它。
gCN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & _
GetBooksale
Resume
Case Else ' 其他未知的错误
MsgBox Err.Number & ": " & Err.Description
End Select
End Sub
Private Sub Form_Load()
'LoadDB ' 加在数据库并且打开连接
Screen.MousePointer = vbHourglass
Me.Show
On Error GoTo LoadError
Set goStatusPanel = sbrRev.Panels(1)
goStatusPanel.Text = "检索作者列表..."
Set gobjServer = CreateObject("BookSaleSvr.Sales")
GetAuthors
goStatusPanel.Text = "正在连接到远程规则..."
goStatusPanel.Text = "远程连接成功..."
LoadExit:
Screen.MousePointer = vbDefault
Exit Sub
LoadError:
If Err.Number = 429 Then ' 创建对象错误
MsgBox "在您运行此程序前, 请使用 book_svr.vbp 来创建 BookSaleSvr.exe。 ", vbExclamation, " 创建对象错误"
End
ElseIf Err <> 0 Then ' 其他错误
MsgBox Error$ & " - " & Str$(Err), vbExclamation, "加载窗体错误"
End
End If
Resume LoadExit
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set gSn = Nothing
Set gobjServer = Nothing
End Sub
Private Sub optAnalysis_Click(Index As Integer)
frmSalesModel.Tag = Index
End Sub
Private Sub txtRevParm_GotFocus(Index As Integer)
txtRevParm(Index).SelStart = 0
txtRevParm(Index).SelLength = Len(txtRevParm(Index).Text)
End Sub
Private Sub udDiscount_DownClick(Index As Integer)
If Val(txtRevParm(Index).Text) > 1 Then
txtRevParm(Index).Text = Val(txtRevParm(Index).Text) - 1
End If
End Sub
Private Sub udDiscount_UpClick(Index As Integer)
If Val(txtRevParm(Index).Text) < 99 Then
txtRevParm(Index).Text = Val(txtRevParm(Index).Text) + 1
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -