?? add_player.frm
字號:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{FAEEE763-117E-101B-8933-08002B2F4F5A}#1.1#0"; "DBLIST32.OCX"
Begin VB.Form add_player
BorderStyle = 0 'None
Caption = "Add Player to database"
ClientHeight = 6015
ClientLeft = 0
ClientTop = 0
ClientWidth = 3555
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6015
ScaleWidth = 3555
ShowInTaskbar = 0 'False
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = "tennis.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 2700
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Participant_complet"
Top = 0
Visible = 0 'False
Width = 1140
End
Begin VB.Data DatSpon
Caption = "Data3"
Connect = "Access"
DatabaseName = "tennis.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 300
Left = 2640
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Sponsor"
Top = 0
Visible = 0 'False
Width = 1140
End
Begin VB.Data DatPays
Caption = "Data2"
Connect = "Access"
DatabaseName = "tennis.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 3000
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Pays"
Top = -120
Visible = 0 'False
Width = 1140
End
Begin VB.Data DatSexe
Caption = "Data1"
Connect = "Access"
DatabaseName = "tennis.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 2640
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Sexe"
Top = 0
Visible = 0 'False
Width = 1140
End
Begin MSDBCtls.DBCombo Text5
Bindings = "add_player.frx":0000
DataField = "Sponsor"
DataSource = "DatSpon"
Height = 315
Left = 240
TabIndex = 15
Top = 4080
Width = 1575
_ExtentX = 2778
_ExtentY = 556
_Version = 393216
ListField = "Sponsor"
Text = ""
End
Begin MSDBCtls.DBCombo DBCombo1
Bindings = "add_player.frx":0016
DataField = "Sexe"
DataSource = "DatSexe"
Height = 315
Left = 240
TabIndex = 2
Top = 3360
Width = 1575
_ExtentX = 2778
_ExtentY = 556
_Version = 393216
MatchEntry = -1 'True
ListField = "Sexe"
Text = ""
End
Begin MSDBCtls.DBCombo text4
Bindings = "add_player.frx":002C
DataField = "Pays"
DataSource = "DatPays"
Height = 315
Left = 240
TabIndex = 14
Top = 4680
Width = 1575
_ExtentX = 2778
_ExtentY = 556
_Version = 393216
ListField = "Pays"
Text = ""
End
Begin VB.TextBox Text3
Height = 285
Left = 240
TabIndex = 7
Top = 1800
Width = 1575
End
Begin VB.CommandButton add
BackColor = &H00E0E0E0&
Caption = "Add"
Height = 255
Left = 360
Style = 1 'Graphical
TabIndex = 5
Top = 5415
Width = 1095
End
Begin VB.CommandButton Command2
BackColor = &H00E0E0E0&
Caption = "Cancel"
Height = 255
Left = 2040
Style = 1 'Graphical
TabIndex = 4
Top = 5415
Width = 1095
End
Begin VB.Data DatParticipant
Caption = "Data1"
Connect = "Access"
DatabaseName = "tennis.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 2640
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Participant"
Top = 0
Visible = 0 'False
Width = 1065
End
Begin VB.TextBox Text1
Height = 285
Left = 240
TabIndex = 3
Top = 600
Width = 1575
End
Begin VB.TextBox Text2
Height = 285
Left = 240
TabIndex = 1
Top = 1200
Width = 1575
End
Begin MSComctlLib.Slider Slider1
Height = 4575
Left = 2640
TabIndex = 0
Top = 480
Width = 495
_ExtentX = 873
_ExtentY = 8070
_Version = 393216
Orientation = 1
Max = 6
SelStart = 3
TickStyle = 1
Value = 3
TextPosition = 1
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "Nationality"
Height = 255
Left = 1875
TabIndex = 13
Top = 4680
Width = 855
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "Sponsor"
Height = 255
Left = 1875
TabIndex = 12
Top = 4080
Width = 855
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "Sexe"
Height = 255
Left = 1875
TabIndex = 11
Top = 3375
Width = 615
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "Rank"
Height = 255
Left = 1875
TabIndex = 10
Top = 1800
Width = 735
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "Surname"
Height = 255
Left = 1875
TabIndex = 9
Top = 1245
Width = 735
End
Begin VB.Label Label2
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Height = 615
Left = 240
TabIndex = 8
Top = 2400
Width = 1575
End
Begin VB.Shape Shape1
BorderWidth = 4
FillColor = &H00808080&
FillStyle = 4 'Upward Diagonal
Height = 5775
Left = 120
Top = 120
Width = 3255
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Name"
Height = 255
Left = 1875
TabIndex = 6
Top = 600
Width = 495
End
End
Attribute VB_Name = "add_player"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim lesex, setidsp, setidpa
Private Sub add_Click()
Dim lastnum As Long
Dim DBtennis
Dim RSlast
Set DBtennis = DBEngine.Workspaces(0). _
OpenDatabase("tennis.MDB")
Set RSlast = DBtennis.OpenRecordset("last_num", dbOpenDynaset)
With RSlast
.MoveFirst
.MoveFirst
.Edit
!last_num = !last_num + 1
lastnum = !last_num
!last_num = !last_num + 1
.Close
End With
If DBCombo1 = "Femme" Then
lesex = "2"
Else
lesex = "1"
End If
Call setIDS
Call setIDP
'On Error GoTo faute:
With Data1.Recordset
.AddNew
!nom = Text1
!prenom = Text2
!rang = Text3
!Sexe_ID = lesex
!sponsor_ID = setidsp
!Pays_ID = setidpa
!Num = lastnum
.Update
End With
MsgBox "entry saved!", 48, "NEW"
Unload Me
'faute:
' MsgBox "une erreur est survenue", 48, "erreur"
End Sub
Private Sub add_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
add.FontBold = True
Command2.FontBold = False
End Sub
Private Sub Command1_Click()
Call setIDS
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command2.FontBold = True
add.FontBold = False
End Sub
Private Sub Command3_Click()
Call setIDP
End Sub
Private Sub Form_Load()
DBCombo1.text = ""
Text5.text = ""
Text4.text = ""
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
add.FontBold = False
Command2.FontBold = False
End Sub
Private Sub Slider1_Click()
Select Case Slider1
Case 0
Text1.Enabled = True
Text2.Enabled = False
Text3.Enabled = False
DBCombo1.Enabled = False
Text5.Enabled = False
Text4.Enabled = False
Slider1.text = "Name active"
Label2.Caption = "Enter a string for the player's name"
Case 1
Text1.Enabled = False
Text2.Enabled = True
Text3.Enabled = False
DBCombo1.Enabled = False
Text5.Enabled = False
Text4.Enabled = False
Slider1.text = "Surname active"
Label2.Caption = "Enter a string for the player's surname"
Case 2
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = True
DBCombo1.Enabled = False
Text5.Enabled = False
Text4.Enabled = False
Slider1.text = "Rank active"
Label2.Caption = "Enter an number for the player's rank"
Case 3
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
DBCombo1.Enabled = True
Text5.Enabled = True
Text4.Enabled = True
Slider1.text = "All active"
Label2.Caption = "Enter ALL informations for the new player"
Case 4
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
DBCombo1.Enabled = True
Text5.Enabled = False
Text4.Enabled = False
Slider1.text = "Sexe active"
Label2.Caption = "Enter a value from list for the player's sexe"
Case 5
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
DBCombo1.Enabled = False
Text5.Enabled = True
Text4.Enabled = False
Slider1.text = "Sponosor active"
Label2.Caption = "Enter a string for the player's sponsor"
Case 6
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
DBCombo1.Enabled = False
Text5.Enabled = False
Text4.Enabled = True
Slider1.text = "Nationality active"
Label2.Caption = "Enter a string for the player's nationality"
End Select
End Sub
Function setIDS()
'setidpa
Dim VarPays
temp = Text4
On Error Resume Next
DatPays.Recordset.MoveFirst
DatPays.Recordset.MoveFirst
For i = 1 To 100
With DatPays.Recordset
.MoveNext
VarPays = !Pays
If temp = VarPays Then
setidpa = !ID
temp2 = !ID
Exit Function
End If
End With
Next
End Function
Function setIDP()
'setidsp
Dim VarPays
temp3 = Text5
On Error Resume Next
DatSpon.Recordset.MoveFirst
DatSpon.Recordset.MoveFirst
For i = 1 To 100
With DatSpon.Recordset
.MoveNext
VarPays = !sponsor
If temp3 = VarPays Then
setidsp = !ID
temp4 = !ID
Exit Function
End If
End With
Next
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -