📄 acc+p.frm
字号:
BackStyle = 0 'Transparent
Caption = "Contact No."
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0E0FF&
Height = 375
Left = 2835
TabIndex = 9
Top = 720
Width = 1335
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "First Name"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0E0FF&
Height = 375
Left = 90
TabIndex = 8
Top = 720
Width = 1335
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "Address"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0E0FF&
Height = 495
Left = 150
TabIndex = 7
Top = 2385
Width = 1095
End
End
Begin VB.TextBox Text15
DataField = "Ac_no"
DataSource = "Adodc2"
Height = 285
Left = 3825
TabIndex = 0
Text = "Text15"
Top = 6720
Width = 255
End
Begin MSAdodcLib.Adodc Adodc2
Height = 330
Left = 2505
Top = 6720
Width = 1200
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "DSN=Relience"
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "Relience"
OtherAttributes = ""
UserName = "Admin"
Password = ""
RecordSource = "select * from accounts_p order by ac_no"
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 105
Top = 6720
Width = 1200
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "DSN=Relience"
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "Relience"
OtherAttributes = ""
UserName = "Admin"
Password = ""
RecordSource = "select * from Accounts_p order by ac_no"
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Label Label15
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00400000&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0E0FF&
Height = 375
Left = -135
TabIndex = 29
Top = 3480
Width = 8055
End
Begin VB.Label Label17
BackStyle = 0 'Transparent
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C0FFFF&
Height = 255
Left = -15
TabIndex = 28
Top = 4320
Width = 2415
End
Begin VB.Image Image1
Height = 3330
Left = -15
Picture = "acc+p.frx":33BB
Stretch = -1 'True
Top = 450
Width = 1785
End
Begin VB.Label Label4
Alignment = 2 'Center
BackColor = &H00E0E0E0&
Caption = "New Account Entries for Purchase"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = -135
TabIndex = 27
Top = 0
Width = 8175
End
End
Attribute VB_Name = "accp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mode, c1, c2, c3, c4 As String
Dim pos As Integer
Private Function is_empty() As Boolean
If Adodc1.Recordset.RecordCount = 0 Then
'MsgBox "The Database is Empty.", vbOKOnly + vbExclamation, "Confirm..."
is_empty = True
Else
is_empty = False
End If
End Function
Private Function new_no() As Integer
On Error Resume Next
If is_empty Then
new_no = 1
Else
Adodc2.RecordSource = "Select max(ac_no) from accounts"
Adodc2.Refresh
new_no = Adodc2.Recordset.Fields(0) + 1
End If
End Function
Private Sub cb_Click(Index As Integer)
Select Case (Index)
Case 0
If Not is_empty Then
Adodc1.Recordset.MoveFirst
Call ref
End If
Case 1
If Not is_empty Then
Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF = True Then
Adodc1.Recordset.MoveFirst
End If
Call ref
End If
Case 2
If Not is_empty Then
Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF = True Then
Adodc1.Recordset.MoveLast
End If
Call ref
End If
Case 3
If Not is_empty Then
Adodc1.Recordset.MoveLast
End If
Call ref
Case 4
Dim nno As Integer
mode = "add"
Label15.Caption = "Type The Entries Of New Account"
pos = Adodc1.Recordset.AbsolutePosition
set2
nno = new_no
Adodc1.Recordset.AddNew
Text1 = nno
Text2.SetFocus
Exit Sub
Case 5
mode = "edit"
set2
pos = Adodc1.Recordset.AbsolutePosition
Case 6
Dim res As Integer
If Not is_empty Then
res = MsgBox("Wish To Delete The Current A/C Entry Permanently", vbYesNo + vbExclamation, "Confirm...")
If res = vbYes Then
Adodc1.Recordset.Delete
If Not is_empty Then
Call cb_Click(2)
Else
Adodc1.Refresh
MsgBox "No more records"
End If
End If
End If
Call ref
Case 7
Me.Enabled = False
Form2.Show
Case 8
MAIN.Enabled = True
MAIN.Show
Unload Me
Case 9
' Label17.Caption = "Under Filteration"
' cb(9).Visible = False
' cb(10).Visible = True
' f_mode = True
' Me.Enabled = False
' Form2.Show
Case 10
Adodc1.RecordSource = "select * from students"
Adodc1.Refresh
cb(9).Visible = True
cb(10).Visible = False
Label17.Caption = ""
End Select
cb(Index).Default = True
Call ref
End Sub
Private Sub Command1_Click()
Call rep
End Sub
Private Sub Command10_Click()
Adodc1.Recordset.Update
If mode = "add" Then
Adodc1.Recordset.MoveLast
Else
Adodc1.Recordset.AbsolutePosition = pos
End If
set1
Call ref
End Sub
Private Sub Command11_Click()
Adodc1.Recordset.CancelUpdate
If pos <> -1 Then
Adodc1.Recordset.AbsolutePosition = pos
Call ref
End If
set1
End Sub
Private Sub set1()
Frame1.Enabled = False
Frame2.Visible = True
Frame3.Visible = False
cb(8).Cancel = True
cb(5).Default = True
End Sub
Private Sub set2()
Frame1.Enabled = True
Frame2.Visible = False
Frame3.Visible = True
Command11.Cancel = True
Command10.Default = True
End Sub
Private Sub Form_Activate()
'If is_admin = False Then
' cb(4).Enabled = False
' cb(5).Enabled = False
' cb(6).Enabled = False
'Else
' cb(4).Enabled = True
' cb(5).Enabled = True
' cb(6).Enabled = True
'End If
Call ref
End Sub
Private Sub ref()
On Error Resume Next
Dim s As String
s = "Record No. :" + Str(Adodc1.Recordset.AbsolutePosition) + " out of " + Str(Adodc1.Recordset.RecordCount)
Label15.Caption = s
hs.Max = Adodc1.Recordset.RecordCount
hs.Value = Adodc1.Recordset.AbsolutePosition
End Sub
Private Sub hs_Change()
Adodc1.Recordset.AbsolutePosition = hs.Value
Call ref
End Sub
Private Sub rep()
mysql = "delete from temp_accounts"
Call del_rec
Adodc3.RecordSource = "Select * from temp_accounts order by name"
Adodc3.Refresh
Adodc1.Recordset.MoveFirst
If Adodc1.Recordset.RecordCount <> 0 Then
'While Adodc1.Recordset.EOF = False
For j = 1 To Adodc1.Recordset.RecordCount
Adodc3.Recordset.AddNew
For i = 0 To 8
If Adodc1.Recordset.Fields(i) = Null Then
Adodc3.Recordset.Fields(i) = ""
Else
Adodc3.Recordset.Fields(i) = Adodc1.Recordset.Fields(i)
End If
Next i
Adodc3.Recordset.Update
Adodc1.Recordset.MoveNext
Next j
'Wend
End If
MsgBox "Press Ok to Print Report"
DataEnvironment1.Connection1.Open
DataEnvironment1.Command1
DataReport1.Show
DataReport1.WindowState = 2
Adodc1.Recordset.MoveFirst
'''DataEnvironment1.rsCommand1_Grouping.Filter = ("where ucase(Branch) = 'CS' and Sem = '8'")
'''MsgBox "Press Ok to Print Report"
'''
'''MsgBox DataEnvironment1.Connection1.State
'''If DataEnvironment1.Connection1.State = 1 Then
''' DataEnvironment1.Connection1.Close
''' DataEnvironment1.Connection1.Open
'''Else
''' DataEnvironment1.Connection1.Open
'''End If
'''DataEnvironment1.Command1_Grouping
'''DataReport1.Show
'''DataReport1.WindowState = 2
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -