form5.frm

来自「一个商业软件的源码」· FRM 代码 · 共 1,112 行 · 第 1/3 页

FRM
1,112
字号
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private CC As Boolean
Private ss As Single

Private Sub Adodc1_WillMove(ByVal adReason As ADODB.EventReasonEnum, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
Call cbv1
End Sub

Private Sub Combo1_Click()
Adodc1.RecordSource = "select * from fymx where fymx.日期 like" & "'" & "%" & Combo1.Text & "%" & "'"
Adodc1.Refresh
Adodc2.RecordSource = "select sum(费用合计) as b  from fymx where fymx.日期 like" & "'" & "%" & Combo1.Text & "%" & "'"
Adodc2.Refresh
End Sub

Private Sub Command1_Click()
If Text1(0).Locked = False Then
MonthView1.Top = Text1(0).Top + Text1(0).Height
MonthView1.Left = Text1(0).Left
MonthView1.Visible = True
End If
End Sub

Private Sub Command2_Click()


End Sub

Private Sub CurtButton1_Click()
Call tlock(False)
Adodc1.Recordset.AddNew
CurtButton3.Caption = "保存(&S)"
CC = False
Call cbv1
End Sub

Private Sub CurtButton2_Click()
If Not Adodc1.Recordset.EOF Then
If MsgBox("本操作无法恢复!你确定要执行吗?", vbYesNo) = vbYes Then
Adodc1.Recordset.Delete
Adodc1.Recordset.UpdateBatch

CC = True
End If
End If
Call cbv1
End Sub

Private Sub CurtButton3_Click()
Dim i As Integer
If CurtButton3.Caption = "编辑(&E)" Then
CurtButton3.Caption = "保存(&S)"
Call tlock(False)
CC = False

Call qx(True)
Else
CurtButton3.Caption = "编辑(&E)"
ss = 0
For i = 4 To Text1.Count - 2
ss = ss + Val(Text1(i).Text)
Next i
Text1(11).Text = ss

Call tlock(True)
Adodc1.Recordset.UpdateBatch
Timer1.Enabled = True
End If
End Sub

Private Sub CurtButton4_Click()
If Adodc1.Recordset.RecordCount = 0 Then
Else
Adodc1.Recordset.MoveFirst
End If
End Sub

Private Sub CurtButton5_Click()
If Not Adodc1.Recordset.BOF Then
Adodc1.Recordset.MovePrevious
Else
Adodc1.Recordset.MoveFirst
End If
End Sub

Private Sub CurtButton6_Click()
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveNext
Else
Adodc1.Recordset.MoveLast
End If
End Sub

Private Sub CurtButton7_Click()
If Adodc1.Recordset.RecordCount = 0 Then
Else
Adodc1.Recordset.MoveLast
End If
End Sub

Private Sub CurtButton8_Click()
TABA = "fymx"
frmselect.Show
End Sub

Private Sub CurtButton9_Click()
If CC = False Then

Call qx(False)
Call cbv1
Call tlock(True)
Adodc1.Recordset.CancelUpdate
CurtButton3.Caption = "编辑(&E)"
End If
End Sub

Private Sub DataGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Set ck = Form5
'Set ad = Adodc1
''Set dt = DataGrid1
'dts = DataGrid1.VisibleRows

End Sub

Private Sub Form_Load()

Set ck = Form5
dts = DataGrid1.VisibleRows
Set ad = Adodc1
Set dt = DataGrid1

Adodc1.ConnectionString = cnnado.ConnectionString

Adodc1.RecordSource = "select * from fymx where fymx.日期 like" & "'" & "%" & VBA.Year(Date) & "%" & "'"
Set DataGrid1.DataSource = Adodc1
Call tb
Call tlock(True)
Call cbv1
Hook Me.hwnd

Adodc2.ConnectionString = cnnado.ConnectionString
Adodc2.RecordSource = "select sum(费用合计) as b  from fymx where fymx.日期 like" & "'" & "%" & VBA.Year(Date) & "%" & "'"
Set Text2.DataSource = Adodc2
Text2.DataField = "b"

'Text2.Text = Adodc2.Recordset.Fields(0).Value
Combo1.Text = VBA.Year(Date)
End Sub



Private Function tb()

Dim i As Integer
Dim J As Integer
i = Text1.Count - 1
For J = 0 To i
Set Text1(J).DataSource = Adodc1
Text1(J).DataField = Adodc1.Recordset.Fields(J).name
Next J

End Function

Private Sub tlock(t As Boolean) '锁定 解锁文本框

Dim i As Integer
Dim J As Integer
J = Text1.Count - 1
If t = True Then
For i = 0 To J
Text1(i).Locked = True
Next i

End If
If t = False Then
For i = 0 To J

Text1(i).Locked = False
Next i

End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
TABA = cx

UnHook Me.hwnd
End Sub
Public Function cbv1() '控制命令按钮的有效性

If Adodc1.Recordset.RecordCount = 0 Then
CurtButton2.Enabled = False
CurtButton3.Enabled = False
CurtButton4.Enabled = False
CurtButton5.Enabled = False
CurtButton6.Enabled = False
CurtButton7.Enabled = False
CurtButton8.Enabled = False
CurtButton9.Enabled = False
Else
CurtButton2.Enabled = True
CurtButton3.Enabled = True
CurtButton4.Enabled = True
CurtButton5.Enabled = True
CurtButton6.Enabled = True
CurtButton7.Enabled = True
CurtButton8.Enabled = True
CurtButton9.Enabled = True
End If
End Function



Public Function qx(b As Boolean)  '保存编辑前的数据并在取消是还原

If edits = False Then
Exit Function
End If
Dim i As Integer
Static sz(11) As String
If b = True Then
For i = 0 To Text1.Count - 1
sz(i) = Text1(i).Text
Next i
Else
For i = 0 To Text1.Count - 1
 Text1(i).Text = sz(i)
Next i
End If
End Function

Public Function adds(c As Integer) As Boolean
Dim i As Integer
Select Case c
Case 0
For i = 0 To Text1.Count - 1
If Text1(i).Text <> "" Then
adds = True
Exit Function
End If
Next i
Case 1
For i = 0 To Text1.Count - 1
If Text1(i).Text <> "" Then
adds = True
Exit Function
End If
Next i
Case 2
For i = 0 To Text1.Count - 1
If Text1(i).Text <> "" Then
adds = True
Exit Function
End If
Next i
Case 3
For i = 0 To Text1.Count - 1
If Text1(i).Text <> "" Then
adds = True
Exit Function
End If
Next i
End Select
adds = False
End Function

Public Function edits() As Boolean
Dim i As Integer

For i = 0 To Text1.Count - 1
If Text1(i).Text <> "" Then
edits = True
Exit Function
End If
Next i

edits = False
End Function

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Text1(0).Text = MonthView1.Year & "-" & MonthView1.Month & "-" & MonthView1.Day
DataGrid1.Columns(0).Value = Text1(0).Text
MonthView1.Visible = False
End Sub

Private Sub Text1_DblClick(Index As Integer)
Dim i As Integer

If Text1(0).Locked = False And Index = 0 Then
Text1(0).Text = Date
MonthView1.Visible = False
End If
End Sub

Private Sub Text1_GotFocus(Index As Integer)
If CurtButton3.Caption = "保存(&S)" Then
If Index = 11 Then
ss = 0
For i = 4 To Text1.Count - 2
ss = ss + Val(Text1(i).Text)
Next i
Text1(11).Text = ss
End If
End If
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

If Text1(0).Locked = False Then
If KeyCode = 13 Then
If Index <> Text1.Count - 1 Then
Text1(Index + 1).SetFocus
Else

CurtButton3.SetFocus
Exit Sub
End If
End If
End If
End Sub

Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)

Select Case Index
Case 4
If KeyCode >= 47 And KeyCode <= 58 Or KeyCode >= 96 And KeyCode <= 106 Or KeyCode = 190 Or KeyCode = 13 Or KeyCode = 8 Then
Else
Text1(4).Text = ""
End If
Case 5
If KeyCode >= 47 And KeyCode <= 58 Or KeyCode >= 96 And KeyCode <= 106 Or KeyCode = 190 Or KeyCode = 13 Or KeyCode = 8 Then
Else
Text1(5).Text = ""
End If
Case 6
If KeyCode >= 47 And KeyCode <= 58 Or KeyCode >= 96 And KeyCode <= 106 Or KeyCode = 190 Or KeyCode = 13 Or KeyCode = 8 Then
Else
Text1(6).Text = ""
End If
Case 7
If KeyCode >= 47 And KeyCode <= 58 Or KeyCode >= 96 And KeyCode <= 106 Or KeyCode = 190 Or KeyCode = 13 Or KeyCode = 8 Then
Else
Text1(7).Text = ""
End If
Case 8
If KeyCode >= 47 And KeyCode <= 58 Or KeyCode >= 96 And KeyCode <= 106 Or KeyCode = 190 Or KeyCode = 13 Or KeyCode = 8 Then
Else
Text1(8).Text = ""
End If
Case 9
If KeyCode >= 47 And KeyCode <= 58 Or KeyCode >= 96 And KeyCode <= 106 Or KeyCode = 190 Or KeyCode = 13 Or KeyCode = 8 Then
Else
Text1(9).Text = ""
End If
Case 10
If KeyCode >= 47 And KeyCode <= 58 Or KeyCode >= 96 And KeyCode <= 106 Or KeyCode = 190 Or KeyCode = 13 Or KeyCode = 8 Then
Else
Text1(10).Text = ""
End If
End Select
End Sub

Private Sub Timer1_Timer()
Adodc2.RecordSource = "select sum(费用合计) as b  from fymx where fymx.日期 like" & "'" & "%" & Combo1.Text & "%" & "'"
Adodc2.Refresh
Timer1.Enabled = False
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?