Ps22Pdf

Transcription

1 Visua l Ba sic 6

2 ( ) 158,,,, Windows ;,, A 6, ; B,, Visual Basic, W indows 95/ 98,, : Visual Basic 6 : : (, ) : : : / 16 : : 578 : : : ISBN / T P 2908 :

3 Visual Basic Visual Basic Visual Basic Visual Basic Windows 3 Visual FoxPro Delphi 4 6 Visual Basic Windows VB Visual Basic 6.0

4

5

6 21 C C++ C PASCAL licb@public wh.hb.cn [email protected] 2001

7 1 VB VB VB VB VB VB VB Print Rem End If Select Case For While Do

8 VB Input Box MsgBox T ab

9 MDI MDI MDI MDI MDI

10 10 VB ( SQL) ODBC Dat a Data Data Data Recordset Data DBGrid DBGrid DBGrid DBGrid DBGrid ADO Dat a ADO Data ADO Data ADO Data ADO Data ( SQL ) SQL SQL DAO DAO DBE ngine DBE ngine DBE ngine DBE ngine Workspace W orkspace W orkspace W orkspace Dat abase Database Database T abledef Recordset QueryDef Database Field Field Field Field Index Index Index Index DAO ADO ADO Connect ion Connection Connection Recordset Recordset Recordset Command Command Command Command Parameter Command ADO

11 A VB B

12 1 VB Visual Basic Visual Basic 1.1 VB Visual Basic Basic Visual Basic BASIC Visual Basic Internet 1991 VB DOS Windows 3.x Windows 9.x NT 32 VB 6.0 VB 6.0 Internet Internet Intranet Internet IIS HTML DHTML Web SQL ActiveX ADO

13 2 Visual Basic VB VB VB Microsoft Windows Windows NT VB VB VB VB ActiveX Internet HTML VB VB VB BackOffice SQL Server 1.2 VB VB Microsoft Visual Basic 6.0 Microsoft Visual Basic 6.0 VB VB VB VB EXE ActiveX EXE ActiveX

14 1 VB 3 ActiveX DLL ActiveX DLL ActiveX EXE ActiveX ActiveX VB VB IIS IIS ActiveX ActiveX VB Web Internet Explorer DHTML DHTML VB VB EXE VB Visual Basic 6.0

15 4 Visual Basic VB 1.3 VB VB VB VB VB 1. 1-Microsoft Visual Basic[ ] VB Windows 9.x

16 1 VB 5 13 VB 3. VB 1.3 VB VB 1.2.vbp.frm.bas.cls

17 6 Visual Basic VB VB Form1 Form VB 1.4 VB 1.4 6

18 1 VB VB VB Option Explicit Tab

19 8 Visual Basic VB VB 1.6

20 1 VB VB VB VB ActiveX ActiveX ActiveX

21 10 Visual Basic VB MDI VB 1.8

22 1 VB Windows VB Visual Basic VB (.exe) VB F5 F5 VB VB MDI 7

23 12 Visual Basic VB SDI MDI SDI VB SDI VB 1.2 VB 1.3 VB 1.4 VB 1.5 VB

24 2 VB VB VB VB 2.1 VB VB VB VB VB VB VB

25 14 Visual Basic 2.1 VB

26 2 VB 15 VB Name Caption Left Top Width Height BorderStyle Font Enabled Visible MousePointer TabIndex Appearance BackColor ToolTipText 2.3

27 16 Visual Basic Windows DOS Windows Timer VB Click DblClick Load Unload Resize Change KeyDown KeyUp KeyPress MouseDown MouseUp MouseMove Sub _ ()

28 2 VB 17 Command1 Text1 Sub Command1_Click Text1.Text=" " VB VB BASIC Command [.] [ ] Form1 Print Form1.Print " "

29 18 Visual Basic Basic VB VB VB Click Click 1 2 Load VB VB vbp 2.vbg 3.frm 4

30 2 VB 19.bas Public 5 Visual Basic.cls

31 20 Visual Basic

32 2 VB VB VB VB VB VB 2.2.5

33 22 Visual Basic 1. F2 Ctrl + Tab Ctrl + Tab

34 2 VB exe 1. F5

35 24 Visual Basic Shift + F exe 2.exe 3.exe Windows VB VB EXE VB VB VB VB

36 2 VB Form Form Shift Top Left Ctrl

37 26 Visual Basic Ctrl Top Left Form1 Form1 Caption example Text1 Text Text1 Command1 Caption Form1 2.8

38 2 VB Form VB VB Name _ Command1 Command1_Click Form1 Command1 2.9

39 28 Visual Basic F

40 2 VB 29 VB Form1 example ?

41 3 VB VB VB VB VB 3.1 VB VB VB 255 VB VB VB As Binary ByRef ByVal Date Else Empty Error False For Friend Get Input Is Len Let Lock Me Mid New Next Nothing Null On Option Optional ParamArray Print Private Property Public Resume Seek Set Static Step String Then Time To True WithEvents VB VB VB

42 3 VB VB VB = = 2. VB 3.1 VB 3.1 VB ^ - * / \ Mod + - & VB 3.2 VB = <> > < >= <=

43 32 Visual Basic Like Is VB Not 3.3 VB Not And Or Xor Eqv Imp VB 1. VB VB VB VB 2. _ Rem '

44 3 VB VB VB VB VB 1. " ( ) c1="a":c2=cl+"1":c3="" ~ A F a f &H 4 &H0 &HFFFF 0 7 &0 & 6 &0~& ~ &H &H0&~&FFFFFFF& &O &O0&~&O &

45 34 Visual Basic E D E D E E True( ) False( ) 4. # #12/18/2000# 5. 1 VB VB VBA 2 VB Const [Public Private] Const < > [As < >]=< > < > < > Const PI= Public Const CMax As Integer = 9 Const IDate = #11/30/2000#

46 3 VB 35 Public Const A = B * 2 Public Const B = A / VB 1. VB 1 Option Explicit 2 Option Explicit 1 Dim [As ] 2 Static [As ] 3

47 36 Visual Basic Private [As ] 4 Public [As ] Module1 x Module2 x Module1 x Module1.x Module2 x Module2.x 2. = X X = 5 X = Y X = X + 1 Y X 3. Y X Y X Y X X = Y

48 3 VB Variant VB 1. Integer Long Single Double Currency Integer Long Long Integer Single Double Double Single Dim X As Integer Dim Y As String Y = "10.23" X = Y Y = X + 1 X Y 11.23

49 38 Visual Basic 4. True False Yes No On Off 5. Date # Dim TestDate As Date TestDate=#11/30/2000# TestDate=# # TestDate=#11/30/ :47:29 pm# 6. Variant Variant VB Dim a' Variant a="20" 'a "20"( ) a=a-15 ',a 5 a="c"&a ',a "C5" ( ) Variant Variant Variant Variant & + Variant 3 Empty Null Error 1 Empty Variant Empty IsEmpty Empty If IsEmpty(x) Then x=0 Empty 0 ("") Null Variant Empty 0 ( 0 Null) Variant Empty Empty Variant Variant Empty 2 Null Null Null

50 3 VB 39 Null Null Null Null Null Null Null Variant Null Null Null Null x=null IsNull Variant Null If IsNull(x) And lsnull(y) Then z=null Else z=0 End If Null Variant Null Variant Null Variant ( Null ) Variant Null 3 Error Error CVErr Error 7. (Object) Object Set Object Dim objdb As Object Set objdb=opendatabase("c:\vb6\student.mdb") Object TextBox Control Database Object VB 3.3 VB Variant

51 40 Visual Basic Private 2 Private 3 Public 2. 0 Long [Private Public] -1 As A Private A 6 As Integer To A Private A(1 To 7) As Integer 3. Variant Variant Dim intx As Integer Dim countersa 5 As Integer For intx = 0 To 4 countersa(intx)=5 Next intx Dim countersb 5 As String For intx = 0 To 4

52 3 VB 41 countersb(intx) = "hello" Next intx Dim arrx 2 As Variant arrx 1 = countersa() arrx 2 = countersb() 4. VB Dim Matrix(9,9) as Double Dim Matrix(1 To 9,1 To 9) as Double Variant Public Dim Static Dim 1 MatrixX Dim MatrixX 2 ReDim ReDim -1 MatrixX 9 ReDim MatrixX 8 X=8 ReDim MatrixX X Preserve MatrixX

53 42 Visual Basic ReDim Preserve MatrixX Form1 Private Sub Form_Load() Show Dim student 5 As String * 8 Dim score(5, 5) As Single student 1 = " ": student 2 = " ": student 3 = " " student 4 = " ": student 5 = " " score(1, 1) = 68: score(1, 2) = 84: score(1, 3) = 79 score(2, 1) = 89: score(2, 2) = 92: score(2, 3) = 90 score(3, 1) = 86: score(3, 2) = 69: score(3, 3) = 72 score(4, 1) = 76: score(4, 2) = 62: score(4, 3) = 60 FontSize = 14: FontName = " ": FontUnderline = True Print Print Tab(14); " " Print FontSize = 10: FontName = " ": FontUnderline = False Print " "; Tab(12); " "; Tab(20); " "; Tab(28); " "; _ Tab(36); " "; Tab(44); " " For i = 1 To 4 ' score(i, 4) = score(i, 1) + score(i, 2) + score(i, 3) score(i, 5) = score(i, 4) / 3 Next For i = 1 To 5 ' score(5, i) = (score(1, i) + score(2, i) + score(3, i) + score(4, i)) / 4 Next i For i = 1 To 4 ' Print student(i); Print Tab(12); Format(score(i, 1), "###.0"); Print Tab(20); Format(score(i, 2), "###.0"); Print Tab(28); Format(score(i, 3), "###.0"); Print Tab(36); Format(score(i, 4), "###.0"); Print Tab(44); Format(score(i, 5), "###.0") Next Print FontUnderline = True Print Trim(student(i)); ' Print Tab(12); Format(score(5, 1), "###.0"); Print Tab(20); Format(score(5, 2), "###.0"); Print Tab(28); Format(score(5, 3), "###.0");

54 3 VB 43 Print Tab(36); Format(score(5, 4), "###.0"); Print Tab(44); Format(score(5, 5), "###.0") student score Form1 3.4 VB [Let] = Let Single

55 44 Visual Basic = = = = x = y ' y x y = x ' x y z=x+y x+y=z = x+y x = 2 : y = x : z = x x y z 2 x = 5 x = x + 1 x x st st = "Good" st = st & "morning" st "Good morning" VB Print Print Print BASIC PRINT [.]Print[ ][, ] (Debug) (Printer) Form1.Print "Visual Basic" ' Form1 "Visual Basic" Picture1.Print "Visual Basic" ' Picture1 "Visual Basic" Print "Visual Basic" ' "Visual Basic"

56 3 VB 45 Print Print "aa"&"bb",2*6 ' aabb 12 Print "aa"&"bb";2*6 ' aabb12 Print 14 Print Print Print Print VB Print 1 Tab Tab Print Print# Tab(n) n 1 n n n Mod n 1 Tab n Tab Print Tab(10); " ";Tab(30);" " Print Tab Tab 2 Spc Print Print# Spc n : Spc(n) n Spc Print "ABC";Spc(5); "DEP" ' ABC DFE Print Spc Spc Tab Tab Spc Spc Space Spc

57 46 Visual Basic 3.2 Print Form2 Private Sub Form_Click() Print "aa" & "bb", 2 * 6 Print "aa" & "bb"; 2 * 6 Print Print Now ' Print FontSize = 16 ' Print "12*5="; 12 * 5 Print FontSize = 12 Print "12*5=", 12 * 5 Print FontSize = 14 FontBold = True ' Print " "; FontSize = 10 Print " " Form Rem 3.2 Form2 Rem '

58 3 VB 47 Rem Rem ' Rem End End End End End Stop End Unload QueryUnload Terminate VB End VB End Private Sub Form_Load Dim Password,Pword As String Password = "640129" Pword=InputBox(" ") If Pword<>Password Then MsgBox " " End End If End 3.5 VB If Select Case

59 48 Visual Basic If If 1. If If Then 1 [Else 2] Else Then 1 If Else Else 2 If If Private Function MaxValue1(a As Integer,b As Integer) As Integer If a > b Then MaxValue1 = a Else MaxValue1 = b End Function 2. If 1 If Then End If Then If If If Private Function MaxValue2(a As Integer,b As Integer) As Integer If a > b Then MaxValue2 = a End If If a<=b Then MaxValue2 = b End If End Function

60 3 VB 49 2 If Then 1 Else 2 End If Then 1 If If Else 2 If Private Function MaxValue3(a As Integer,b As Integer) As Integer If a > b Then MaxValue3 = a Else MaxValue3 = b End If End Function 3 If 1 Then 1 ElseIf 2 Then 2 [ElseIf 3 Then 3] [Else n] End If ElseIf ElseIf 3.4

61 50 Visual Basic Private Function Level1(x As Integer) As String If x>=90 Then Level1 = " " ElseIf x>=80 Then Level1 = " " ElseIf x>=70 Then Level1 = " " ElseIf x>=60 Then Level1 = " " Else Level1 = " " End If Select Case If VB Select Case If If Select Case Select Case Select Case Case 1 1 [Case 2 2] [Case Else n]

62 3 VB 51 End Select Case Select Case Select Case Case Else Select Case Select Case Select Case Case 1 Case 1 Case "char" 2 1[ 2] [ n] Case Case 1,3,5,7 Case "a", "b", "c", "d" 3 1 To Case 1 To 4 Case "a" To "z" 4 Is Is = < > <= >= <> Case Is < 3 Case Is > "Apple" Case Is < Is > 12 Case Is < "z", "A" To "Z" Select Case Case Case

63 52 Visual Basic Select Case Case Else Case Case Case Select Case Select Case Private Function Level2(x As Integer) As String Select Case x Case Is>=90 Level2 = " " Case Is>=80 Level2 = " " Case Is>=70 Level2 = " " Case Is>=60 Level2 = " " Case Else Level2 = " " End Select 3.6 For While Do For For For For = To [Step ] [ ] [Exit For] [ ] Next 1

64 3 VB Step 5 6 Exit For For 7 Next For For For Exit For Exit For For Exit For For For 1 n Private Function Sum1(n As Integer) As Integer Dim s,i As Integer For i=1 To n s=s+i Next i Sum1=s End Function 3.3 Form3 Private Sub Form_Click() FontSize = 12 Print Tab(35); " "

65 54 Visual Basic Print Tab(33); " " For i = 1 To 9 For j = 1 To i Print Tab((j - 1) * 9 + 1); i & "*" & j & "=" & i * j; Next j Print Next i Form3 For For For Each in [ ] Next [ ] Next Private Sub Command1_Click For Each Control in Me.Controls Print Control.Name Next Control While While For For

66 3 VB 55 While While While While [ ] Wend True False Wend While 1 n While Private Function Sum2(n As Integer) As Integer Dim s,i As Integer i=1 While (i<=n) s=s+i:i=i+1 Wend Sum2=s End Function Do Do While While Do Do 1 Do [ ] ['

67 56 Visual Basic Exit Do] [ ] Loop [While Until ] 2 Do [While Until ] [ ] [' Exit Do] [ ] Loop Do 1 For While 2 Exit Do Do Exit Do Do 3 Do Loop Exit Do 4 Do For While 5 While Until 1 While Until While Until 2 Loop

68 3 VB 57 1 n Do Private Function Sum3(n As Integer) As Integer Dim s,i As Integer If n=1 Then Sum3=1 Else i=1 Do s=s+i:i=i+1 Loop (i<=n) Sum3=s End If End Function Private Function Sum4(n As Integer) As Integer Dim s,i As Integer i=1 Do While (i<=n) s=s+i:i=i+1 Loop Sum4=s Loop End Function VB 1 Exit For For For For If Then Exit For 2 Exit Do Do 3 Exit Sub Sub 4 Exit Function Function

69 58 Visual Basic 1 n Exit Do Private Function Sum5(n As Integer) As Integer Dim s,i As Integer i=1 Do If (i>n) Then Exit Do s=s+i:i=i+1 Loop Sum5=s End Function 3.7 VB Sub [Private Public][Static]Sub Sub Public VB Click Gen() Click

70 3 VB 59 Command1_Click() Command2_Click() Command3_Click() Gen() VB Name _ Command1 Command1_Click Form Form_Click MDI MDIForm MDIForm_Load Private Sub _ ( ) [ ] Private Sub Form MDIForm_ ( ) [ ] VB Name VB VB Sqr Sin Chr Function Function

71 60 Visual Basic [Private Public][Static]Function ( ) [As ] [ ] Sub Function Function Sub Function 1 = 2 As Variant 3 Function Function Area(a As Single, b As Single, c As Single) As Single Dim s As Single s = (a + b + c) / 2 Area = Sqr(s * (s - a) * (s - b) * (s - c)) End Function VB Function Area Private Sub Command1_Click() Text4.Text = Area(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text)) Sub Function Sub getdata() Function avgdata() VB

72 3 VB Sub Function Sub Sub Function Sub Sub Call Sub ( ) Sub Call Call 3. VB = ( ) Call ( ) VB 4. 1 Form1 SomeSub Form1 Call Form1.SomeSub( ) 2 DemoClass Class1 Dim DemoClass As New Class1 DemoClass.SomeSub DemoClass 3

73 62 Visual Basic Module1 Module2 CommonName Module2 CommonName Module2 CommonName Module1 CommonName Module2 Module1 CommonName Module1.CommonName( ) Variant Function Sqrtab1(a As Single,b as Single) a=a*a:b=b*b Sqrtab=Sqr(a+b) End Function 2. ByVal Function Sqrtab2(ByVal a As Single,ByVal b as Single) a=a*a:b=b*b Sqrtab=Sqr(a+b) End Function 3. VB VB Sqrtab1 a b x y Sqrtab1

74 3 VB 63 Sub Comp() Dim x As Single Dim y As Single Dim z As Single x=3:y=4 z=sqrtab1(x,y) ' x=9,y=16 Sqrtab1 x y Sqrtab1 Sub Comp() Dim x As Single Dim y As Single Dim z As Single x=3:y=4 z=sqrtab1((x),(y)) ' x y 4. Optional Optional c Function CompAdd1(a As Integer,b As Integer,Optional c As Integer) If IsMissing(c) Then CompAdd1=a+b+c Else CompAdd1=a+b End If End Function IsMissing Empty x=compadd1(2,3) ' x 5 y=compadd1(2,3,4) ' y 9 5. c 10 Function CompAdd2(a As Integer,b As Integer,Optional c As Integer=10)

75 64 Visual Basic CompAdd2=a+b+c End Function x=compadd2(2,3) ' x 15 y=compadd2(2,3,4) ' y 9 6. ParamArray CompAdd3 Dim x As Variant Dim s As Integer Dim intsum As Integer Function CompAdd3(ParamArray intnums()) For Each x In intnums s=s+x Next x CompAdd3=s End Function x=compadd3(2,3,4,5) y=compadd3(1,3) ' x 14 ' y VB VB InputBox 1 InputBox(prompt[,title][,default][,xpos,ypos][,helpfile,context]) 2

76 3 VB 65 InputBox$(prompt[,title][,default][,xpos,ypos][,helpfile,context]) $ prompt 1024 title default xpos twip 1 =1440 ypos twip xpos ypos helpfile readme.hlp C:\readme.hlp context helpfile 3.5 Private Sub Command1_Click() m = InputBox(" ", " ", "80") 3.5

77 66 Visual Basic MsgBox VB InputBox MsgBox MsgBox MsgBox MsgBox(prompt[,buttons][,title][,helpfile,context]) title helpfile context Inputbox prompt buttons button vbokonly 0 OK vbokcancel 1 OK Cancel vbabortretryignore 2 Abort Retry Ignore vbyesnocancel 3 Yes No Cancel vbyesno vbretrycancel 4 5 Yes No Retry Cancel VbCritical 16 VbQuestion 32 vbexclamation 48 vbinformation 64 i vbdefaultbutton1 0 vbdefaultbutton2 256 vbdefaultbutton3 512 vbdefaultbutton4 768

78 3 VB 67 vbapplicationmodal 0 vbsystemmodal 4096 buttons buttons 0 OK A ALT + MsgBox buttons MsgBox vbok 1 OK vbcancel 2 Cancel vbabort 3 Abort vbretry 4 Retry vbignore 5 Ignore vbyes 6 Yes vbno 7 No MsgBox VB 1. Chr() ASCII ASCII a ASCII 97 Chr(97) a

79 68 Visual Basic MsgBox " [ ] " 0 " " MsgBox " " 2 " " MsgBox " " 4+32 " " 3.6 MsgBox 2. Val() $ Val("123") Ucase() Ucase("abcd") "ABCD" 4. Lcase() Lcase("ABCD") "abcd"

80 3 VB Sqr() Sqr(16) 4 6. Abs() Abs(-100) Mid() Mid(string, start[,length]) string NULL NULL start length start start Mid("Computer",1,4) "Comp" 8. Format() Format[$](expr outformat) expr outformat VB VB General Number Currency Fixed Standard Percent Scientific

81 70 Visual Basic Yes/No True/False On/Off 0 No Yes 0 False True 0 Off On #. %, 3 E-,E+,e-,e+ : / -,+,$,(,), & < >! Format(125.25, " ") Format(125.25,"#####.###") VB? 1 XYZ 2 True1 3 False 4 1ABC 5 A[7] 6 Y_1 7 IntA 8 A-2 9 A.3 10 "Comp" 3.2???

82 3 VB 71 1 name 2 "name" 3 False 4 ff 5 " " 6 cj 7 "120" 8 n 9 #11/16/2000# VB?

83 72 Visual Basic 3.7 ax 2 bc c >75 20

84 3 VB Rnd A s=1+(1+2)+(1+2+3)+...+( n) 3.15 s n s 4000 n

85 4 VB VB VB VB 4.1 VB Caption Alignment Object.Alignment[= ] ( ) AutoSize Object.AutoSize[=True False] 3 BackStyle Object.BackStyle[= ] 0 1 1( ) 0

86 BorderStyle Object.BorderStyle[= ] 0 1 0( ) 1 5 Caption Object.Caption[= ] 6 WordWrap Object.WordWrap[=True False] True False Move Move left,top,width,height left top width height left Label1 Name Label1 Caption " " BorderStyle 1 BackColor &H00FF8080( ) ForeColor &H000000FF( ) Font _GB

87 76 Visual Basic VB Windows Windows Text Object.Text[= ] 2 MaxLength MultiLine True False

88 4 77 Object.MultiLine [=True False] 4 PasswordChar Text MultiLine False 5 ScrollBars Object.ScrollBars[= ] MultiLine True 6 SelLength SelStart SelText SelLength / SelStart / SelText / Change KeyPress SetFocus 1 Change Sub Text_Change([Index As Integer]) Text Index Index 2 KeyPress Sub Text_KeyPress(KeyAscii As Integer) KeyAscii 3 SetFocus *

89 78 Visual Basic Name Text1 Appearance 0'Flat BackColor &H00FFFFFF& ForeColor &H000000FF& PasswordChar "*" Text2 Text1 Private Sub Text1_Change() Text2.Text = Text1.Text

90 Click VB Cancel Cancel Esc Click Object.Cancel[=True False] True Cancel False Cancel Cancel 2 Caption Object.Captionl[= ] 3 Default Object.Default[=True False] True False 4 Enabled Object.Enabled=True False True False 5 Picture

91 80 Visual Basic Object.Picture[= ] Style 1 6 Style Object.Style[=0 1] 0 1 Picture Click DblClick 1 Click Sub Command_Click([Index As Integer]) Command Index Index 2 DblClick Sub Label_DblClick([Index As Integer]) Click Label1 Command1 Caption " " FontName " " FontSize Picture "Form2.frx":0000 Style 1 Command2 Caption " " FontName " " FontSize 14.25

92 4 81 Private Sub Command1_Click() Label1.Caption = " " Private Sub Command2_Click() Label1.Caption = " " 4.5 command

93 82 Visual Basic 4.4 Value Value 0 Value 1 Value 2 0 Click Caption 2 Value Click Click 4.4.3

94 4 83 Label1 Check1 Check2 Private Sub Check1_Click() Label1.FontBold = Check1.Value Private Sub Check2_Click() Label1.FontUnderline = Check2.Value Caption Alignment Caption 2 Alignment 0

95 84 Visual Basic 1 3 Value True False Click Click Label1 3 Option1 Option2 Option3 Private Sub Option1_Click() Label1.Caption = " DOS" Private Sub Option2_Click() Label1.Caption = " Windows" Private Sub Option3_Click() Label1.Caption = " Linux"

96 Caption Caption Click Click Label1 Frame1 3 Option1 Option2 Option3 Private Sub Option1_Click() Label1.Caption = " DOS" Private Sub Option2_Click() Label1.Caption = " Windows" Private Sub Option3_Click() Label1.Caption = " Linux" 4.9

97 86 Visual Basic Appearance / 3D 2 AutoRedraw / 3 AutoSize 4 Picture / LoadPicture

98 Picture1 4 Command1 Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 Picture1.Picture = LoadPicture("e:\sf\spring.jpg") Case 1 Picture1.Picture = LoadPicture("e:\sf\summer.jpg") Case 2 Picture1.Picture = LoadPicture("e:\sf\fall.jpg") Case 3 Picture1.Picture = LoadPicture("e:\sf\winter.jpg") End Select 4.8 JPEG GIF Appearance

99 88 Visual Basic / 3D 2 Picture / LoadPicture 3 Stretch / False True Stretch 1 Image1 Picture e:\media\ happy.bmp 2 Command1 Command2 Private Sub Command1_Click() ' " " Image1.Width = 1000' Image1.Height = 1000 Image1.Stretch = False Private Sub Command2_Click() ' " " Image1.Width = 1000' Image1.Height = 1000 Image1.Stretch = True

100 Line BorderColor 2 BorderStyle / 0(Transparent) 1(Solid) 2(Dash) 3(Dot) 4(Dash-Dot) 5(Dash-Dot-Dot) 6(Inside Solid) 3 BorderWidth / 4 X1 Y1 / 5 X2 Y2 /

101 90 Visual Basic BorderStyle 3 BorderColor BorderWidth Shape BorderColor BorderStyle BorderWidth FillColor / 2 FillStyle / 3 Shape

102 Shape1 Frame1 6 Option1 Shape Private Sub Option1_Click(Index As Integer) Shape1.Shape = Index 'Index Option

103 92 Visual Basic 4.11 VB MultiSelect 0 1 Space 2 Ctrl Shift 2 ListCount 3 List List List 0 ListCount 1 4 Selected List List List(1) Selected(1) True List(1) Selected(1) False 5 Sorted True False Sorted 6 SelCount MultiSelect 1 2 Selected

104 Style Click 2 AddItem Object.AddItem Item,Index Item Index Index Item Index Sorted True Item Sorted False Item 3 RemoveItem Object.RemoveItem Index Index 4 Clear Object.Clear

105 94 Visual Basic Label1 Label2 List1 List2 Command1 Command2 List1 4 MultiSelect 1 Private Sub Command1_Click() n = List1.ListCount - 1 i = 0 Do While i <= n If List1.Selected(i) Then List2.AddItem List1.List(i) List1.RemoveItem i n = n - 1 Else i = i + 1 End If Loop Private Sub Command2_Click() n = List2.ListCount - 1 i = 0 Do While i <= n If List2.Selected(i) Then List1.AddItem List2.List(i) List2.RemoveItem i n = n - 1 Else

106 4 95 i = i + 1 End If Loop Style

107 96 Visual Basic 2 Text Style 0 1 Text Style 2 Text Text Text List AddItem RemoveItem Change 2 Click 3 AddItem 4 Clear 5 RemoveItem Combo1 Label1 List Private Sub Combo1_Change() Label1.Caption = " " + Combo1.Text Private Sub Combo1_Click() Label1.Caption = " " + Combo1.Text

108 ms /18 s Enabled Object.Enabled=True False True Enabled True 2 Interval ms Interval 1000ms 1s 1s 1s n Interval 1000/n Timer Interval Label1 Label2 Timer1 Interval 100 Private Sub Timer1_Timer() Label2.Caption = Time 4.18

109 98 Visual Basic Path Drive Object.Drive= Drive1.Drive="c:\" 'Drive Drive ChDrive ChDriveDrive1.Drive 2. Path Object.Path=

110 Path 2 Pattern 3 Filename Change Click DblClick Label1 Drive1 Dir1 File1 Private Sub Dir1_Change() File1.Path = Dir1.Path Label1.Caption = "" Private Sub Drive1_Change() Dir1.Path = Drive1.Drive Label1.Caption = "" Private Sub File1_Click() If Len(Dir1.Path) > 3 Then Label1.Caption = " " + Dir1.Path + "\" + File1.FileName Else Label1.Caption = " " + Dir1.Path + File1.FileName End If 4.19 d d COMPUTER GSWDLL.DLL 4.20

111 100 Visual Basic VB 4.21

112 Max Min Max Min 0 Min Max Min Max 2 Value 3 LargeChange 1 4 SmallChange Scroll 2 Change

113 102 Visual Basic label1 Text1 VScroll1 Max 100 Min 0 HScroll1 Max 100 Min 0 Private Sub HScroll1_Change() Text1.Text = HScroll1.Value VScroll1.Value = HScroll1.Value Private Sub VScroll1_Change() Text1.Text = VScroll1.Value HScroll1.Value = VScroll1.Value

114 VB Form1 Label1 Picture1 Frame1 Timer1 Timer2 Command1 Frame1 5 Label2 2 Option1 Combo1 Timer1 Interval 400 Timer2 Label1 Interval 1000 Combo 'n Dim n As Integer Private Sub Form_Load() n = 0 'n Private Sub Command1_Click(Index As Integer) If Index = 0 Then ' Text1(0).SetFocus Else' Text1(0).Text = "" Text1(1).Text = ""

115 104 Visual Basic Text1(2).Text = "" Combo1.Text = "" Option1(0).Value = Empty End If Private Sub Timer1_Timer() ' e:\vbook 1.bmp 16.bmp ' n = n + 1 If n = 16 Then n = 1 fn = "e:\vbook\" + Trim(Str(n)) + ".bmp" Picture1.Picture = LoadPicture(fn) Private Sub Timer2_Timer() ' Label1.Caption = " :" + Str(Time) VB

116

117 106 Visual Basic

118

119 108 Visual Basic bmp e:\media

120 5 VB 5.1 Form VB VB Appearance 3D.Appearance= AutoRedraw.AutoRedraw[=True False] True False 3 BackColor ForeColor 4 BorderStyle.BorderStyle= Caption

121 110 Visual Basic.Caption= 6 FillStyle.FillStyle= Icon 8 MaxButton.MaxButton=True False True False 9 MDIChild MDI.MDIChild=True False True MDI False MDI 10 MinButton.MinButton=True False True False 11 Movable.Movable=True False True False 12 Picture 13 ScaleMode.ScaleMode= Visible.Visible=True False

122 5 111 True False 15 WindowsState.WindowsState= VB 1 Activate 2 Click 3 DblClick 4 Deactivate 5 Initialize MDI 6 Load 7 MouseDown 8 QueryUnload 9 Resize 10 Terminate MDI 11 Unload VB 1 Load VB

123 112 Visual Basic Load VB Load < > Load Form1 Form1 2 Show.Show 0 1 Show VB 3 Hide Visible False VB.Hide Hide VB 4 Unload Unload VB VB 4 1. Initialize Form_Initialize

124 5 113 Form_Initialize Sub Function Property 2. Load Form_Load Form_Load (hwnd) (hdc) Show Form_Load Hide Load Form_Load 3. Form1.Show Form1.Hide ' Form1 ' Form1 Unload QueryUnload QueryUnload QueryUnload QueryUnload Cancel True Unload 4. Nothing Name Nothing Set Form1=Nothing Terminate

125 114 Visual Basic (Name) ( ) Index Null 1. 1 ( ) 2 (Y) 2. Index Tab Microsoft Windows ( ) ( ) Frame Lable Menu Line Image Timer

126 5 115 GotFocus LostFocus GotFocus LostFocus SetFocus Enabled Visible True Enabled Visible Tab Tab Tab Tab 3 Command1 Command2 Command3 Command1 Tab Command2 Command3 Tab Command1 Command3 TabIndex Tab TabIndex Tab TabIndex 0 TabIndex 1 Tab VB Tab Command3 Tab TabIndex TabIndex Tab Tab Tab TabStop False TabStop False Tab Tab Name Caption Picture Proj5.1 Form1 Form1 " " "summer.jpg"

127 116 Visual Basic 5.1 Proj5-1 Form Proj5-1 Form2 BackColor Caption MaxButton = MinButton = &H00FFC0C0& " " 0 'False 0 'False label1 label2 5.3

128 Form2 Private Sub Form_Click() Label2.Caption =" " Private Sub Form_dblClick() Label2.Caption=" " Private Sub Form_Load() Label1.Caption=" " Proj5-1 Form2 5.4 Load label2 5.5 label2 5.4 Form2 (a)

129 118 Visual Basic 5.5 Form2 (b) 5.2 VB

130 Caption - Name Index Caption

131 120 Visual Basic VB Name_Click() Name VB Name_Click() Click Enabled Visible Proj5-1 Form3 label1 5.7

132 Name_Click 5.8 Form3

133 122 Visual Basic Private Sub menu111_click() Label1.Caption = " " Private Sub menu112_click() Label1.Caption = " " Private Sub menu113_click() Label1.Caption = " " Private Sub menu114_click() Label1.Caption = " " Private Sub menu115_click() Label1.Caption = " " Private Sub menu121_click() Label1.Caption = " " Private Sub menu122_click() Label1.Caption = " " Private Sub menu123_click() Label1.Caption = " " Private Sub menu124_click() Label1.Caption = " " Private Sub menu211_click() Label1.Caption = " " Private Sub menu212_click() Label1.Caption = " "

134 5 123 Private Sub menu213_click() Label1.Caption = " " Private Sub menu221_click() Label1.Caption = " " Private Sub menu222_click() Label1.Caption = " " Private Sub menu223_click() Label1.Caption = " " Private Sub menu224_click() Label1.Caption = " " Proj5-1 Form Form3 5.4 Proj5-1 Form4 label1 label2 label3 text1 text2 text Oper... Add... Sub... Mul

135 124 Visual Basic...- Spbar... Div Exit 5.10 Form4 Private Sub Add_Click() Text3.Text = Val(Text1.Text) + Val(Text2.Text) Private Sub Mul_Click() Text3.Text = Val(Text1.Text) * Val(Text2.Text) Private Sub Oper_Click() If Val(Text2.Text) = 0 Then Div.Enabled = False Else Div.Enabled = True End If Private Sub Sub_Click() Text3.Text = Val(Text1.Text) - Val(Text2.Text) Private Sub Div_Click() Text3.Text = Val(Text1.Text) / Val(Text2.Text) Private Sub Exit_Click() End Proj5-1 Form4 text1 12 text text

136 Form4 (a) 5.12 Form4 (b) 5.13 Form4 (c) 5.3

137 126 Visual Basic PopupMenu PopupMenu,flags,x,y,boldcommand flags PopupMenu x flags flags 0 x 4 x 8 x flags 0 2 boldcommand PopupMenu Oper 0 Div Oper Div 5.14 Div Proj5-1 Form5 label1 label2 label3 text1 text2 text3 5.15

138 Form5 Oper... Add... Sub... Mul...- Spbar... Div Oper Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single,Y As Single) ' PopupMenu If Button = 2 Then PopupMenu oper, 2 End If Private Sub Add_Click() Text3.Text = Val(Text1.Text) + Val(Text2.Text) Private Sub Mul_Click() Text3.Text = Val(Text1.Text) * Val(Text2.Text) Private Sub Sub_Click() Text3.Text = Val(Text1.Text) - Val(Text2.Text) Private Sub Div_Click() If Val(Text2.Text) <> 0 Then Text3.Text = Val(Text1.Text) / Val(Text2.Text) Else MsgBox " 2 0 ",vbokonly," " End If

139 128 Visual Basic Proj5-1 Form5 text1 10 text Form VB MDI Office Office 97 Word 97 Excel 97 VB MDIChild True MDI MDI MDI 1. MDI 1 MDI 2 3 MDI 4 MDI 5 MDI 6 MDI MDI 7 AutoShowChildren

140 MDI ActiveForm MDI Arrange MDI MDI VB Form1 MDI MDI MDI MDIForm MDI MDI 1. MDI VB Form1 MDI Form1 MDI MDIChild True 2. MDI MDI MDIChild True MDIChild MDI MDI 1. MDI MDI Load MDI Form1 Form2 Private Sub MDIForm1_Load Form1.Show Form2.Show

141 130 Visual Basic 2. MDI MDI UnloadMDI Unload Me QueryUnload MDI MDI 5.6 proj5-2 MDI MDIForm menu1 menu2 menu3 menu MDI MDI Form1 Form2 MDI MDI MDI MDIForm1 Private Sub MDIForm_Load() Form1.Show Form2.Show Private Sub menu1_click()

142 5 131 MDIForm1.Arrange vbcascade Private Sub menu2_click() MDIForm1.Arrange vbtilehorizontal Private Sub menu3_click() MDIForm1.Arrange vbarangeicons Private Sub menu4_click() Unload Me MDIForm MDIForm1 5.19

143 132 Visual Basic 5.7 MDI proj5-3 MDI MDIForm1 Picture1 5, 5.20 Picture1 Align 1 'Top Command1 Caption " " Command2 Caption " " Command3 Caption " " Command4 Caption " " Command5 Caption " " Label1 AutoSize -1 'True 5.20 MDIForm1 MDI Form1 Proj5-1 Form3 MDIForm1 Dim i As Integer Private Sub command1_click() i = i + 1 Dim NewDoc As New Form1 NewDoc.Caption = " " + Str(i) + " " NewDoc.Show Label1.Caption = Str(Forms.Count - 1) + " " Private Sub command2_click() MDIForm1.Arrange vbcascade

144 5 133 Private Sub command3_click() MDIForm1.Arrange vbtilehorizontal Private Sub command4_click() MDIForm1.Arrange vbarrangeicons Private Sub Command5_Click() Unload Me Private Sub Command6_Click() Label1.Caption = Str(MDIForm1.Count) MDIForm1 MDI 4 MDI 5.21 MDI 5.21 MDI Form

145 134 Visual Basic text

146 6 Windows GUI Windows VB 6.1 VB VB.bmp.dib.ico.cur.wmf.emf.jpg.gif Bitmap ( ).bmp.dib Icon Windows ico Metafile.wmf.emf JPEG 8 24 Internet GIF CompuServe 256 Internet 1. VB Image PictureBox

147 136 Visual Basic Image Image( ) Picture Picture LoadPicture() Picture GetData Picture PictureBox Image Print MDI( ) MDI ( ) 2. 1 Picture Picture VB Windows95 VB 2 LoadPicture LoadPicure Picture objectname.picture=loadpicture("[filename]") objectname Name Filename filename ("") Picture picdisplay imgdisplay imgdisplay.picture=picdisplay.picture Picture

148 6 137 objectname.picture=clipboard.getdata([format%]) 6.1 Form1 Picture1 Image1 File1 Picture1 AutoSize True Appearance 0-Flat Image1 Stretch True File1 Path e:\media Pattern *.bmp;*.ico;*.cur;*.jpg Dim filepath As String Private Sub File1_Click() Picture1.Picture = LoadPicture(filepath + "\" + File1.FileName) Image1.Picture = Picture1.Picture Form1.Picture = Picture1.Picture Private Sub Form_Load() filepath = "e:\media" File1.Path = filepath Form1 6.1 HAPPY.BMP 6.1 Form1 File1_Click() LoadPicture() Picture

149 138 Visual Basic AutoSize True 1 2 AutoSize AutoSize ( ) AutoSize True AutoSize True 3 Stretch True Stretch False ( ) 1. Line BorderCo1or QColor() RGB() BorderStyle BorderWidth Line Circle

150 6 139 Shape FillColor FillStyle Form command1 Private Sub Command1_Click() Text4.Text = Text1.Text * Text2.Text * Text3.Text 6.2 Form2 Form

151 140 Visual Basic 6.2 VB Cls Pset Point Line Circle PaintPicture Print Print Set Line Circle ( AutoRedraw ) 6.2.1

152 ( ) VB 7 (0 0) twips Screen( ) VB twips ( ) ScaleMode 6.2 VB ScaleMode 0 ScaleWidth ScaleHeight ScaleTop ScaleLeft VB ScaleMode 0 1 twips 144twips =120twips =240twips CurrentX CurrentY Height Width ScaleHeight ScaleWidth Left Top ScaleLeft ScaleTop ( ) (0 0)

153 142 Visual Basic ( ) 1 ScaleLeft ScaleTop ScaleHeight ScaleWidth ScaleLeft ScaleTop ScaleHeight ScaleWidth Form1 (10 20) (60 50) Form1.ScaleWidth=50 Form1.ScaleHeight=30 Form1.ScaleTop=20 Form1.ScaleLeft= (ScaleLeft ScaleTop) (ScaleLeft+ScaleWidth ScaleTop+ScaleHeight) (ScaleLeft ScaleTop+ScaleHeight) (ScaleLeft+ScaleWidth ScaleTop) (50 100) ScaleLeft=20 ScaleTop=100 ScaleWidth=50 ScaleHeight=-100

154 6 143 Picture1 6.5 Private Sub Form_Load() Picture1.ScaleLeft=-15 Picture1.ScaleTop=-25 Picture1.ScaleWidth=30 Picture1.ScaleHeight=50 (-15,-25) (15,-25) (0 0) X (-15,25) (15,25) Y Scale Scale ScaleTop ScaleLeft ScaleWidth ScaleHeight Scale [formname] [pictureboxname].scale[(x1 y1)-(x2 y2)] (x1 y1) (x2 y2) x1=scaleleft;y1=scaletop;x2=scalewidth+x1;y2=scaleheight+y1 Scale (0 0) Scale Scale(0 2)-(20 0) VB 1. PSet PSet

155 144 Visual Basic DrawWidth PSet [formname] pictureboxname.pset[step](x,y)[,color] (x y) color Long ForeColor color QBColor() RGB() Step ( ) (x,y) 6.3 Form3 Dim mouse As Boolean ' Private Sub Form_Load() mouse = False Me.DrawWidth = 2 ' ( ) Me.ForeColor = vbred ' Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) mouse = True Me.PSet (X, Y) Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If mouse Then Me.PSet (X, Y) Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) mouse = False Form3 Form3 6.6 PSet 6.6 Form3

156 Line Line ( ) 1 Line objectname.line [[Step](x1,y1)]-[Step](x2,y2)[,color] Step (x1,y1) Step (x1,y1) (x1,y1) (0,0) (x1,y1) (CurrentX,CurrentY) (x2,y2) Step (x2,y2) (x1,y1) (x2,y2) color ForeColor DrawWidth DrawStyle DrawStyle vbsolid 0 vbdash 1 vbdot 2 vbdashdot 3 vbdashdotdot 4 vbinvisible 5 vbinsidesolid Form4 Const pi = Private Sub star(x As Single) Randomize n = Int(Rnd * 16) colr = QBColor(n) Line -Step(x * Sin(pi / 10), -x * Cos(pi / 10)), colr Line -Step(x * Sin(pi / 10), x * Cos(pi / 10)), colr Line -Step(-x * Cos(2 * pi / 10), -x * Sin(2 * pi / 10)), colr Line -Step(x, 0), colr Line -Step(-x * Cos(2 * pi / 10), x * Sin(2 * pi / 10)), colr

157 146 Visual Basic Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) PSet (x, y) star (Rnd * 2000) star 2 /10 Rnd Randomize Form4 Form Form4 6.5 Sin x Cos x Sin x Cos x Form5 Picture1 Appearance 0 BackColor 6.5 menu 6.5 menu popmenu...sin x hs 0...Cos x hs 1... hs 2 Const pi = Private Sub Form_paint() With Picture1

158 6 147.Height = Me.ScaleHeight.ScaleMode = 6 oldx =.ScaleWidth / 2 oldy =.ScaleHeight / 2.Cls ' Picture1.Line (oldx,.top)-(oldx,.scaleheight), RGB(255, 0, 0) Picture1.Line (0, oldy)-(.scalewidth, oldy), RGB(255, 0, 0) End With Picture1.CurrentX = oldx - 4 Picture1.CurrentY = oldy ' Picture1.Print 0 For xt = -Int(oldx) To Int(oldx) Step 0.5 If xt <> 0 Then st = xt * 10 * pi Picture1.CurrentX = oldx + st - 3 Picture1.CurrentY = oldy ' x Picture1.Print xt & " " Picture1.Line (oldx + st, oldy - 1)-(oldx + st, oldy), RGB(255, 0, 0) End If Next xt For yt = -5 To 7 If yt <> 0 Then st = yt * 10 Picture1.CurrentX = oldx - 4 Picture1.CurrentY = oldy + st - 1 ' y Picture1.Print yt Picture1.Line (oldx, oldy + st)-(oldx + 1, oldy + st), RGB(255, 0, 0) End If Next yt Label1.Caption = "" Private Sub Form_Resize() Form_paint

159 148 Visual Basic Private Sub hs_click(index As Integer) oldx = Picture1.ScaleWidth / 2 oldy = Picture1.ScaleHeight / 2 Select Case Index Case 0 Label1.Caption = "Sin(x) " For t = -oldx To oldx Step 0.01 xt = 10 * t yt = 10 * Sin(t) Picture1.PSet (xt + oldx, oldy - yt), RGB(0, 127, 127) Next Case 1 Label1.Caption = "Cos(x) " For t = -oldx To oldx Step 0.01 xt = 10 * t yt = 10 * Cos(t) Picture1.PSet (xt + oldx, oldy - yt), RGB(0, 127, 127) Next Case 2 Picture1.Cls Form_paint Exit Sub End Select Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu popmenu, 6 End If Form5 Form5 6.8 Sin x 6.9 Sin x 6.8 Form5 (1)

160 Form5 2 2 Line Line Line B F Line objectname.line[[step](x1,y1)]-[step](x2 y2)[,color],[b[,f]] Step (x1,y1) Step Step (CurrentX,CurrentY) (x2,y2) Step Step (x1,y1) (x1,y1) (CurrentX CurrentY) color ( ) ForeColor B Line ( ) F B ( B ) FillStyle Circle 6.6

161 150 Visual Basic 6.6 FillStyle vbfssolid 0 vbfstransparent 1 ( ) vbhorizontalline 2 vbverticalline 3 vbupwarddiagonal 4 vbdownwarddiagonal 5 vbcross 6 vbdiagonalcross 7 FillStyle 1( ) FillColor Form FillColor DrawWidth DrawStyle 3. Circle Circle DrawWidth DrawStyle FillColor FillStyle Circle 1 Circle objectname.circle [Step](x,y),radius[,color] (x,y) Step (x,y) (CurrentX,CurrentY) Step (x,y) radius color ForeColor FillColor ( ) FillStyle ( ) 6.6 Form6 Private Sub Form_Load() Show Dim X, Y, r, r1, i Randomize ScaleMode = 6 ' mm

162 6 151 DrawWidth = 2 ' 2 X = ScaleWidth / 2 ' r Y = ScaleHeight / 2 If ScaleWidth > ScaleHeight Then r = Y Else r = X End If For r1 = 0 To r ' r1 Circle (X, Y), r1, RGB(255 * Rnd, 255 * Rnd, 255 * Rnd) Next Form Form6 2 Circle 1:1 objectname.circle[step](x,y),radius[,color],,,aspect aspect 1 ( ) 1 1 aspect Form7 Private Sub Form_Load() Show Scale (-15, 14)-(15, -14) Circle (0, 0), 7 Circle (0, 0), 7,,,, 2.5 ' ' '

163 152 Visual Basic FillStyle = 7 Circle (0, 0), 7, RGB(255, 0, 0),,, 0.4 ' 6.11 Form7 3 Circle objectname.circle [Step](x,y),radius[,color][start,end][,aspect] start end 0 2 start end start end start end start end 0 /2 0 /2 0 /2 0 - /2 3 / Form8 Const pi = Private Sub Form_Load() Show ForeColor = vbred DrawWidth = 2 Circle (1800, 500), 1000,, -pi, -1.5 * pi ' Circle (3500, 500), 1000,, pi, 1.5 * pi '

164 Form8 6.9 Form9 Picture1 Frame1 Picture1 Appearance 0 Label1 Label2 Label3 Text1 Text2 Text3 Command1 Const pi = Private Sub Command1_Click() Dim a As Single Dim b As Single Dim c As Single Dim s As Single a = Val(Text1.Text) b = Val(Text2.Text) c = Val(Text3.Text) s = a + b + c If s = 0 Then MsgBox " ", vbokonly, " " Exit Sub End If a = a / s b = b / s Call hb(a, b) Private Sub hb(a As Single, b As Single) Picture1.FillStyle = 0 For i = 0 To 200 Picture1.FillColor = vbred ' Picture1.Circle (1500, i), 1000, vbred, -2 * pi, -2 * pi * a, 2 / 3

165 154 Visual Basic Picture1.FillColor = vbgreen ' Picture1.Circle (1500, i), 1000, vbgreen, -2 * pi * a,-2 * pi * (a + b), 2 / 3 Picture1.FillColor = vbblue' Picture1.Circle (1500, i), 1000, vbblue, -2 * pi * (a + b),-2 * pi,2 / 3 Next Picture1.FillColor = vbred ' Picture1.Circle (1500, i), 1000, vbwhite, -2 * pi, -2 * pi * a, 2 / 3 Picture1.FillColor = vbgreen ' Picture1.Circle (1500, i), 1000, vbwhite, -2 * pi * a,-2 * pi * (a + b), 2 / 3 Picture1.FillColor = vbblue ' Picture1.Circle (1500, i), 1000, vbwhite, -2 * pi * (a + b),-2 * pi, 2 / 3 Command1_Click hb hb 200 For...Next 200 Form9 Form Form9 6.3

166 AutoRedraw True Paint AutoRedraw Paint 1. AutoRedraw ( ) -1(True) 0(False) AutoRedraw True PictureBox AutoRedraw False 2. Paint Paint Circle Line AutoRedraw Paint AutoRedraw AutoRedraw False Paint AutoRedraw Paint AutoRedraw AutoRedraw AutoRedraw AutoRedraw True Paint Paint 6.10 AutoRedraw Paint Form10 Form11 Form10 Command1 Private Sub Command1_Click()

167 156 Visual Basic Form11.Show Form11 Private Sub Form_Click() Me.Scale (0, 0)-(18, 8) Me.AutoRedraw = True Me.DrawWidth = 2 Circle (3, 4), 3, vbred ' Me.AutoRedraw = False Line (7, 1)-Step(4, 6), vbgreen, B ' Line (13, 7)-Step(4, 0), vbblue ' Line Step(0, 0)-Step(-2, -6), vbblue Line Step(0, 0)-Step(-2, 6), vbblue Private Sub Form_Paint() Line (7, 1)-Step(4, 6), vbgreen, B ' Form11 Form_Click() AutoRedraw True AutoRedraw False Form_Paint() Form10 Form10 Form11 Form11 Form11 Form_Click 6.14 Form10 Form10 Form11 Form11 Form Form11

168 Form11 Form11 AutoRedraw True Form11 AutoRedraw False Form_Paint AutoRedraw Paint PaintPicture Printer Picture LoadPicture object.paintpicture pic,dx,dy,dw,dh,sx,sy,sw,sh,opcode object object pic object Picture dx,dy dw,dh sx,sy sw,sh

169 158 Visual Basic opcode PaintPicture Opcode ScaleMode AutoRedraw ScaleMode AutoRedraw True PaintPicture PaintPicture 6.11 PaintPicture Form12 Picture1 Picture2 Command1 Command2 Picture1 Picture Beany.cur Picture2 AutoRedraw True Private Sub command1_click() ' Dim sw, sh, sx, sy As Integer sw = Picture1.ScaleWidth sh = Picture1.ScaleHeight sx = sw sy = 0 Picture2.Picture = LoadPicture("") ' Picture2.PaintPicture Picture1.Picture, 0, 0, sw, sh, sx, sy, -sw, sh Private Sub Command2_Click() ' Dim sw, sh, sx, sy, dw, dh As Integer sw = Picture1.ScaleWidth sh = Picture1.ScaleHeight dw = 1.5 * sw dh = 1.5 * sh sx = 0 sy = sh Picture2.Picture = LoadPicture("") ' Picture2.PaintPicture Picture1.Picture, 0, 0, dw, dh, sx, sy, sw, -sh Form12 Form Picture2

170 Picture Picture GIF JPEG SavePicture SavePicture pic,fn pic fn 6.12 SavePicture Form13 Picture1

171 160 Visual Basic Command1 Picture Winter.jgp Private Sub Command1_Click() SavePicture Picture1.Image, "e:\media\abc.bmp" Picture1 e:\media\abc.bmp VB VB VB VB 6.20

172 Cos(2x)Sin(5x)

173 7 7.1 VB ASCII C

174 7 163 n n+1 n n ( ) 7.2 ASCII Open Open [For [Access ][Lock]As[#] [Len= ] Output Input Append Read

175 164 Visual Basic Write ReadWrite Append Lock Shared LockRead LockWrite FreeFile() Output Output Append Append VB Print #, 1[;][","][; 2[;][","] Write #, 1[, 2] Print Write try.txt txtmytext FileNum=FreeFile() Open "try.txt" For 0utput As FileNum Print #FileNum,txtMyText.Text Close FileNum Input Input #, 1[, 2]{, }, Line Input #, Input$ ( # )

176 7 165 try.txt txtourtext FileNum=FreeFile() 0pen try.txt For Input As FileNum txtourtext.text=input$(lof(filenum),filenum) Close Close [# 1][ # 2] Close ( ) 1. LOF() LOF( ) LOF 1 #1 2. LOC() LOC( ) EOF() EOF( ) True False

177 166 Visual Basic 7.1 Form1 txt MultiLine True Command1 Command2 7.3 Private Sub Command1_Click() ' fno = FreeFile Open "File.dat" For Output As #fno Print #fno, txt.text Close #fno 7.3 Form1 Private Sub Command2_Click() ' txt.text = "" fno = FreeFile Open "File.dat" For Input As #fno Do Until EOF(fno) Line Input #fno, newline txt.text = txt.text & newline & Chr(13) + Chr(10) Loop Close #fno Form1 File.dat 7.4

178 Form Open For Random As # [Len= ] Open Put Put [#],[ ], # 1

179 168 Visual Basic Put #1,student student # Get Get [#],[ ], 1 Get #1,1,student 1 student Put 1 5 Positlon 6 LastRecord = LastRecord + l Put #FileNum, LastRecord Employee N : 'recordnum i=n DO While i<=recordnum Get #1,i+1,recvar Put #,i,recvar i=i+1 Loop ' i recordnum=recordnum-1

180 Kill Name 7.2 Form2 4 4 Text1 4 Command1 Command Form2 ' stud.dat Private Type StudType No As String * 4 Name As String * 10 Age As Integer Class As String * 5 End Type Dim Stud As StudType Dim Recnum As Integer Private Sub Form_Load() For i = 0 To 3 Text1(i).Text = "" Next Private Sub Command1_Click(Index As Integer) On Error Resume Next Recnum = InputBox(" ", " ") If Recnum = 0 Then Exit Sub Open "stud.dat" For Random As #1 Len = Len(Stud)

181 170 Visual Basic If Index = 0 Then totalrec = LOF 1 / Len(Stud) ' For i = totalrec To Recnum Step -1 Get #1, i, Stud Put #1, i + 1, Stud Next Stud.No = Text1(0).Text Stud.Name = Text1(1).Text Stud.Age = Text1(2).Text Stud.Class = Text1(3).Text Put #1, Recnum, Stud End If If Index = 1 Then totalrec = LOF 1 / Len(Stud) ' For i = Recnum To totalrec - 1 Get #1, i + 1, Stud Put #1, i, Stud Next Stud.No = "" Stud.Name = "" Stud.Age = Empty Stud.Class = "" Put #1, i, Stud End If If Index = 2 Then Get #1, Recnum, Stud Text1(0).Text = Stud.No Text1(1).Text = Stud.Name Text1(2).Text = Stud.Age Text1(3).Text = Stud.Class End If Close Private Sub Command2_Click(Index As Integer) End 7.4

182 Open For Binary As # Open Open Len Open Put #,[ ], Put Get #,[ ], Seek Seek Seek() Seek( ) Seek Seek(,recnumber) recnumber Person1 Type Person1 ID As Integer Salary As Currency LastReviewDate As Long FirstName As String*15 LastName As String*15

183 172 Visual Basic Title As String*15 ReviewComments As String*150 End Type 209 Type Person2 ID As Integer Salary As Currency LastReviewDate As Long FirstName As String LastName As String Title As String ReviewComments As String End Type Person2 7.3 Form3 Text1 4 Command1 Command2 Command3 Command4 7.6 Dim mystring As String Private Sub Command1_Click() mystring = String$(10, " ") Get #1, 1, mystring Text1.Text = mystring 7.6 Form3

184 7 173 Private Sub Command2_Click() mystring = String$(26, " ") Get #1, 11, mystring Text1.Text = mystring Private Sub Command3_Click() mystring = String$(26, " ") Get #1, 37, mystring Text1.Text = mystring Private Sub Command4_Click() Close #1 End Private Sub Form_Load() Open "try.dat" For Binary As #1 mystring = " " Put #1, 1, mystring mystring = "abcedfghijklmnopqrstuvwxyz" Put #1,, mystring mystring = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Put #1,, mystring Form3 Form3 try.dat Form3

185 174 Visual Basic ? 7.2 (xs.dat) xs.dat xs1.dat 7.10

186 xs1.dat

187 8 8.1 Windows Clipboard Windows VB Clipboard Clipboard Clipboard Clear Clipboard Clipboard.Clear Windows Clipboard Clipboard SetData vbcfdib Clipboard SetText vbcftext Clipboard GetText GetData Clipboard Clipboard Clipboard SetText GetText 8.1 Clipboard GetText SetText 8.1 SetText GetText SetText Clipboard SetText

188 8 177 Clipboard.SetText data[,format] data format vbcftext vbcflink DDE vbcftext GetText Clipboard =Clipboard.GetText() SetText GetText SelStart SelLength SelText 8.1 Form1 Text1 Text2 Label1 command1 command2 MultiLine True Form1 Private Sub Command1_Click() Clipboard.Clear ' Clipboard.SetText Text1.SelText ' Private Sub Command2_Click() Text2.Text = Clipboard.GetText(vbCFText) ' Private Sub Form_Load() Text1.Text = " [ ] _ [ ] " Text2.Text = " "

189 178 Visual Basic Form Form Clipboard Clipboard (GetData SetData GetFormat) SetData Clipboard Clipboard.SetData data,format data Clipboard format 8.1 VB Clipboard format SetData

190 Format vbcfbitmap 2 (.bmp ) vbcfmetafile 3 (.wmf ) vbcfdib 8 (DIB) vbcfpalette 9 Clipboard.GetData(format) Clipboard format Clipboard Clipboard (1 1) DIB SetData Clipboard GetData Clipboard Private Sub Form_Click() Dim Msg As String ' Msg = " [ ] " MsgBox Msg ' Clipboard.Clear ' Clipboard.SetData LoadPicture("PAPER.BMP") ' Msg = " [ ] " MsgBox Msg ' Picture=Clipboard.GetData() ' Msg = " " MsgBox Msg ' Picture=LoadPicture() ' GetFormat(Format) Clipboard Format Format Format vbcflink &HBF00 DDE vbcftext 1 vbcfbitmap 2 (.bmp ) vbcfmetafile 3 (.wmf ) vbcfdib 8 (DIB) vbcfpalette 9

191 180 Visual Basic Clipboard GetFormat True False GetFormat Clipboard 8.2 GetFormat Clipboard Form2 command1 command2 command3 Form Form2 Private Sub Command1_Click() Dim ClpFmt As Integer Dim Msg As String ClpFmt = 0 If Clipboard.GetFormat(vbCFText) Then ClpFmt = ClpFmt + 1 If Clipboard.GetFormat(vbCFBitmap) Then ClpFmt = ClpFmt + 2 If Clipboard.GetFormat(vbCFDIB) Then ClpFmt = ClpFmt + 4 If Clipboard.GetFormat(vbCFRTF) Then ClpFmt = ClpFmt + 8 Select Case ClpFmt Case 1 Msg = " " Case 2, 4, 6 Msg = " " Case 3, 5, 7 Msg = " " Case 8, 9 Msg = " RFT " Case Else Msg = " " End Select

192 8 181 MsgBox Msg, vbokonly, " " Private Sub Command2_Click() Clipboard.SetData LoadPicture("c:\my documents\aa.bmp") Private Sub Command3_Click() Clipboard.SetText " " Private Sub Form_Load() Clipboard.Clear Form2 Form Form2 8.2 VB Shift Ctrl Alt VB OLE Drag OLE Windows

193 182 Visual Basic MouseIcon MousePointer 1. MouseIcon MouseIcon MousePointer 99 Object.MouseIcon = LoadPicture(pathname) Object.MouseIcon = picture pathname picture Form PictureBox Image Picture VB (.cur) ( Windows NT ) MouseIcon Windows NT (.ico) MouseIcon VB (.ani) 32 Windows 2. MousePointer MousePointer Object.MousePointer = value value value vbdefault 0 ( ) vbarrow 1 vbcrosshair 2 (crosshair ) vbibeam 3 I vbiconpointer 4 ( ) vbsizepointer 5 ( ) vbsizenesw 6 ( ) vbsizens 7 ( ) vbsizenwse 8 ( ) vbsizewe 9 ( )

194 8 183 vbuparrow 10 vbhourglass 11 ( ) vhnodrop 12 vbarrowhourglass 13 vbarrowquestion 14 vbsizeall 15 vbcustom 99 MouseIcon MousePointer (11) 8.3 MouseIcon Form3 Image1 Picture \Image\Spring.jpg MousePointer 99 MouseIcon \Image\Pointer.cur Form3 Pointer.cur Form Click DblClick

195 184 Visual Basic MouseDown MouseUp MouseMove ( ) C1ick DblClick MouseDown MouseUp MouseMove MouseDown MouseUp Private Sub object_mousedown(button As Integer, shift As Integer x As Single, y As Single) Private Sub object_mouseup(button As Integer shift As Integer x As Single, y As Single) Private Sub object_mousemove(button As Integer, shift As Integer x As Single, y As Single) object button MouseDown MouseUp button ( 0) ( 1) ( 2) shift button Shift Ctrl Alt x,y x y ScaleHeight ScaleWidth ScaleLeft ScaleTop 1. button button ( 0) ( 1) ( 2) Button 8.5

196 M R L 8.8 button 8.5 button 000( 0) 001( 1) vbleftbutton 010( 2) vbrightbutton 011( 3) vbleftbutton vbrightbutton 100( 4) vbmiddlebutton 101( 5) vbleftbutton vbmiddlebutton 110( 6) vbrightbutton vbmiddlebutton 111( 7) vbleftbutton vbrightbutton vbmiddlebutton 2. Shift Shift Shift ( 0) Ctrl ( 1) Alt ( 2) Shift Ctrl Alt Shift Shift 8.6 Shift Shift 000( 0) 001( 1) VbShiftMask Shift 010( 2) vbctrlmask Ctrl 011( 3) vbshiftmask cbctrlmask Shift Ctrl 100( 4) vbaltmask Alt 101( 5) vbshiftmask vbaltmask Shift Alt 110( 6) vbctrlmask vbaltmask Ctrl Alt 111( 7) VbCtrl vbaltmask vbshiftmask Shift Ctrl Alt

197 186 Visual Basic A C S Shift Ctrl Alt 8.9 Shift MouseDown MouseUp Click DblC1ick MouseDown MouseUp Click DblClick 1 MouseUp x y MouseDown MouseMove MouseUp Form Form4

198 8 187 ' DrawNow Dim DrawNow As Boolean Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) DrawNow = True CurrentX = X CurrentY = Y Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) If DrawNow Then Line -(X, Y) Circle (X, Y), 50 End If Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _ X As Single, Y As Single) DrawNow = False Form4 Form Form4 8.3 VB VB

199 188 Visual Basic DragMode DragIcon DragDrop DragOver Drag Menu Timer Line Shape DragMode DragIcon Drag DragDrop DragOver DragMode DragIcon Drag Menu Timer Line Shape DragDrop DragMode 1-Automatic ( ) DragDrop DragDrop DragOver DragOver DragDrop DragMode 1-Automatic Click MouseDrop 8.12

200 8 189 DragMode=1 DragOver DragOver DragDrop 8.12 DragMode=0 DragOver DragOver MouseDown DragDrop Drag 8.13 DragMode 0-Manual ( ) MouseDown Drag VB DragIcon Picture DragIcon DragIcon VB DragIcon DragIcon Set Image1.DragIcon = Image2.DragIcon Picture DragIcon DragIcon Set Image1.DragIcon = Image3.Picture LoadPicture Set Image1. DragIcon = LoadPicture("c:\Icons\Disk04.ico") VB DragDrop (

201 190 Visual Basic ) DragDrop source x y source As Control 8.5 Form5 label1 command1 command2 command3 DragMode 1-Automatic Form5 label1 Private Sub Label1_DragDrop(Source As Control, X As Single, Y As Single) Select Case Source.Caption Case " " Label1.FontName = " _GB2312" Case " " Label1.FontName = " " Case " " Label1.FontName = " " End Select Form5 Form5 8.15

202 Form5 Source.Value Value DragMode VB DragMode 1-Automatic ) MouseDown MouseUp MouseDown DragMode 0-Manual Drag Drag object.drag action action vbcancel 0 cbbegindrag 1 cbenddrag 2 vbbegindrag Drag vbenddrag DragDrop vbcancel vbenddrag DragDrop 8.6 Form6 label1 label2 command1 command2 command3 DragMode

203 192 Visual Basic 0-Manual Form6 Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single,Y As Single) Command1.Drag vbbegindrag Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single,Y As Single) Command2.Drag vbbegindrag Private Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single,Y As Single) Command3.Drag vbbegindrag Private Sub Label1_DragOver(Source As Control, X As Single, Y As Single, State As Integer) Source.Drag vbenddrag Select Case Source.Caption Case " " Label1.FontName = " _GB2312" Case " " Label1.FontName = " " Case " " Label1.FontName = " " End Select Private Sub Label2_DragOver(Source As Control, X As Single, Y As Single, State As Integer) Select Case Source.Caption Case " " Label2.FontName = " _GB2312" Case " " Label2.FontName = " " Case " " Label3.FontName = " " End Select

204 8 193 Label1_DragOver Label2_DragOver Source.Drag vbenddrag label2 label1 label1 label2 Form6 Form Form6 8.4 KeyPress KeyUp KeyDown ( ) Text VB 8.8

205 194 Visual Basic 8.8 KeyPress KeyDown KeyUp ASCII KeyPreview True KeyPreview KeyPress KeyDown KeyUp KeyPress Shift Ctrl Alt PageUp PageDown (KeyPress ) ( ) KeyDown KeyPess KeyUp KeyPress KeyDown KeyUp KeyUp KeyDown KeyPress KeyPress ASCII Enter Tab BackSpace KeyPress ( Shift ) 1. KeyPress ASCII KeyPress ASCII KeyPress Enter Tab BackSpace KeyDown KeyUp ASCII KeyPress

206 8 195 Private Sub Textl_KeyPress(KeyAscii As Integer) KeyAscii=Asc(UCase(Chr(KeyAscii))) KeyAscii ASCII Chr ASCII UCase Asc ASCII KeyPress KeyPress BackSpace Private Sub Textl_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then MsgBox " BACKSPACE " VB BackSpace ASCII 8 vbkeyback KeyPress Enter KeyPress Enter ( 13) Private Sub Textl_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then KeyAscii = 0 2. KeyDown KeyUp KeyUp KeyDown KeyDown KeyUp KeyPress A KeyDown A ASCII a KeyDown ASCII shift KeyPress ASCII KeyDown KeyUp Private Sub object_keydown(keycode As Integer,shift As Integer) Private Sub object_keyup(keycode As Integer,shift As Integer) object keycode vbkeyf1(f1 ) vbkeyhome(home ) VB shift Shift Ctrl Alt shift Shift ( 0) Ctrl ( 1) Alt ( 2)

207 196 Visual Basic Ctrl Alt shift 6 keycode ASCII ASCII A a keycode Asc( A ) Shift KeyDown A A a Private Sub Text1_KeyDown(KeyCode As Integer Shift As Integer) If KeyCode = vbkeya Then MsgBox " A " shift shift Private Sub Text1_KeyDown(KeyCode As Integer Shift As Integer) If KeyCode=vbKeyA And Shift=1 Then MsgBox " A " ASCII 1! keycode Asc("1")! shift KeyDown KeyUp (Fl~F16) (Home PageUp Delete ) (Right Left Up DownArrow) ASCII Private Sub Text1_KeyDown(KeyCode As Integer Shift As Integer) If KeyCode=vbKeyHome Then MsgBox " Home " KeyDown KeyUp KeyPreview True KeyPreview True KeyPress KeyUp KeyDown Click Default True Enter Click Cancel True Esc Click command1 Click Default Cancel

208 8 197 True Enter Esc KeyDown Private Sub Command1_Click() End Tab TabStop False Tab KeyPreview True keyascii keycode

209 198 Visual Basic

210 KeyCode 8.24 KeyCode

211 9 9.1 VB Point Public Type Point x As Integer y As Integer End Type Point p setvalue p display Dim p As Point Public Sub setvalue(byval a As Integer, ByVal b As Integer) p.x = a p.y = b Public Sub display() MsgBox "(" + Str(p.x) + "," + Str(p.y) + ")" Point CPoint CPoint

212 VB 9.1 Class1 Form1.EXE 1 Class1 9.1 Class1 9.1 Class1 Name ReverseName Name Initialize Terminate 2 Initialize Terminate Form1 label1 label2 text1 text2 command1 Private Sub Command1_Click() Set myobject = New Class1 myobject.name = Text1.Text myobject.reversename Text2.Text = myobject.name

213 202 Visual Basic 9.2 Form1 text text Form1 9.3 Form1 Command1_Click() Class1 myobject Name myobject. myobject ReverseName Name Name text2 Public Public Public

214 ( ) ( ) Student Public name As String Public age As Integer Private Private f As Single Private c As Single 1. Class x Integer Long Class Property Get 2. Class x myobject myobject.x VB VB

215 204 Visual Basic 9.2 Class2 'pn n Private pn As Integer Public Property Get n() As Integer n = pn End Property Public Property Let n(byval Newn As Integer) If (Newn <= 0) Then MsgBox "n 0", vbokonly, " " Else pn = Newn End If End Property myobject Class2 x=myobject.n Property Get pn myobject.n=10 Property Let Set myobject = New Class2 myobject.n = 10 ' Property Let pn=10 x=myobject.n ' Property Get pn n x= Visible 2 True False Boolean

216 9 205 Single Double String VB VB Property Get Property Let Property Set ( ) Property Get Property Let Property Set Set VB Property Set Property Let Property Get Property Get propertyname( 1,..., n ) As type Property Let Property Let propertyname( 1,..., n, n+1 ) Property Set Property Set propertyname( 1,..., n, n+1 ) Property 1,..., n Property Get Property Let Property Set Property Get Property Let Property Set n+1 Property Let Private AValue As Variant Public Property Let PropArr(ByVal X As Integer,_ ByVal Y As Integer,ByVal NewValue As Variant)

217 206 Visual Basic... AValue=NewValue End Property Property Get Property Let Public Property Get PropArr(ByVal X As Integer,ByVal Y As Integer) As Variant... PropArr(X,Y)=AValue End Property Property Set Variant 9.4 VB Property Let Propname(a,b,c)=d Property Let Propname(x,y,z,w) 9.4 Property Let Property Let Property Set 9.3 Class * 32.0 Class3 Private f As Single Private c As Single Public Property Get cs() As Single cs = c End Property Public Property Let cs(byval newc As Single) c = newc End Property Public Property Get fs() As Single fs = f End Property Public Property Let fs(byval newf As Single)

218 9 207 f = newf End Property Public Sub trans() c = (5 / 9) * (f - 32) Form3 9.5 label1 label2 text1 text2 command1 Private Sub Command1_Click() Set myobject = New Class3 myobject.fs() = Val(Text1.Text) myobject.trans Text2.Text = myobject.cs() 9.5 Form3 Form Form3

219 208 Visual Basic Sub Function Class Comp Public Function Public Function Comp() As Double... End Function Private Sub Function Function VB (5) 4 None 5 6 None VB 9.3

220 PercentDone Class5 Class5 Class5 Class5 PercentDone Class5 PercentDone.EXE Form Name Class5 Caption Caption Name label1 Caption Form5 Event ByVal ByRef

221 210 Visual Basic Class5 PercentDone Option Explicit Public Event PercentDone(ByVal Percent As Single, ByRef Cancel As Boolean) PercentDone Percent ByRef Cancel True PercentDone Class5 LongTask LongTask PercentDone Public Sub LongTask(ByVal Duration As Single, ByVal MinInterval As Single) Dim Threshold As Single Dim Start As Single Dim blncancel As Boolean Start = Timer Threshold = MinInterval Do While Timer < (Start + Duration) ' If Timer > (Start + Threshold) Then RaiseEvent PercentDone(Threshold / Duration, blncancel) ' If blncancel Then Exit Sub Threshold = Threshold + MinInterval End If Loop MinInterval RaiseEvent PercentDone LongTask blncancel True True WithEvents Class5 PercentDone Form5 Option Explicit Private WithEvents myobject As Class5 Private mblncancel As Boolean WithEvents myobject myobject Form5 WithEvents mblncancel LongTask WithEvents

222 9 211 WithEvents As Object WithEvents As New WithEvents WithEvents WithEvents WithEvents myobject Class WithEvents myobject_ WithEvents myobject_percentdone Private Sub myobject_percentdone(byval Percent As Single, Cancel As Boolean) Label1.Caption = CInt(100 * Percent) & "%" DoEvents If mblncancel Then Cancel = True PercentDone Label1 DoEvents Click

223 212 Visual Basic Private Sub Command2_Click() mblncancel = True LongTask DoEvents Command2_Click mblncancel True myobject_percentdone ByRef Cancel True WithEvents WithEvents WithEvents Form_Load myobject Private Sub Form_Load() Set myobject = New Class5 VB Class5 myobject Class5 PercentDone myobject_percentdone LongTask Click Private Sub Command1_Click() mblncancel = False Label1.Caption = "0%" Label1.Refresh Call myobject.longtask(10, 0.5) If Not mblncancel Then Label1.Caption = "100%" LongTask Boolean ( ) False 10 LongTask 0.5 PercentDone myobject_percentdone LongTask mblncancel LongTask mblncancel True Form5 PercentDone 9.9

224 Form5 Class5 myobject myobject Class5 Commandl Set myobject=new Class5 Call myobject.longtask(10,0.5) Set myobject=nothing '<- '<- myobject LongTask Class5 myobject Nothing Class5 WithEvents Class5 myobject Class5 myobject Class5 myobject Class5 myobject myobject Nothing Set myobject=nothing ' myobject WithEvents Nothing VB Gong 1 Class6 Class6 Public Property Get Form6() As Form6 Set Form6 = mform6

225 214 Visual Basic End Property Public Property Set Form6(ByVal NewForm6 As Form6) Set mform6 = NewForm6 End Property 2 Form6 Form6 Event Gong() Private mc1 As Class6 Class6 Class6 3 Class6 Private WithEvents mform6 As Form6 WithEvents Form6 Gong 4 Class6 mform6 Gong Private Sub mform6_gong() MsgBox " Gong!", vbokonly, " " 5 Form6 Private Sub Form_Load() Set mc1 = New Class6 Set mc1.form6 = Me Class6 Form6 Form6 ( ) (6) text1 command1 Form Private Sub Text1_Change() RaiseEvent Gong Private Sub Command1_Click() Set Form6 = Nothing End

226 Form6 Gong 7 Form Form6 1 Event Public 2 RaiseEvent 3 WithEvents 4 WithEvents 5 ( ) 6

227 216 Visual Basic Initialize Terminate 9.2 Class True

228 10 VB VB VB Data DBGrid ADO Data SQL VB Access VB.MDB 1. SQL

229 218 Visual Basic SQL VB 3 ActiveX ADO RDO DAO VB 3 3 ADO RDO DAO ADO ADO VB 6.0 ActiveX Data

230 10 VB SQL VB SQL Structured Query Language SQL VB 3 1 Jet Jet Microsoft Access VB Jet 2 ISAM ISAM Dbase FoxPro Text Files Paradox VB 3 ODBC ODBC / Microsoft SQL Server Oracle Sybase VB ODBC ODBC ODBC Open Database Connection Microsoft 1989 ODBC ODBC ODBC ODBC 10.1 ODBC ODBC SQL Server ORACLE FoxPro SQL Server ORACLE FoxPro 10.1 ODBC

231 220 Visual Basic ODBC API SQL ODBC API SQL ODBC ODBC Windows 98 ODBC ODBC Access ODBC DSN Microsoft Access Driver(*.mdb) 10.2 newstudent E:\vb\student.mdb ODBC newstudent ODBC Microsoft Access

232 10 VB ODBC 10.2 VB Visual Data Manager VB VisData Jet Jet

233 222 Visual Basic Microsoft Access Microsoft Access Version mdb Dbase Dbase Version 5.0 FoxPro FoxPro Version Paradox Paradox Version x 3.x ODBC ODBC Text Files Microsoft Access Version 7.0 MDB 2 student e:\vb 3 VisData SQL Access

234 10 VB Access student.mdb

235 224 Visual Basic

236 10 VB Data Data Data Data DBGrid DBGrid 3 2. Data

237 226 Visual Basic VB 1 student.mdb 2 stud >>

238 10 VB frmstud VB cmdadd cmddelete cmdrefresh cmdupdate cmdclose Data Data1 Data Click Private Sub cmdadd_click() Data1.Recordset.AddNew Private Sub cmddelete_click() ' ' Data1.Recordset.Delete Data1.Recordset.MoveNext Private Sub cmdrefresh_click() ' Data1.Refresh Private Sub cmdupdate_click() Data1.UpdateRecord Data1.Recordset.Bookmark = Data1.Recordset.LastModified Private Sub cmdclose_click() Unload Me Data

239 228 Visual Basic 5 1 frmstud Data Data VB Data Data SQL Data Data Name Left

240 10 VB Connect VB 7 Microsoft Access dbase FoxPro Connect Access 2 DatabaseName DatabaseName 3 Exclusive True False 4 ReadOnly True False 5 RecordSource SQL QueryDef 6 Recordset 7 RecordsetType Recordset dbopentable dbopendynaset Dynaset dbopensnapshot Recordset 8 BOFAction BOF True Data 9 EOFAction EOF True Data Data Data

241 230 Visual Basic 1 Refresh Data Data Data Connect RecordSource Exclusive Refresh 2 UpdateRecord Validate 3 UpdateControls Data Data Data 1 Error Data Private Sub Data1_Error(DataErr As Integer, Response As Integer) Data1 Data DataErr Response Reposition 3 Validate Recordset Recordset Data 1. Recordset 1 MoveFirst MoveNext MovePrevious MoveLast 2 FindFirst FindLast FindNext FindPrevious

242 10 VB 231 Seek 3 Seek Recordset NoMatch True 4 AddNew Edit Delete Update AddNew Update Edit AddNew Update Delete Update AddNew Edit Update Edit AddNew 5 Close 2. Recordset Recordset 1 Bookmark Variant 2 AbsolutePosition Data

243 232 Visual Basic Data 10.2 Data1 Caption "Data1" Connect "Access" DatabaseName "E:\vb\student.mdb" DefaultCursorType 0 ' DefaultType 2 ' ODBC Exclusive 0 'False Options 0 ReadOnly 0 'False RecordsetType 1 'Dynaset RecordSource " " Combo1 DataField " " DataSource "Data1" Combo2 DataField " " DataSource "Data1" cmdadd Caption " " cmddelete Caption " " cmdfind Caption " " cmdupdate Caption " " cmdclose Caption " " txtfields(0) DataField " " DataSource "Data1" txtfields(1) DataField " " DataSource "Data1" txtfields(2) DataField " " DataSource "Data1" lbllabels(0) AutoSize -1 'True Caption " :"

244 10 VB 233 lbllabels(1) AutoSize -1 'True Caption " :" lbllabels(2) AutoSize -1 'True Caption " :" lbllabels(3) AutoSize -1 'True Caption " :" lbllabels(4) AutoSize -1 'True Caption " :" Data Private Sub cmdadd_click() Data1.Recordset.AddNew cmddelete.enabled = False cmdfind.enabled = False cmdupdate.enabled = True txtfields(0).setfocus Private Sub cmddelete_click() If MsgBox(" ", vbyesno, " ") = vbyes Then Data1.Recordset.Delete Data1.Recordset.MoveNext If Data1.Recordset.EOF Then Data1.Recordset.MoveFirst If Data1.Recordset.BOF Then cmddelete.enabled = False cmdfind.enabled = False End If End If

245 234 Visual Basic End If Private Sub cmdclose_click() Unload Me Private Sub cmdfind_click() Dim str As String str = InputBox(", =9", " ") If str = "" Then Exit Sub Data1.Recordset.FindFirst str If Data1.Recordset.NoMatch Then MsgBox " ",, " " End If Private Sub cmdupdate_click() Data1.UpdateRecord Data1.Recordset.Bookmark = Data1.Recordset.LastModified cmdupdate.enabled = False cmddelete.enabled = True cmdfind.enabled = True Private Sub Data1_Error(DataErr As Integer, Response As Integer) MsgBox " " & Error$(DataErr) Response = 0 ' Private Sub Data1_Reposition() Screen.MousePointer = vbdefault On Error Resume Next Data1.Caption = " " & (Data1.Recordset.AbsolutePosition + 1) Private Sub Form_Initialize() If Data1.Recordset.EOF And Data1.Recordset.BOF Then ' cmdfind.enabled = False cmddelete.enabled = False Else Data1.Recordset.MoveFirst ' End If cmdupdate.enabled = False 10.4 DBGrid VB Data Data

246 10 VB 235 Data VB VB Data DataSource DataField DBGrid DBGrid DBGrid Microsoft Data Bound Grid Control DBGrid DBGrid DataSource Data DBGrid DataSource DBGrid DataSource Data DBGrid Data Retrieve Fields DBGrid Data Recordset DBGrid Columns DBGrid Column

247 236 Visual Basic DBGrid Columns Count Data Recordset RecordCount Row Col Data Column Value DBGrid 1 Data DatabaseName RecordSource 2 DBGrid DataSource Data 3 DBGrid 4 DBGrid DBGrid AllowUpdate True AllowAddNew AllowDelete True DBGrid DBGrid DBGrid DBGrid DBGrid DBGrid Column

248 10 VB 237 DBGrid DBGrid DBGrid Edit DBGrid Column DBGrid General DBGrid Columns Columns Column DBGrid DBGrid Column DBGrid Column Column Width DBGrid RowHeight DBGrid DBGrid Recordset DBGrid Data DBGrid Bookmark Bookmark Recordset DBGrid DBGrid AllowUpdate True RecordSelectors True Col Row Column Text Value SelStartCol SelEndCol DBGrid

249 238 Visual Basic DBGrid 10.3 Command1 Caption " " Command2 Caption " " Data1 Caption "Data1" Connect "Access" DatabaseName "E:\vb\student.mdb" DefaultCursorType 0 ' DefaultType 2 ' ODBC Exclusive 0 'False ReadOnly 0 'False RecordsetType 1 'Dynaset RecordSource " " DBGrid1 AllowAddNew True AllowDelete True AllowUpdate True DataSource data1 DataMode 0-Bound HeadLines

250 10 VB DBGrid Private Sub Command1_Click() Data1.Recordset.Delete Private Sub Command2_Click() Unload Me Private Sub Data1_Reposition() Screen.MousePointer = vbdefault On Error Resume Next Data1.Caption = " " & (Data1.Recordset.AbsolutePosition + 1) 10.5 ADO Data ADO Data ADO VB Data ADO Data Microsoft ActiveX Data Objects ADO ADO Data SQL ADO Data Microsoft ADO Data Control VB

251 240 Visual Basic ADO Data ADO Data 1. Align 5 vbalignnone vbaligntop vbalignbottom vbalignleft vbalignright 2. BOFAction EOFAction BOF EOF BOFAction EOFAction BOFAction addomovefirst adstaybof Validate Reposition

252 10 VB 241 EOFAction addomovelast adstayeof addoaddnew Validate AddNew Reposition 3. ConnectionString ConnectionString VB ADO ADO Data ConnectionString ConnectionString ConnectionString ConnectionString 1 ADOData ConnectionString Microsoft.UDL Data Link 3 DSN ODBC DSN

253 242 Visual Basic ConnectionString drive=[sql Server];server=bigsmile;uid=sa;pwd=pwd;database=pubs ConnectionString 4. RecordSource RecordSource SQL SQL SELECT * FROM student WHERE sex=" " 5. CommandType CommandType RecordSource CommandType adcmdunknown CommandText adcmdtable CommandText SQL adcmdtext CommandText adcmdstoreproc CommandText

254 10 VB UserName UserName ConnectionString ConnectionString UserName ConnectionString UserName 7. Password Password Provider UserName ConnectionString 8. ConnectionTimeout ADO Data ADO Data 1. UpdateControls DataSource DataField ADO Data 2. AddNew ADO Data Adodc1.Recordset.AddNew Adodc1 ADO Data UpdateBatch CancelUpdate 3. Delete ADO Data Adodc1.Recordset.Delete 4. MoveFirst MoveLast MoveNext MovePrevious ADO Data MoveFirst MoveLast MoveNext MovePrevious

255 244 Visual Basic Adodc1.Recordset.MoveFirst Adodc1.Recordset.MoveLast Adodc1.Recordset.MoveNext Adodc1.Recordset.MovePrevious 5. CancelUpdate ADO Data Adodc1.Recordset.CancelUpdate 6. UpdateBatch ADO Data Adodc1.Recordset.UpdateBatch ADO Data ADO Data 1. WillMove MoveComplete WillMove ADO Data WillComplete 2. WillChangeField FieldChangeComplete WillChangeField FieldChangeComplete 3. WillChangeRecord RecordChangeComplete WillChangeRecord RecordChangeComplete ADO Data ADO Data Adodc1 ConnectionString... Microsoft Jet 3.51 OLE DB Provider E:\vb\student.mdb

256 10 VB 245 RecordSource... 2-adCmdTable ADO Data 10.4 Adodc1 ConnectMode 3 CursorLocation 3 ConnectionTimeout 15 CursorType 3 LockType 3 CommandType 2 BOFAction 0 EOFAction 0 ConnectStringType 1 Connect "Provider=Microsoft.Jet.OLEDB.3.51; Persist Security Info=False; Data Source=E:\vb\student.mdb" OLEDBString "Provider=Microsoft.Jet.OLEDB.3.51; Persist Security Info=False; Data Source=E:\vb\student.mdb" DataSourceName "" UserName "" Password "" RecordSource " " Caption " "

257 246 Visual Basic CmdUpdate Caption " " Combo2 DataField " " DataSource "Adodc1" Combo1 DataField " " DataSource "Adodc1" cmdclose Caption " " cmdfind Caption " " cmddelete Caption " " cmdadd Caption " " txtfields(0) DataField " " DataSource "Adodc1" txtfields(1) DataField " " DataSource "Adodc1" txtfields(2) DataField " " DataSource "Adodc1" lbllabels(0) AutoSize -1 'True Caption " :" lbllabels(1) AutoSize -1 'True Caption " :" lbllabels(2) AutoSize -1 'True Caption " :" lbllabels(3) AutoSize -1 'True Caption " :" lbllabels(4) AutoSize -1 'True Caption " :" Private Sub cmdadd_click() badd = True Adodc1.Recordset.AddNew cmddelete.enabled = False cmdfind.enabled = False cmdupdate.enabled = True txtfields(0).setfocus Private Sub cmddelete_click() If MsgBox(" ", vbyesno, " ") = vbyes Then Adodc1.Recordset.Delete

258 10 VB 247 Adodc1.Recordset.MoveNext If Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveFirst If Adodc1.Recordset.BOF Then cmddelete.enabled = False cmdfind.enabled = False End If End If End If Private Sub cmdclose_click() Unload Me Private Sub cmdfind_click() Dim str As String Dim mybookmark As Variant mybookmark = Adodc1.Recordset.Bookmark str = InputBox(", =9", " ") If str = "" Then Exit Sub Adodc1.Recordset.MoveFirst Adodc1.Recordset.Find str If Adodc1.Recordset.EOF Then MsgBox " ",, " " Adodc1.Recordset.Bookmark = mybookmark End If Private Sub cmdupdate_click() Adodc1.Recordset.Update Adodc1.Recordset.MoveLast cmdupdate.enabled = False cmddelete.enabled = True cmdfind.enabled = True Private Sub Form_Load() If Adodc1.Recordset.EOF And Adodc1.Recordset.BOF Then cmdfind.enabled = False cmddelete.enabled = False End If cmdupdate.enabled = False Adodc1.Recordset.MoveFirst 10.22

259 248 Visual Basic ADO Data 10.6 SQL SQL SQL SQL SQL SELECT SQL SQL SELECT CREATE DROP INSERT UPDATE DELETE GRANT REVOKE SQL SELECT FORM WHERE GROUP BY HAVING ORDER BY [ASC DESC] SELECT FORM

260 10 VB 249 WHERE GROUP BY HAVING ORDER BY SQL AVG COUNT SUM MAX MIN 10.6 < <= > >= = <> BETWEEN 1 AND 2 IN ( ) LIKE * *? * SQL SQL SQL Data RecordSource Data SQL 10.1 SQL CREATE TABLE CHAR(5), CHAR(10),

261 250 Visual Basic CHAR(2), CHAR(12), CHAR(5)); 10.2 Data1.RecordSource="SELECT * FROM " Data Data1.RecordSource="SELECT FROM " Data Data1.RecordSource="SELECT FROM WHERE =' '" Data VB 10.2 VB? 10.3? 10.4 Data? 10.5 ADO 10.6 ADO Data 10.7 Data student.mdb 10.6, Integer Text 8 Single Single Single

262 10 VB 251 ADO Data

263 11 DAO Data Data DAO Data DAO Jet DAO 11.1 DAO DAO Data Access Objects Jet Microsoft Access ODBC DAO DAO Data Jet Data DAO DAO 11.1 Microsoft Jet DAO DAO DAO 11.2 Microsoft DAO 3.5 Object Library 11.2 DBEngine DAO DBEngine DBEngine Jet

264 11 DAO DAO DBEngine DBEngine 1 Version Jet

265 254 Visual Basic 2 DefaultType Workspace dbusejet 2 Jet Engine CreateWorkspace Workspace type type 3 DefaultUser Workspace 4 DefaultPassword Workspace DBEngine DBEngine 1 CompactDatabase CompactDatabase DBEngine.CompactDatabase olddb,newdb,local,options,password olddb newdb local Variant options dbencrypt dbdncrypt password password 2 RepairDatabase RepairDatabase DbEngine.RepairDatabase databasename databasename 3 CreateWorkspace DBEngine Workspace Workspace Workspace CreateWorkspace Set myws DBEngine.CreateWorkspace(name,user,password,type) myws Workspace name user password type Workspace DAO Workspace Jet ODBC dbusejet dbuseodbc

266 11 DAO DBEngine 11.1 ws1 Dim ws1 As Workspace Set ws1 = DBEngine.CreateWorkspace("ws1","lichun" " " ) 11.2 student.mdb student1 DBEngine.CompactDatabase "student","student1",dblanggeneral dbdncrypt 11.3 Workspace DBEngine Workspace Workspace Workspace Microsoft Jet Workspace Workspace DAO Microsoft Jet ODBCDirect Workspace Workspace Workspace Workspace 0 Workspace DBEngine Defaulttype DefaultUser DefaultPassword Workspaces 0 Workspace Workspace 1 myws Workspace DBEngine.Workspaces(1) DBEngine.Workspaces("myWs") Workspace Workspace Workspace 1 Name Workspace Workspace

267 256 Visual Basic 2 Type Workspace 3 UserName Workspace Workspace 1 CreateDatabase Workspace CreateDatabase Set database = Workspace.CreateDatabase (Name, Local, Options) database Workspace Workspace Name Local dblanggeneral Options C VB sample Set NewDB = NewWS.CreateDatabase("C:\VB\sample",dbLangGeneral) 2 OpenDatabase Workspace OpenDatabase Workspace Set database=workspace.opendatabase databasename,options,read-only,connect databasename Jet ODBC options Jet True False ODBC read-only connect

268 11 DAO 257 C VB sample Set db = NewWS.OpenDatabase("C:\VB\sample",True False) databasename 3 Close Workspace Workspace Workspace Workspace Close Workspace.Close 4 DAO BeginTrans CommitTrans RollBackTrans VB BeginTrans CommitTrans RollBackTrans Workspace 11.3 works.mdb Dim ws As Workspace Dim db As Database Set ws= DBEngine.Workspace(0) Set db=db.createdatabase("c:\vb\works.mdb")

269 258 Visual Basic 11.4 Database DAO Database Database Workspace Database Database Database TableDef QueryDef Container Recordset Relation 5 Database Database Workspace Database CreateDatabase OpenDatabase Database Database Set Database Database 1 Name 2 Version Jet Jet ODBC ODBC 3 Updatable 4 RecordAffected 5 Transactions Database Database 1 CreateQueryDef Set querydef=database.createquerydef(name,sqltext) name name sqltext SQL 2 CreateTableDef TableDef

270 11 DAO 259 Set table = database.createtabledef(name,attribute,source,connect) table database name attribute source connect 3 Execute 4 OpenRecordset Recordset Database Recordset Set recordset=database.openrecordset(source,type,options,lockedits) source SQL SQL Recordset NextRecordset type Recordset dbopentable dbopendynaset dbopensnapshot dbopenforwardonly dbopendynamic source type options Recordset dbappendonly dbreadonly DbSeeChanges dbdenywrite dbdenyread lockedits

271 260 Visual Basic 5 CreateRelation 6 Close Set database=nothing TableDef TableDef TableDef 1. TableDef TableDef 1 LastUpdated 2 DataCreated 3 SourceTableName 4 Updatable 5 Recordcount 6 Attributes 6 7 ValidationRule 8 ValidationText 2. TableDef TableDef 1 CreateField Set field = table.createfield (name,type,size)

272 11 DAO 261 field Field table Field name type size 2 CreateIndex Set index = table.createindex ("name") index index table index name Index 3 OpenRecordset Database OpenRecordset TableDef Database OpenRecordset SQL TableDef OpenRecordset Set recordset = tabledef.openrecordset(source,type,options,lockedits) recordset Recordset source Recordset type Recordset 5 Database OpenRecordset options Recordset Recordset Recordset Recordset Recordsets Recordset Recordset 5 3

273 262 Visual Basic dbopentable Recordset Recordset Recordset ODBC Recordset dbopendynaset Recordset Recordset dbopensnapshot Recordset Recordset Recordset 1. Recordset Recordset 1 RecordCount Recordset Recordset MoveLast 2 AbsolutePosition AbsolutePosition recordset.absoluteposition = N recordset Recordset N 0~ AbsolutePosition 0 N AbsolutePosition N-1 3 AbsolutePosition 2 AbsolutePosition AbsolutePosition 1 3 Bookmark Bookmark Bookmark Bookmark Bookmark

274 11 DAO 263 Bookmark AbsolutePosition Bookmark String Variant Bookmark Bookmark Bookmarkable Bookmarkable True Bookmark 4 Sort SQL-SELECT ORDER BY Recordset 5 Filter SQL-SELECT WHERE 2. Recordset Recordset 1 AddNew AddNew AddNew recordset.addnew recordset recordset 2 Update Update Update recordset.update recordset recordset 3 Edit Edit recordset.edit recordset recordset 4 Delete recordset.delete recordset recordset 5 Move

275 264 Visual Basic Recordset VB Move Move recordset.move rows start recordset Recordset rows start Bookmark Move Move recordset.movefirst recordset.movelast recordset.movenext recordset.moveprevious recordset recordset MoveFirst MoveLast MoveNext recordset.move 1 MovePrevious recordset.move-1 6 Find Seek Find Recordset.FindFirst Recordset.FindLast Recordset.FindNext Recordset.FindPrevious Recordset recordset FindFirst Seek FindLast

276 11 DAO 265 FindNext FindPrevious 7 Seek Seek Seek Seek recordset.seek = recordset Recordset > < = Seek 8 Close Recordset Recordset Close recordset.close recordset Recordset QueryDef QueryDef QueryDef OpenRecordset Database QueryDef QueryDef parameter Field SQL QueryDef DAO SQL 1. QueryDef QueryDef

277 266 Visual Basic 1 SQL SQL QueryDef SQL querydef.sql=sqlstatement sqlstatement SQL 2 Execute Execute querydef.execute options options 3 OpenRecordset TableDef OpenRecordset Database ' TableDef Dim table1 As TableDef Dim table2 As TableDef Dim table3 As TableDef Dim db As Database Set db=dbengine.workspace(0).opendatabase("c:\vb\works.mdb") ' newtable1 newtable2 newtable3 Set table1 = db.createtabledef ("newtable1") Set table2 = db.createtabledef ("newtable2") Set table3 = db.createtabledef ("newtable3") 11.5 Recordset Dim db As Database Dim rst As Recordset ' Recordset Set db=dbengine.workspace(0).opendatabase("c:\vb\works.mdb") Set rst = db.openrecordset("select * from zgb") 11.6 Recordset

278 11 DAO 267 ' Recordset Dim rst As Recordset Dim db As Database ' Set db = workspace(0).opendatabase("c:\vb\works" False ) ' Recordset Set rst = NewDB.OpenRecordset("zgb", dbopentable ) ' zgb Print " " rst.recordcount ' rst.close rst Recordcount rst Recordcount ' Recordset Dim rst As Recordset Dim db As Database ' Set db = workspace(0).opendatabase("c:\vb\works" False ) ' Recordset Set rst = NewDB.OpenRecordset("zgb", dbopentable ) ' rst.addnew ' rst.field(" ")=" " rst.field(" ")="25" rst.field(" ")="2000" ' rst.update rst.close db.close Update Update ' Recordset Dim rst As Recordset Dim db As Database ' Set db = workspace(0).opendatabase("c:\vb\works" False )

279 268 Visual Basic ' Recordset Set rst = NewDB.OpenRecordset("zgb", dbopentable ) ' rst.edit ' rst.field(" ")="2500" ' rst.update rst.close db.close 11.9 AbsolutePosition 3 Dim rst As Recordset Dim NewDB As Database ' Set db = workspace(0).opendatabase("c:\vb\works" False ) ' Recordset Set rst = NewDB.OpenRecordset("zgb", dbopendynaset ) ' 3 rst.absoluteposition = 2 ' rst.delete rst.close db.close Update Bookmark Dim rst As Recordset Dim db As Database Dim mybookmark As String ' Set db = workspace(0).opendatabase("c:\vb\works" False ) ' Set rst = db.openrecordset("zgb", dbopendynaset ) ' Bookmark mybookmark = rst.bookmark ' rst.absoluteposition = 5 ' rst.bookmark = mybookmark rst.close db.close

280 11 DAO Move ' Dim rst As Recordset Dim db As Database Dim mybookmark As String ' Set db = workspace(0).opendatabase("c:\vb\works" False ) ' Set rst = NewDB.OpenRecordset("zgb", dbopendynaset ) ' 4 rst.move 3 ' 4 " " Form1.Print rst.fields (" ") ' 2 rst.move 2 ' 2 " " Form1.Print rst.fields (" ") ' rst.bookmark = mybookmark rst.close db.close Seek Dim rst As Recordset Dim db As Database ' Set db = workspace(0).opendatabase("c:\vb\works" False ) ' Set rst = db.openrecordset("zgb", dbopentable ) ' "name" " " rst.index = "name" ' " " " " rst.seek "="," " ' " " Form1.Print rst.fields (" ") rst.close db.close Find Dim rst As Recordset Dim db As Database ' Set db = workspace(0).opendatabase("c:\vb\works" False ) '

281 270 Visual Basic Set rst = NewDB.OpenRecordset("zgb", dbopendynaset ) ' "old" " " rst.index = "old" ' "24" rst.findfirst " ='24'" ' "24" rst.findnext " ='24'" ' " " Form1.Print rst.fields (" ") ' "26" rst.findlast " ='26'" ' " " Form1.Print rst.fields (" ") rst.close db.close SQL SQL Dim db As Database Dim qry As QueryDef Dim rst as Recordset Set db = workspace(0).opendatabase("c:\vb\works" False ) Set qry=db.createquerydef("") Dim str As String str="parameters YearStart Integer,YearEnd Integer; " str=str&"select * From zgb Where " str=str&"between YearStart And YearEnd" qry.sql=str qry.parameters("yearstart")=1970 qry.parameters("yearend")=1998 set rst=qry.openrecordset() 11.5 Field Field TableDef Field Fields Field Fields Field

282 11 DAO 271 Fields("fieldname") Fields("no") fieldname no Fields Field Field 1 Size Size Type 2 Value Field Field rst.fields(" ")="102" rst.fields.value(" ")= "102" 3 SourceField SourceTable Field Field 1 AppendChunk Memo Long Binary 64K field.appendchunk source source 2 GetChunk field.getchunk offset,num offset 64K num 64K

283 272 Visual Basic Field table1 Set fld(0) = table1.createfield (" " dbtext 10 ) Set fld 1 = table1.createfield (" " dbinteger 3 ) ' table1 table1.fields.append fld(0) table1.fields.append fld(1) 11.6 Index Index Index Index Field Field Index Index 1 Primary NULL 2 Unique Index Unique True Index Index 1 CreateField TableDef CreateField Index Set field = index.createfield ("name") field field

284 11 DAO 273 index name 2 Append Index Indexes table1.indexes.append "indexname" table1 indexname 3 Delete Index Indexes tablen1.indexes.delete "indexname" tablen1 indexname Index ' Dim idx As Index Dim fld As Field Set idx = table1.createindex (" ") ' Set fld = idx.createfield (" ") ' Set idx.primary = True Set idx.unique = True ' table1.indexes.append idx 11.7 DAO works.mdb zgb C 5 C 10 C 2 N N ' Dim ws As WorkSpace Dim db As Database '

285 274 Visual Basic Set ws = DBEngine.Workspace(0) ' Set db = ws.createdatabase("c:\vb\works",dblanggeneral) ' ' TableDef Dim table1 As TableDef ' db zgb Set table1 = db.createtabledef ("zgb") ' ' table1 Dim fld 5 As Field ' table1 Set fld(0) = table1.createfield (" " dbtext 5 ) Set fld 1 = table1.createfield (" " dbtext 10 ) Set fld 2 = table1.createfield (" " dbtext 2 ) Set fld 3 = table1.createfield (" " dbinteger 2 ) Set fld 4 = table1.createfield (" " dbinteger 8) ' ' Dim idx As Index Dim idxfld As Field ' Set idx = table1.createindex (" ") ' Set idxfld = idx.createfield (" ") ' Set idx.primary = True Set idx.unique = True ' table1 table1.fields.append fld(0) table1.fields.append fld(1) table1.fields.append fld(2) table1.fields.append fld(3) table1.fields.append fld(4) ' idx.fields.append idxfld ' table1.indexes.append idx ' table1 db db.tabledefs.append table1 db.close Data DAO 11.1

286 11 DAO cmdclose Caption " " cmdcancel Caption " " cmdupdate Caption " " cmdfind Caption " " cmddelete Caption " " cmdedit Caption " " cmdadd Caption " " HScroll1 txtclass optsex 0 Caption " " optsex 1 Caption " " Comnation TxtName TxtNo Label1AutoSize -1 'True Caption " " Label2AutoSize -1 'True Caption " " Label3AutoSize -1 'True Caption " " Label4AutoSize -1 'True Caption " " Label5AutoSize -1 'True Caption " "

287 276 Visual Basic Dim db As Database Dim rst As Recordset Dim RecNum As Integer ' Dim bedit As Boolean Dim badd As Boolean Dim bdatachange As Boolean ' Dim mybookmark As String ' Dim intscrollpre As Integer ' Private Sub Form_Load() Set db = DBEngine.Workspaces(0).OpenDatabase("e:\vb\student.mdb") Set rst = db.openrecordset("select * from ") bdatachange = False bedit = False badd = False rst.movelast RecNum = rst.recordcount If RecNum = 0 Then DisButton Else rst.movelast intscrollpre = 1 HScroll1.Max = RecNum HScroll1.Min = 1 HScroll1.SmallChange = 1 HScroll1.Value = intscrollpre rst.movefirst FillText End If cmdupdate.enabled = False cmdcancel.enabled = False Private Sub cmdadd_click() If RecNum > 0 Then myboolmark = rst.bookmark Else mybookmark = vbnullstring End If badd = True rst.addnew ' rst.fields(" ") = vbnullstring rst.fields(" ") = vbnullstring rst.fields(" ") = vbnullstring rst.fields(" ") = vbnullstring

288 rst.fields(" ") = vbnullstring ClearField cmdadd.enabled = False cmdedit.enabled = False cmdfind.enabled = False HScroll1.Enabled = False cmddelete.enabled = False cmdupdate.enabled = True cmdcancel.enabled = True cmdclose.enabled = False txtno.setfocus ' Private Sub ClearField() optsex(0).value = True txtno.text = "" txtname.text = "" txtclass.text = "" Comnation.Text = "" Private Sub cmdcancel_click() badd = False bedit = False cmdupdate.enabled = False cmdedit.enabled = True cmdcancel.enabled = False HScroll1.Enabled = True cmddelete.enabled = True cmdadd.enabled = True cmdedit.enabled = True cmdfind.enabled = True cmdclose.enabled = True rst.cancelupdate bdatachange = False If RecNum = 0 Then DisButton ClearField Exit Sub End If rst.bookmark = mybookmark FillText Private Sub cmdclose_click() db.close End 11 DAO 277

289 278 Visual Basic Private Sub cmddelete_click() If MsgBox(" ", vbyesno, " ") = vbyes Then rst.delete rst.movenext RecNum = RecNum - 1 HScroll1.Max = HScroll1.Max - 1 If RecNum = 0 Then DisButton ClearField Exit Sub ElseIf rst.eof Then rst.movefirst HScroll1.Value = 1 intscrollpre = HScroll1.Value FillText mybookmark = rst.bookmark End If End If Private Sub FillText() If rst.fields(" ") = " " Then optsex(0).value = True Else optsex(1).value = True End If txtno = rst.fields(" ") txtname = rst.fields(" ") Comnation = rst.fields(" ") txtclass = rst.fields(" ") Private Sub cmdedit_click() If RecNum > 0 Then mybookmark = rst.bookmark Else mybookmark = vbnullstring End If bedit = True rst.edit cmdadd.enabled = False cmdedit.enabled = False cmdfind.enabled = False HScroll1.Enabled = False cmddelete.enabled = False cmdupdate.enabled = True cmdcancel.enabled = True cmdclose.enabled = False

290 txtno.setfocus Private Sub cmdfind_click() mybookmark = rst.bookmark Dim rst1 As Recordset Dim str As String str = InputBox(" ", " ") Set rst1 = rst rst.findfirst str If rst.nomatch Then MsgBox " ",, " " rst.bookmark = mybookmark Else intscrollpre = rst.absoluteposition + 1 HScroll1.Value = intscrollpre FillText End If Private Sub cmdupdate_click() rst.update RecNum = RecNum + 1 HScroll1.Enabled = True cmdedit.enabled = True cmddelete.enabled = True cmdupdate.enabled = False cmdcancel.enabled = False cmdadd.enabled = True cmdedit.enabled = True cmdfind.enabled = True cmdclose.enabled = True If badd Then rst.movelast intscrollpre = RecNum HScroll1.Min = 1 HScroll1.Max = RecNum HScroll1.Value = RecNum End If bedit = False badd = False Private Sub DisButton() cmdedit.enabled = False cmddelete.enabled = False cmdupdate.enabled = False cmdcancel.enabled = False cmdfind.enabled = False 11 DAO 279

291 280 Visual Basic HScroll1.Enabled = False Private Sub HScroll1_Change() If HScroll1.Value - intscrollpre = 1 Then rst.movenext ElseIf HScroll1.Value - intscrollpre = -1 Then rst.moveprevious ElseIf HScroll1.Value - intscrollpre <> 0 Then rst.move HScroll1.Value - intscrollpre End If intscrollpre = HScroll1.Value If rst.eof Then rst.movelast ElseIf rst.bof Then rst.movefirst End If FillText Private Sub optsex_keypress(index As Integer, KeyAscii As Integer) If KeyAscii = 13 Then Comnation.SetFocus Private Sub optsex_lostfocus(index As Integer) If bedit Or badd Then If optsex(0).value Then rst.fields(" ") = " " Else rst.fields(" ") = " " End If End If Private Sub txtclass_keypress(keyascii As Integer) If KeyAscii = 13 Then txtno.setfocus Private Sub txtclass_lostfocus() If bedit Or badd Then rst.fields(" ") = Trim(txtClass.Text) End If Private Sub txtname_keypress(keyascii As Integer) If KeyAscii = 13 Then optsex(0).setfocus Private Sub txtname_lostfocus() If bedit Or badd Then rst.fields(" ") = Trim(txtName.Text) End If

292 11 DAO 281 Private Sub txtno_keypress(keyascii As Integer) If KeyAscii = 13 Then txtname.setfocus Private Sub txtno_lostfocus() If bedit Or badd Then rst.fields(" ") = Trim(txtNo.Text) End If Private Sub Comnation_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtclass.setfocus Private Sub Comnation_LostFocus() If bedit Or badd Then rst.fields(" ") = Trim(Comnation.Text) End If DAO 11.2 stud dbinteger dbtext 8 dbtext 2 dbtext 12 dbtext 5

293 282 Visual Basic

294 12 ADO ADO ActiveX ADO ODBC ODBC SQL Server Oracle Access Excel 12.1 ADO ADO Microsoft OLE DB OLE DB ADO ADO ADO COM OLE VB VC++ VBScript Java OLE DB COM ADO C++ OLE DB DBMS ADO DAO ADO DAO ADO ADO Connection Command Parameter Recordset Field Property,Error

295 284 Visual Basic 4 Fields,Properties,Parameters,Errors ADO Connection Recordset Command VB 5.0 ADO VB VB 6.0 ADO ADO VB 6.0 ADO 2.1 ADO ADO ADODB MSADO15.DLL Microsoft ActiveX Data Objects 2.1 Library... ADOR MSADOR15.DLL Microsoft ActiveX Data Objects Recordset 2.0 Library ADODB ADO ADODB 12.2 Connection Connection

296 12 ADO 285 ADO Connection Connection.Open Recordset.Open Connection Connection 1 ConnectionString DSN datas SQL Sever li chun Dim cn AS ADODB.Connection Set cn=new ADODB.Connection cn.connectionstring="dsn=datas;uid=li;pwd=chun" cn.connectionstring="driver={sqlserver};server=mm;uid=li; " & "PWD=pwd;Database=datas" 2 ConnectionTimeout 15 3 CursorLocation adusenone aduseclient aduseserver 4 DefaultDatabase Connection 5 Mode Connection ConnectionModeEnum 6 State Connection 7 Version

297 286 Visual Basic ADO Connection Connection 1 Open Connection.Open ConnectionString,UserID,Password,Options ConnectionString UserID Password Options ConnectionOptionEnum 2 Close Set Connection=Nothing 3 Execute SQL DSN datas zgb gzs 1000 Dim cn As ADODB.Connection Dim rst As ADODB.Recordset Set cn=new ADODB.Connection Set rst=new ADODB.Recordset cn.connectionstring="dsn=datas;uid=li;pwd=chun" cn.open cn.execute "DELETE FROM zgb WHERE gzs>1000" Set rst=cn.execute("select * FROM zgb") (4) ADO ADO BeginTrans CommitTrans RollBackTrans

298 12 ADO 287 BeginTrans CommitTrans RollBackTrans 12.3 Recordset ADO Recordset Connection Recordset Connection Recordset Recordset Recordset Recordset 1 AbsolutePage 2 AbsolutePosition Recordset 3 ActiveConnection Command Recordset Connection 4 BOF Recordset 5 EOF Recordset 6 Bookmark Recordset Recordset 7 CacheSize Recordset 8 CursorLocation 9 CursorType Recordset 10 EditMode 11 Filter

299 288 Visual Basic Recordset 12 LockType 13 MarshalOptions 14 MaxRecords Recordset 15 PageCount Recordset 16 PageSize Recordset 17 RecordCount Recordset 18 Sort Recordset 19 Source Recordset Command SQL 20 State 21 Status Recordset Recordset 1 AddNew Recordset 2 Cancel Execute Open 3 CancelBatch 4 CancelUpdate Update 5 Clone Recordset Recordset 6 Delete 7 Move

300 12 ADO 289 Recordset 8 MoveFirst MoveLast MoveNext MovePrevious Recordset 9 NextRecordset Recordset 10 Open recordset.open source,activeconnection,cursortype,locktype,options source command activeconnection Connection cursortype locktype options source 11 Requery Recordset 12 Resync Recordset 13 Save Recordset recordset.save filename filename 14 Supports Recordset 15 Update Recordset 16 UpdateBatch

301 290 Visual Basic 12.4 Command Command ADO Command Recordset Command Command 1 ActiveConnection Command Recordset Connection 2 CommandText 3 CommandTimeout 4 CommandType Command 5 Prepared 6 State Command Command 1 Cancel Execute Open 2 CreateParameter Parameter Command CommandText Set parameter=command.createparameter(name,type,direction,size,value) name type direction size value

302 12 ADO Execute CommandText SQL Command Parameter Command Parameters Parameter Command SQL-SELECT WHERE SORT BY Parameter 1 Direction adparaminput adparamoutput 2 Name 3 Precision Parameter 4 Size Parameter 5 Type Parameter 6 Value Parameter 7 AppendChunk Parameter 8 Append Parameter Parameters 9 Delete Parameters Parameter Command 12.1 stud id N 6,name C 10,Birthday D Private Conn As ADODB.Connection Private Rs As ADODB.Recordset Private Comm As ADODB.Command Set Conn=New Connection Set Rs=New Recordset Set Comm=New Command Conn.ConnectionString="DSN=datas;UID=li;PWD=chun"

303 292 Visual Basic Conn.Open Set Comm.ActiveConnection=Conn Comm.CommandText= "Select * From stud" Set Rs=Comm.Execute Rs.Close Conn.Close CommandText Command Dim cn As ADODB.Connection Dim cmd As ADODB.Command Dim par As ADODB.Parameter Dim par1 As ADODB.Parameter Set cn=new ADODB.Connection cn.connectionstring="dsn=datas;uid=li;pwd=chun" cn.open Set cmd=new ADODB.Command cmd.activeconnection=cn cmd.commandtext= "DELETE FROM stud WHERE id BETWEEN? AND? " Set par=new ADODB.Parameter par.name=myid par.type=adinteger par.size=6 par.value= par.direction=adparaminput cmd.parameters.append par Set par1=new ADODB.Parameter par1.name=my par1.type=adinteger par1.size=6 par.value= par1.direction=adparaminput cmd.parameters.append par1 cmd.execute 12.3 Command 1980 Recordset stud Dim cn As ADODB.Connection Dim cmd As ADODB.Command Dim par as ADODB.Parameter Dim rst As ADODB.Recordset Set cn=new ADODB.Connection Set rst=new ADODB.Recordset

304 12 ADO 293 cn.connectionstring="dsn=datas;uid=li;pwd=chun" cn.open cn.begintrans Set cmd=new ADODB.Command cmd.commandtext="delete FROM stud WHERE birthday=?" Set cmd.activeconnection=cn Set par=new ADODB.Parameter par.name=birth par.direction=adparaminput par.size=4 par.value=1980 cmd.parameters.append par cmd.execute cn.rollbacktrans rst.open "stud",cn,adopendynamic,adlockoptimistic,adcmdtable rst.movefirst Do While Not rst.eof Debug.Print rst.fields(0),rst.fields(1) IF rst.fields("birthday")=1980 Then rst.fields("birthday")=1979 End If If rst.fields("id")= Then rst.delete End IF rst.movenext Loop 12.5 ADO ADO ADO

305 294 Visual Basic 12.1 CmdCancel Caption " " cmdupdate Caption " " cmddelete Caption " " cmdedit Caption " " cmdadd Caption " " HScroll1 Enabled -1 'True optsex 0 Caption " " optsex 1 Caption " " Comnation Text "" txtname Text "" txtno Text "" txtclass Text "" Label1 AutoSize -1 'True Caption " " Label2 AutoSize -1 'True Caption " " Label3 AutoSize -1 'True Caption " " Label4 AutoSize -1 'True Caption " " Label5 AutoSize -1 'True Caption " " ' Dim bedit As Boolean Dim badd As Boolean Dim RecNum As Integer ' Dim bdatachange As Boolean Dim mybookmark As Variant Dim intscrollpre As Integer Private Conn As ADODB.Connection Private Rs As ADODB.Recordset ' Private Sub cmdadd_click() If RecNum > 0 Then mybookmark = Rs.Bookmark Else mybookmark = vbnullstring

306 End If badd = True Rs.AddNew Rs.Fields(" ") = vbnullstring Rs.Fields(" ") = vbnullstring Rs.Fields(" ") = vbnullstring Rs.Fields(" ") = vbnullstring Rs.Fields(" ") = vbnullstring ClearField HScroll1.Enabled = False cmdedit.enabled = False cmddelete.enabled = False cmdupdate.enabled = True cmdcancel.enabled = True cmdadd.enabled = False cmdedit.enabled = False cmdclose.enabled = False txtno.setfocus Private Sub ClearField() optsex(0) = True txtno.text = "" txtname.text = "" txtclass.text = "" Comnation.Text = "" Private Sub cmdcancel_click() badd = False bedit = False cmdupdate.enabled = False cmdedit.enabled = True cmdcancel.enabled = False HScroll1.Enabled = True cmddelete.enabled = True cmdadd.enabled = True cmdedit.enabled = True cmdclose.enabled = True Rs.CancelUpdate bdatachange = False If RecNum = 0 Then DisButton ClearField Exit Sub End If Rs.Bookmark = mybookmark FillText Private Sub cmdclose_click() 12 ADO 295

307 296 Visual Basic Rs.Close End Private Sub cmddelete_click() If MsgBox(" ", vbyesno, " ") = vbyes Then Rs.Delete Rs.MoveNext RecNum = RecNum - 1 HScroll1.Max = HScroll1.Max - 1 If RecNum = 0 Then DisButton ClearField Exit Sub ElseIf Rs.EOF Then Rs.MoveFirst HScroll1.Value = 1 intscrollpre = HScroll1.Value mybookmark = Rs.Bookmark End If FillText End If Private Sub FillText() If Rs.Fields 2 = " " Then optsex(0) = True Else optsex 1 = True End If txtno = Rs.Fields(0) txtname = Rs.Fields(1) Comnation = Rs.Fields(3) txtclass = Rs.Fields(4) Private Sub cmdedit_click() If RecNum > 0 Then mybookmark = Rs.Bookmark Else mybookmark = vbnullstring End If bedit = True HScroll1.Enabled = False cmddelete.enabled = False cmdupdate.enabled = True cmdcancel.enabled = True cmdadd.enabled = False cmdedit.enabled = False cmdclose.enabled = False txtno.setfocus

308 Private Sub cmdupdate_click() If bedit Then Rs.Update End If If badd Then Rs.Update RecNum = RecNum + 1 intscrollpre = RecNum HScroll1.Min = 1 HScroll1.Max = RecNum HScroll1.Value = RecNum End If HScroll1.Enabled = True cmdedit.enabled = True cmddelete.enabled = True cmdupdate.enabled = False cmdcancel.enabled = False cmdadd.enabled = True cmdedit.enabled = True cmdclose.enabled = True bedit = False badd = False Private Sub Form_Load() Set Conn = New ADODB.Connection Set Rs = New Recordset Conn.Open "DSN=newstudent" Dim strquery As String Set Rs.ActiveConnection = Conn Rs.LockType = adlockoptimistic Rs.CursorType = adopenkeyset strquery = "select * from " Rs.Open strquery bdatachange = False bedit = False badd = False Rs.MoveLast RecNum = Rs.RecordCount If RecNum = 0 Then DisButton Else Rs.MoveLast intscrollpre = 1 HScroll1.Max = Rs.RecordCount HScroll1.Min = 1 HScroll1.SmallChange = 1 HScroll1.Value = intscrollpre 12 ADO 297

309 298 Visual Basic Rs.MoveFirst FillText End If cmdupdate.enabled = False cmdcancel.enabled = False Private Sub DisButton() cmdedit.enabled = False cmddelete.enabled = False cmdupdate.enabled = False cmdcancel.enabled = False HScroll1.Enabled = False Private Sub HScroll1_Change() If HScroll1.Value - intscrollpre = 1 Then Rs.MoveNext ElseIf HScroll1.Value - intscrollpre = -1 Then Rs.MovePrevious ElseIf HScroll1.Value - intscrollpre <> 0 Then Rs.Move HScroll1.Value - intscrollpre End If intscrollpre = HScroll1.Value If Rs.EOF Then Rs.MoveLast ElseIf Rs.BOF Then Rs.MoveFirst End If FillText Private Sub txtno_keypress(keyascii As Integer) ' Enter txtname If KeyAscii = 13 Then txtname.setfocus Private Sub txtno_lostfocus() If bedit Or badd Then Rs.Fields(" ") = Trim(txtNo.Text) End If Private Sub txtname_keypress(keyascii As Integer) If KeyAscii = 13 Then optsex(0).setfocus Private Sub txtname_lostfocus() If bedit Or badd Then Rs.Fields(" ") = Trim(txtName.Text) End If Private Sub optsex_keypress(index As Integer, KeyAscii As Integer) If KeyAscii = 13 Then Comnation.SetFocus

310 12 ADO 299 Private Sub optsex_lostfocus(index As Integer) If bedit Or badd Then If optsex(0) Then Rs.Fields(" ") = " " Else Rs.Fields(" ") = " " End If End If Private Sub Comnation_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtclass.setfocus Private Sub Comnation_LostFocus() If bedit Or badd Then Rs.Fields(" ") = Trim(Comnation.Text) End If Private Sub txtclass_keypress(keyascii As Integer) If KeyAscii = 13 Then txtno.setfocus Private Sub txtclass_lostfocus() If bedit Or badd Then Rs.Fields(" ") = Trim(txtClass.Text) End If ADO

311 300 Visual Basic ADO Recordset

312 A 1 VB (0~9) a+bc+def=ghij 1 2 def ghij d=9 g=1 h=0 a b c e f i j x x[i] True i A.1 Text1 Label1 Label2 Text1 Multiline True A.1 1

313 302 Visual Basic Private Sub Form_Load() Show Dim a, b, c, d, e, f, g, i, j, h, u, v, n As Integer Dim x(1 To 9) As Boolean n = 0 For i = 1 To 9 x(i) = True Next Text1.Text = "" g = 1: h = 0: d = 9 For a = 2 To 8 x(a) = False For b = 2 To 8 If x(b) Then x(b) = False For c = 2 To 8 If x(c) Then x(c) = False For e = 2 To 8 If x(e) Then x(e) = False For f = 2 To 8 If x(f) Then x(f) = False For i = 2 To 8 If x(i) Then x(i) = False For j = 2 To 8 If x(j) Then u = a + c + f + (b + e) * v = i * 10 + j If u = v Then str1 = Trim(Str(a)) + "+" + Trim(Str(b)) + _ Trim(Str(c))+"+"+ Trim(Str(d)) + Trim(Str(e)) + _ Trim(Str(f)) + "=" + Trim(Str(g)) + _ Trim(Str(h)) + Trim(Str(i)) + Trim(Str(j)) If n = 0 Then Text1.Text = str1 ElseIf n Mod 3 = 0 Then Text1.Text = Text1.Text + Chr(13) + Chr(10) + str1 Else Text1.Text = Text1.Text + Chr(13) + " " + str1 End If n = n + 1 End If

314 A 303 End If Next x(i) = True End If Next x(f) = True End If Next x(e) = True End If Next x(c) = True End If Next x(b) = True End If Next x(a) = True Next Label1.Caption = " :" + Trim(Str(n)) A.2 60 A.2 1

315 304 Visual Basic 2 A A.3 5 Command1 A.3 2 ' Private Type teacher name As String * 8 rq As String * 7 sex As Boolean prof As String * 8 nation As String * 10 lang As Integer salary As Integer depart As String * 20 history As String * 100 End Type Dim tech() As teacher ' tech Dim n, curi As Integer 'n curi

316 A 305 Private Sub Form_Load() Combo2.AddItem (" ") ' Combo2.AddItem (" ") Combo2.AddItem (" ") Combo2.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Command1(0).Enabled = False ' 4 Command1(1).Enabled = False Command1(3).Enabled = False Command1(4).Enabled = False n = 0 Private Sub display(byval i As Integer) ' tech Text1.Text = tech(i).name Text2.Text = tech(i).rq Text3.Text = tech(i).salary Text4.Text = tech(i).depart Text5.Text = tech(i).history Combo1.Text = tech(i).nation Combo2.Text = tech(i).prof Optsex(0).Value = tech(i).sex HScr.Value = tech(i).lang Private Sub Combo1_Click() ' tech(curi).nation = Combo1.Text Private Sub Combo2_Click() ' tech(curi).prof = Combo2.Text Private Sub HScr_Change() ' tech(curi).lang = HScr.Value Private Sub Optsex_Change(Index As Integer) ' tech(curi).sex = Optsex(0).Value

317 306 Visual Basic Private Sub Text1_change() ' tech(curi).name = Text1.Text Private Sub Text2_Change() ' tech(curi).rq = Text2.Text Private Sub Text3_Change() ' tech(curi).salary = Val(Text3.Text) Private Sub Text4_Change() ' tech(curi).depart = Text4.Text Private Sub Text5_Change() ' tech(curi).history = Text5.Text Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 ' curi = curi 1 If curi <= 0 Then curi = 1 display (curi) Case 1 ' curi = curi + 1 If curi > n Then curi = n display (curi) Case 2 ' ' 4 Command1(0).Enabled = True Command1(1).Enabled = True Command1(3).Enabled = True Command1(4).Enabled = True ' 1 n = n + 1 ' ReDim Preserve tech(n) As teacher curi = n

318 A 307 ' Text1.Text = "": Text2.Text = "": Text3.Text = "" Text4.Text = "": Text5.Text = "": Combo1.Text = "" Combo2.Text = "": HScr.Value = 0: Optsex(0).Value = True ' tech(curi).name = "": tech(curi).rq = "": tech(curi).prof = "" tech(curi).sex = True: tech(curi).nation = "": tech(curi).lang = 0 tech(curi).salary = 0: tech(curi).depart = "": tech(curi).history = "" ' Text1.SetFocus Case 3 ' If MsgBox("?", , " ") = 6 Then ' 1 n = n 1 If n = 0 Then ' Command1(0).Enabled = False Command1(1).Enabled = False Command1(3).Enabled = False Command1(4).Enabled = False Exit Sub End If If cur = n + 1 Then Exit Sub ' ' For i = curi To n tech(i).name = tech(i + 1).name tech(i).rq = tech(i + 1).rq tech(i).sex = tech(i + 1).sex tech(i).prof = tech(i + 1).prof tech(i).nation = tech(i + 1).nation tech(i).lang = tech(i + 1).lang tech(i).salary = tech(i + 1).salary tech(i).history = tech(i + 1).history tech(i).depart = tech(i + 1).depart Next ' cur = cur - 1 display (cur) End If Case 4 ' i = InputBox(" (1-" + Trim(Str(n)) + ")", " ", "1") ' If i <= n And i > 0 Then cur = i display (curi) End If

319 308 Visual Basic End Select A.4 A.5 A.6 A.4 2 A.5 2 A.6 2

320 A A A.7 3 Text1 MultiLine True " " font..." " font1(1)..." " font1(2)..." " font1(3)..." " font1(4)..." " font1(5)..." " font1(6) "size..."28 "(size1(1))..."24 "(size1(2))..."18 "(size1(3))..."14 "(size1(4))..."10 "(size1(5))..."8 "(size1(6)) " "color..." "(color1(1))

321 310 Visual Basic..." "(color1(2))..." "(color1(3))..." "(color1(4))..." "(color1(5)) " " specfont..." "(font2(1))..." "(font2(2))..." "(font2(3)) Private Sub font1_click(index As Integer) Select Case Index Case 1 Text1.FontName = " _GB2312" Case 2 Text1.FontName = " " Case 3 Text1.FontName = " _GB2312" Case 4 Text1.FontName = " " Case 5 Text1.FontName = " " Case 6 Text1.FontName = " " End Select Private Sub size1_click(index As Integer) Select Case Index Case 1 Text1.FontSize = 28 Case 2 Text1.FontSize = 24 Case 3 Text1.FontSize = 18 Case 4 Text1.FontSize = 14 Case 5 Text1.FontSize = 10 Case 6 Text1.FontSize = 8 End Select Private Sub color1_click(index As Integer) Select Case Index

322 A 311 Case 1 Text1.ForeColor = vbred Case 2 Text1.ForeColor = vbyellow Case 3 Text1.ForeColor = vbgreen Case 4 Text1.ForeColor = vbblue Case 5 Text1.ForeColor = vbblack End Select Private Sub font2_click(index As Integer) Select Case Index Case 1 Text1.FontItalic = False Text1.FontBold = False Case 2 Text1.FontItalic = True Case 3 Text1.FontBold = True End Select 18 A.8 A.8 3

323 312 Visual Basic 4 A.9 A Picture1 Frame1 Frame2 Frame3 Frame4 Option1 Option2 Option3 Option4 Dim XStart, YStart As Single ' Dim XOld, YOld As Single Dim mshape As Integer ' Private Sub Form_Load() Picture1.ScaleMode = 3 Picture1.DrawWidth = 1

324 A 313 Private Sub Option1_Click(Index As Integer) ' mshape = Index Private Sub Option2_Click(Index As Integer) ' Select Case Index Case 0 Picture1.ForeColor = vbred Case 1 Picture1.ForeColor = vbgreen Case 2 Picture1.ForeColor = vbblue Case 3 Picture1.ForeColor = vbyellow End Select Private Sub Option3_Click(Index As Integer) ' Select Case Index Case 0 Picture1.FillStyle = 0 Case 1 Picture1.FillStyle = 1 Case 2 Picture1.FillStyle = 2 Case 3 Picture1.FillStyle = 3 Case 4 Picture1.FillStyle = 4 Case 5 Picture1.FillStyle = 5 Case 6 Picture1.FillStyle = 6 Case 7 Picture1.FillStyle = 7 End Select Private Sub Option4_Click(Index As Integer) ' Select Case Index Case 0 Picture1.DrawWidth = 1

325 314 Visual Basic Case 1 Picture1.DrawWidth = 2 Case 2 Picture1.DrawWidth = 3 Case 3 Picture1.DrawWidth = 4 End Select Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' If Button = 1 Then XStart = X YStart = Y XOld = XStart YOld = YStart Picture1.DrawMode = 7 End If Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' If Button < > 1 Then Exit Sub Select Case mshape Case 1 Picture1.Line (XStart, YStart)-(XOld, YOld) Picture1.Line (XStart, YStart)-(X, Y) Case 2 Picture1.Line (XStart, YStart)-(XOld, YOld),, B Picture1.Line (XStart, YStart)-(X, Y),, B Case 3 Picture1.Circle (XStart,YStart), Sqr((XOld-XStart)^2+(YOld - YStart)^2) Picture1.Circle (XStart,YStart), Sqr((X - XStart) ^ 2 + (Y - YStart)^2) End Select XOld = X YOld = Y Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Picture1.DrawMode = 13 'Picture1.FillStyle = mfill Select Case mshape Case 0 Picture1.PSet (X, Y) Case 1

326 A 315 Picture1.Line (XStart, YStart)-(X, Y) Case 2 Picture1.Line (XStart, YStart)-(X, Y),, B Case 3 Picture1.Circle (XStart, YStart), Sqr((X - XStart)^2 +(Y - YStart) ^ 2) End Select A.10 A A

327 316 Visual Basic A.11 5 Picture1 Picture2 Frame1 Exit Frame1 6 Label1 4 txtno txtname txtrq txtclass 2 optsex 1 commz Picture1 7 Tp Prev Nex Bott Add Upd Del Picture1.Visible=False Picture1.Visible=True Picture2 2 Ok Cancel Picture2.Visible=False Picture2.Visible=True ' Private Type StudType No As Integer Name As String * 10 Sex As Boolean Rq As Date Mz As String * 12 Class As String * 5 End Type Dim student As StudType Dim Recs As Integer Dim CurNo As Integer Dim Op As Integer ' ' '

328 A 317 Private Sub Exit_Click() ' Open "student1.dat" For Random As #2 Len = Len(student) For i = 1 To Recs Get #1, i, student Put #2, i, student Next Close Kill "student.dat" Name "student1.dat" As "student.dat" End Private Sub Form_Load() Picture2.Visible = False Open "student.dat" For Random As #1 Len = Len(student) ' Recs = LOF 1 / Len(student) If Recs > 0 Then ' CurNo = 1 BEnabled (True) DispRec Else ' CurNo = 0 BEnabled (False) TxtEnabled (False) End If Private Sub Tp_Click() CurNo = 1 DispRec Private Sub Prev_Click() CurNo = CurNo - 1 If CurNo < 1 Then CurNo = 1 DispRec Private Sub Nex_Click() CurNo = CurNo + 1 If CurNo > Recs Then CurNo = Recs DispRec Private Sub Bott_Click()

329 318 Visual Basic CurNo = Recs DispRec Private Sub Add_Click() labop.caption = " " BEnabled (True) Op = 1 txtno.text = ""' txtname.text = "" Optsex(0).Value = True commz.text = "" txtrq.text = "" txtclass.text = "" TxtEnabled (True) Picture1.Visible = False ' Picture2.Visible = True Private Sub Upd_Click() labop.caption = " " Op = 2 TxtEnabled (True) Picture1.Visible = False ' Picture2.Visible = True Private Sub Del_Click() labop.caption = " " Op = 3 Picture1.Visible = False ' Picture2.Visible = True Private Sub Ok_Click() Picture1.Visible = True Picture2.Visible = False If Op = 1 Then ' Recs = Recs + 1 CurNo = Recs WriteRec ElseIf Op = 2 Then ' WriteRec ElseIf Op = 3 Then ' i = CurNo Do While i < Recs

330 A 319 Get #1, i + 1, student Put #1, i, student i = i + 1 Loop Recs = Recs - 1 student.no = Empty student.name = "" student.sex = Empty student.mz = "" student.rq = Empty student.class = "" Put #1, i, student If Recs = 0 Then txtno.text = "" txtname.text = "" Optsex(0).Value = True commz.text = "" txtrq.text = "" txtclass.text = "" BEnabled (False) Else CurNo = CurNo - 1 DispRec End If End If ' ' ' Private Sub Cancel_Click() Picture1.Visible = True ' Picture2.Visible = False If Recs = 0 Then ' txtno.text = "" ' txtname.text = "" Optsex(0).Value = True commz.text = "" txtrq.text = "" txtclass.text = "" BEnabled (False) ' Else DispRec End If Private Sub DispRec() ' Get #1, CurNo, student

331 320 Visual Basic txtno.text = student.no txtname.text = student.name If student.sex = True Then Optsex(0).Value = True Else Optsex(1).Value = True End If commz.text = student.mz txtrq.text = student.rq txtclass.text = student.class TxtEnabled (False) Picture2.Visible = False ' Private Sub WriteRec() ' student student.no = Val(txtNo.Text) student.name = txtname.text If Optsex(0) Then student.sex = True Else student.sex = False End If student.mz = commz.text If txtrq.text = "" Then student.rq = Empty Else student.rq = txtrq.text End If student.class = txtclass.text Put #1, CurNo, student Private Sub BEnabled(ByVal setvalue As Boolean) ' Tp.Enabled = setvalue Prev.Enabled = setvalue Nex.Enabled = setvalue Bott.Enabled = setvalue Del.Enabled = setvalue Upd.Enabled = setvalue Private Sub TxtEnabled(ByVal setvalue As Boolean) ' txtno.enabled = setvalue

332 A 321 txtname.enabled = setvalue Optsex(0).Enabled = setvalue Optsex(1).Enabled = setvalue txtrq.enabled = setvalue commz.enabled = setvalue txtclass.enabled = setvalue A.12 A.13 A.14 A.15 A.12 5 A.13 5

333 322 Visual Basic A.14 5 A Integer Text 8 Single Single Single A.16

334 A 323 A Data 2 DBGrid Data Data1 DBGrid Dbgrid1 Frame1 Data1 student.mdb Dbgrid1 Data1 Frame1 5 Label1 5 Text1 3 Command1 Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 If Command1(0).Caption = " " Then Command1(0).Caption = " " Command1(1).Caption = " " Data1.Recordset.AddNew Tenable (False) Else Command1(0).Caption = " " Command1(1).Caption = " " Data1.Recordset.Update Tenable (True) End If Case 1 If Command1(1).Caption = " " Then Command1(0).Caption = " " Command1(1).Caption = " " Data1.Recordset.Edit

335 324 Visual Basic Tenable (False) Else Command1(0).Caption = " " Command1(1).Caption = " " Data1.Recordset.CancelUpdate Data1.Refresh Tenable (True) End If Case 2 Data1.Recordset.Delete Data1.Recordset.MoveNext End Select Text1(0).SetFocus Private Sub Tenable(ByVal setvalue As Boolean) Dim x As TextBox For Each x In Text1 x.locked = setvalue Next Command1(2).Visible = setvalue Data1.Enabled = setvalue Private Sub Data1_Reposition() Data1.Caption = " :" & (Data1.Recordset.AbsolutePosition + 1) & _ "/" & Data1.Recordset.RecordCount Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 13 Then i = (Index + 1) Mod 5 Text1(i).SetFocus End If A.17 A.18

336 A 325 A.17 6 A.18 6

337 B VB Windows 1.2 VB VB VB Microsoft Windows Windows NT VB VB VB VB ActiveX Internet HTML VB VB VB BackOffice SQL Server 1.3 VB Microsoft Visual Basic 6.0 Microsoft Visual Basic 6.0 VB VB VB VB 1.4 VB VB

338 B 327 VB VB (Click DblClick) (Load) (MouseMove) (Print) (Show) 2.2 VB Form1 Command1 Label1 Command1 (Click) Private Sub Commmand1_Click() Label1.Caption = Command1

339 328 Visual Basic 2.3. = ( ). ( ) (Textl) (Text) Text1.Text = " " Form2 Form2.Hide 2.4.vbp.vbg.frm.bas Public Visual Basic.cls 2.5 Label1 Command1 Command2 Private Sub Command1_Click() ' Label1.Caption = " " Private Sub Command2_Click() ' Label1.Caption = " 51 "

340 B Text1 Text2 Text3 Command1 command2 Command3 Command4 Private Sub Command1_Click() Text3.Text = Val(Text1.Text) + Val(Text2.Text) Private Sub Command2_Click() Text3.Text = Val(Text1.Text) - Val(Text2.Text) Private Sub Command3_Click() Text3.Text = Val(Text1.Text) * Val(Text2.Text) Private Sub Command4_Click() If Val(Text2.Text) <> 0 Then Text3.Text = Val(Text1.Text) + Val(Text2.Text) End If False 1ABC A[7] A-2 A.3 "Comp" VB 3.2 name ff cj n "name" False "11/16/99" "120" #11/ # "name" "11/16/99" "120" False #11/16/2000# VB 0 ("") Variant Empty False Label1 6 Text1 Command1 Private Sub Command1_Click() s = Val(Text1(0).Text) * Val(Text1(1).Text) + _

341 330 Visual Basic Val(Text1(2).Text) * Val(Text1(3).Text) + _ Val(Text1(4).Text) * Val(Text1(5).Text) MsgBox " " + Trim(Str(s)), 0, " " Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) i = Index + 1 If i >= 6 Then i = 0 If KeyAscii = 13 Then Text1(i).SetFocus End If Label1 Label2 Text1 Command1 Private Sub Command1_Click() Dim s As Integer Dim a, b, c, revs As String s = Val(Text1.Text) If s < 100 Or s > 999 Then Exit Sub a = Str(s \ 100): s1 = s - Val(a) * 100 b = Str(s1 \ 10): s2 = s1 - Val(b) * 10 c = Str(s2) revs = c + b + a Label2.Caption = " :" + revs Label1 Label2 3 Text1 Command1 Private Sub Command1_Click() Dim a, b, c, m As Integer a = Val(Text1(0).Text) b = Val(Text1(1).Text) c = Val(Text1(2).Text) If a < b Then If b < c Then m = c Else m = b Else If a < c Then m = c Else m = a End If Label2.Caption = " " + Str(m) Label1 Label2 3 Text1 Command1

342 B 331 Private Sub Command1_Click() Dim a, b, c, d, x1, x2 As Single a = Val(Text1(0).Text) b = Val(Text1(1).Text) c = Val(Text1(2).Text) d = b * b - 4 * a * c If d > 0 Then x1 = (-b + Sqr(d)) / (2 * a) x2 = (-b - Sqr(d)) / (2 * a) Label2.Caption = " :x1=" + Trim(Str(x1)) + " x2=" + Trim(Str(x2)) ElseIf d = 0 Then x1 = -b / (2 * a) Label2.Caption = " :x=" + Trim(Str(x1)) Else Label2.Caption = " " End If Label1 Label2 Text1 Command1 Private Sub Command1_Click() Dim a, s As Single a = Val(Text1.Text) Select Case a Case Is < s = a * 0.05 Case Is < s = * (a ) * 0.1 Case Is < s = * ( ) * (a ) * 0.2 Case Else s = * ( ) * ( ) * _ (a ) * 0.4 End Select Label2.Caption = " " + Trim(Str(s)) Label1 Label2 Text1 Command1 Private Sub Command1_Click() Dim a, s, x As Single a = Val(Text1.Text) s = 15 * Int((a + 14) / 15)

343 332 Visual Basic Select Case s Case 15 x = 5 Case 30 x = 9 Case 45 x = 12 Case 60 x = 14 Case Else x = 20 End Select Label2.Caption = " " + Trim(Str(x)) 3.10 Private Sun Form_Load Show Dim A(1 To 20) For i=1 To 20 A(i)=Int(Rnd*100) Next For Each x In A If x<60 Then Print x Next 3.11 Private Sub Form_Load Show Dim m,n As Integer Dim A(1 To 10) For i=1 to 10 A[i]=Int(Rnd*90)+10 Next Print m=100:n=-100 For i=1 To 10 If A[i]>n Then n=a[i] If A[i]<m Then m=a[i] Next Print " ";n Print " ";m

344 B Private Sub Form_Load() Show Dim n, c, i, j As Integer n = InputBox(" ( 10)", " ", "5") For i = 0 To n - 1 c = 1 Print Tab(30-2 * i); c; For j = 1 To i c = c * (i - j + 1) \ j Print c; ; Next Print Next 3.13 Private Sub Form_Load() Show Dim studname 5 As String * 8 Dim measure(5, 2) As Single studname 1 = " ": studname 2 = " ": studname 3 = " " studname 4 = " ": studname 5 = " " measure(1, 1) = 180.6: measure(1, 2) = 75.8 measure(2, 1) = 180.4: measure(2, 2) = 68.7 measure(3, 1) = 179.6: measure(3, 2) = 72.5 measure(4, 1) = 170.9: measure(4, 2) = 69.9 measure(5, 1) = 168.2: measure(5, 2) = 65.8 FontName = " _GB2312": FontSize = 16: FontUnderline = True Print Tab(7); " " Print FontName = " ": FontSize = 10 Print " "; Print Tab(15); " "; Print Tab(30); " " Print FontUnderline = False For i = 1 To 5 Print studname(i); Print Tab(15); Format$(measure(i, 1), "000.0"); Print Tab(30); Format$(measure(i, 2), "00.0") high = high + measure(i, 1) Weight = Weight + measure(i, 2) Next Print

345 334 Visual Basic Print FontItalic = True Print " "; Print Tab(15); Format$(high / 5, "000.0"); Print Tab(30); Format$(Weight / 5, "00.0") 3.14 Private Function sum(byval m) Dim s,i as Integer For i=1 To m s=s+i Next sum=s End Function Private Sub Form_Load() Dim n,s,i As Integer n=inputbox(" "," ","10") For i=1 To n s=s+sum(i) Next MsgBox(" : "+Trim(Str(s)),0, " ") 3.15 Private Sub Form_Load Dim n,s As Integer n=1:s=1 Do While s<=40000 n=n+1:s=s*n Loop MsgBox(" n : "+Trim(Str(n)),0, " ") Label1 Label1 Lable1(1) Ctrl Label1(0) 30

346 B Text1 FontName " " FontSize 10.5 ForeColor &H00FF0000& MultiLine -1 'True ScrollBars 3 'Both 4.3 Command1 Caption " " FontName " _GB2312" FontSize 12 ToolTipText " " 4.4 Check1 Private Sub Command1_Click() If Check1 1 And Check1 3 Then Label2.Caption = " " Else Label2.Caption = " " End If 4.5 Label1 Private Sub Option1_Click(Index As Integer) If Index = 1 Then Label2.Caption = " " Else Label2.Caption = " " End If 4.6 Text1 Frame1 Frame2 Option1 Option2 Private Sub Option1_Click(Index As Integer) If Index = 0 Then Text1.FontName = " "

347 336 Visual Basic Else Text1.FontName = " _GB2312" End If Private Sub Option2_Click(Index As Integer) If Index = 0 Then Text1.FontSize = 10 Else Text1.FontSize = 16 End If 4.7 List1 List2 List3 Dim a As Integer Private Sub Form_Load() List1.AddItem ("12") List1.AddItem ("10") List1.AddItem ("5") List1.AddItem ("8") List1.AddItem ("22") List1.AddItem ("25") List1.AddItem ("9") List2.AddItem ("9") List2.AddItem ("15") List2.AddItem ("20") List2.AddItem ("32") List2.AddItem ("18") List2.AddItem ("5") List2.AddItem ("7") List2.AddItem ("32") Private Sub List1_Click() a = Val(List1.Text) Private Sub List2_Click() b = Val(List2.Text) List3.AddItem Trim(Str(a)) + "*" + Trim(Str(b)) + "=" + Trim(Str(a * b)) Private Sub List3_Click() List3.RemoveItem List3.ListIndex Combo1

348 B 337 Private Sub Form_Load() Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Combo1.AddItem (" ") Private Sub Combo1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then ' Enter For i = 1 To Combo1.ListCount If Combo1.Text = Combo1.List(i) Then Label2.Caption = " " Exit Sub End If Next Label2.Caption = " " Combo1.AddItem (Combo1.Text) End If 4.9 Picture1 Timer1 Label1 Interval 100 Private Sub Timer1_Timer() If Label1.Left - 30 >= Picture1.Left Then Label1.Left = Label1.Left - 30 Else Label1.Left = Picture1.Left + Picture1.Width - 30 End If Label1 Label2 Text1 Timer1 Private Sub Form_Load() ' Text1(1).Text = InputBox$(" ( : : ):", _ " ", "00:01:01")

349 338 Visual Basic Private Sub Timer1_Timer() Text1(0).Text = Time If Text1(1).Text = "" Then Exit Sub t = DateDiff("s", Text1(1).Text, Time$) If Abs(t) < 5 Then '5 Label2.Caption = " " Beep ' Beep Else Label2.Caption = "" End If 4.11 Img txt img Name img Height 555 Stretch -1 'True Width 675 txt Name txt Text "" Height 270 Width 675 Shift 26 drive1 dir1 file1 Private Sub Form_Load() Dir1.Path = Drive1.Drive File1.Path = Dir1.Path File1.Pattern = "*.bmp" File1.Visible = False ' Private Sub Dir1_Change() File1.Path = Dir1.Path If File1.ListCount = 0 Then Exit Sub m = IIf(File1.ListCount > 26, 26, File1.ListCount) For i = 0 To m 1 'txt txt(i).text = Left(File1.List(i), Len(File1.List(i)) - 4)

350 B 339 img(i).picture = LoadPicture(Dir1.Path & "\" & File1.List(i)) Next Private Sub Drive1_Change() Dir1.Path = Drive1.Drive 4.12 Label2 Combo1 Frame1 5 Label1 5 Text1 Private Type student ' no As Integer name As String * 8 sex As String * 2 rq As Date class As String * 5 End Type Dim stud(1 To 10) As student ' student Private Sub Form_Load() ' stud(1).no = 1: stud(1).name = " ": stud(1).sex = " " stud(1).rq = #10/2/1980#: stud(1).class = "99091" stud(2).no = 2: stud(2).name = " ": stud(2).sex = " " stud(2).rq = #10/4/1981#: stud(2).class = "99101" stud(3).no = 3: stud(3).name = " ": stud(3).sex = " " stud(3).rq = #3/2/1980#: stud(3).class = "99091" stud(4).no = 4: stud(4).name = " ": stud(4).sex = " " stud(4).rq = #1/5/1980#: stud(4).class = "99101" stud(5).no = 5: stud(5).name = " ": stud(5).sex = " " stud(5).rq = #3/10/1980#: stud(5).class = "99091" stud(6).no = 6: stud(6).name = " ": stud(6).sex = " " stud(6).rq = #6/2/1980#: stud(6).class = "99101" stud(7).no = 7: stud(7).name = " ": stud(7).sex = " " stud(7).rq = #10/9/1981#: stud(7).class = "99091" stud(8).no = 8: stud(8).name = " ": stud(8).sex = " " stud(8).rq = #5/2/1982#: stud(8).class = "99101" stud(9).no = 9: stud(9).name = " ": stud(9).sex = " " stud(9).rq = #8/3/1980#: stud(9).class = "99101" stud(10).no = 10: stud(10).name = " ": stud(10).sex = " " stud(10).rq = #11/8/1980#: stud(10).class = "99091" ' For i = 1 To 10 Combo1.AddItem stud(i).no Next

351 340 Visual Basic Private Sub Combo1_Click() i = 1 ' Do While Val(Combo1.Text) <> stud(i).no i = i + 1 Loop If i > 10 Then MsgBox " ", 0, " " Text1(0).Text = stud(i).no ' Text1(1).Text = stud(i).name Text1(2).Text = stud(i).sex Text1(3).Text = stud(i).rq Text1(4).Text = stud(i).class MaxButton MinButton False Private Sub Form_Load() Show Caption = "" Appearance = 0 BackColor = vbgreen ForeColor = vbred: FontUnderline = True FontBold = True: FontSize = 16: FontItalic = True Print Tab(6); "VB " Print ForeColor = vbblue: FontUnderline = False FontBold = False: FontSize = 11: FontItalic = False Print "1. Visual Basic " Print "2. Visual Basic 6.0 " Print "3. Visual Basic " Print "4. Visual Basic " 5.2 " " Font " " Font..." " Font1..." " Font2

352 B " " Font3..." " Font4 " " Size..."10" Size1..."12" Size2..."16" Size3..."26" Size4 Private Sub font1_click() Label1.FontName = " _GB2312" Private Sub font2_click() Label1.FontName = " " Private Sub font3_click() Label1.FontName = " _GB2312" Private Sub font4_click() Label1.FontName = " " Private Sub size1_click() Label1.FontSize = 10 Private Sub size2_click() Label1.FontSize = 14 Private Sub size3_click() Label1.FontSize = 20 Private Sub size4_click() Label1.FontSize = op op(1) op(2) op(3) 'Div 1 0 Dim Div As Integer Private Sub op_click(index As Integer) If Val(Text2.Text) <> 0 Then If Div = 0 Then Load op(4) op(4).caption = " " op(4).visible = True

353 342 Visual Basic Div = 1 End If Else If Div = 1 Then Unload op(4) Div = 0 If Index = 4 Then Exit Sub End If End If End If Select Case Index Case 1 Text3.Text = Val(Text1.Text) + Val(Text2.Text) Case 2 Text3.Text = Val(Text1.Text) - Val(Text2.Text) Case 3 Text3.Text = Val(Text1.Text) * Val(Text2.Text) Case 4 Text3.Text = Val(Text1.Text) / Val(Text2.Text) End Select Private Sub Exit_Click() End 5.4 Text1 Multiline True oper oper... oper1... oper2 Dim str As String Private Sub oper1_click() str = Text1.SelText Private Sub oper2_click() Str1 = Mid(Text1.Text, 1, Text1.SelStart) Str3 = Mid(Text1.Text, Text1.SelStart + 1, Len(Text1.Text)) Text1.Text = Str1 + str + Str3 Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then

354 B 343 PopupMenu oper, 2 End If Shape BackStyle=0 BorderStyle=0 FillStyle=0 FillColor=&H000000FF& ( ) FillStyle=0 FillColor=&H00FFFFFF& ( ) BackStyle=0 BorderStyle=0 FillStyle=0 FillColor=&H00FFFFFF& ( ) 6.2 Private Sub Form_Paint() For i = 1000 To 1 Step 1 Circle (1900, i), 1000, vbred,,, 3 / 7 Next Me.FillStyle = 0 Me.FillColor = RGB(255, 255, 255) Circle (1900, 700), 1000,,,, 3 / Private Sub Form_Load() Show x0 = 1500: y0 = 500 X1 = 2500: Y1 = 2000 X2 = 4000: Y2 = 3000

355 344 Visual Basic x3 = 600: y3 = 3000 x4 = 400: y4 = 2000 DrawStyle = 0 DrawWidth = 2 Line (x0, y0)-(x2, Y2) Line -(x3, y3) Line -(x4, y4) Line -(x0, y0) Line -(x3, y3) DrawStyle = 2 DrawWidth = 1 Line (x0, y0)-(x1, Y1) Line -(X2, Y2) Line (X1, Y1)-(x4, y4) DrawStyle = 3 DrawWidth = 1 Line (x0, y0)-(x0, (Y1 + Y2) / 2) 6.4 Const pi = Private Sub Form_Paint() For i = 300 To 1 Step 1 Circle (1900, i), 1000, vbred, -pi / 3, -pi / 6, 3 / 5 Next Me.FillStyle = 0 Me.FillColor = RGB(255, 255, 255) ' Circle (1900, 1000), 1000,, -pi / 3, -pi / 6, 3 / Picture1 Command1 Picture1 Appearance 0 Const pi = Private Sub Command1_Click() Dim i As Single Picture1.ForeColor = vbred Picture1.Scale (-2 * pi, 1)-(2 * pi, -1) ' Picture1.CurrentX = -2 * pi ' Picture1.CurrentY = 0 For i = -2 * pi To 2 * pi Step 0.01 Picture1.Line -(i, Cos(3 * i) * Sin(5 * i)) ' Next

356 B Const pi = Private Sub Command1_Click() degree = InputBox(" ", "") If degree < 0 Or degree > 360 Then Exit Sub m = Pic1.ScaleWidth d = degree * pi / 180 Pic1.Scale (-m / 2, m / 2)-(m / 2, -m / 2) Pic2.Scale (-m / 2, m / 2)-(m / 2, -m / 2) Pic1.CurrentX = 0 Pic1.CurrentY = 0 For i = -m / 2 To m / 2 For j = -m / 2 To m / 2 If Pic1.Point(i, j) = 0 Then x = i * Cos(d) - j * Sin(d) y = i * Sin(d) + j * Cos(d) Pic2.PSet (x, y) End If Next j Next i (Input Output Append) 2 Input 3 Output Append

357 346 Visual Basic Text1 Option1 Command1 Command2 Private Sub Command1_Click() Dim No As String * 5 Dim Name As String * 10 Dim Sex As String * 2 Dim De1, De2, De3, Avg As Integer No = Text1(0).Text Name = Text1(1).Text Sex = IIf(Option1(0).Value, " ", " ") De1 = Val(Text1(2).Text) De2 = Val(Text1(3).Text) De3 = Val(Text1(4).Text) Avg = (De1 + De2 + De3) / 3 Write #1, No, Name, Sex, De1, De2, De3, Avg For i = 0 To 4 Text1(i).Text = "" Next Option1(0).Value = True Text1(0).SetFocus Private Sub Command2_Click() Close #1 End Private Sub Form_Load() Open "xs.dat" For Append As #1 B.19 xs.dat B.19

358 B MultiLine True Command1 Command2 Private Sub Command1_Click() Dim No As String * 5 Dim Name As String * 10 Dim Sex As String * 2 Dim De1, De2, De3, Avg As Integer Open "xs.dat" For Input As #2 Text1.Text=" " + Chr(13) + Chr(10) + _ " " Do Until EOF(2) Input #2, No, Name, Sex, De1, De2, De3, Avg Text1.Text = Text1.Text + Chr(13) + Chr(10) + _ No+Name+Sex+" "+Str(De1)+" "+ Str(De2) + " " + Str(De3) + " " + Str(Avg) Loop Close #2 Private Sub Command2_Click() End B.20 B Private Type student No As String * 5 Name As String * 10 Sex As String * 2 De1 As Integer De2 As Integer De3 As Integer

359 348 Visual Basic Avg As Integer End Type Dim Stud As student Private Sub Command1_Click() Stud.No = Text1(0).Text Stud.Name = Text1(1).Text Stud.Sex = IIf(Option1(0).Value, " ", " ") Stud.De1 = Val(Text1(2).Text) Stud.De2 = Val(Text1(3).Text) Stud.De3 = Val(Text1(4).Text) Stud.Avg = (De1 + De2 + De3) / 3 Put #1,, Stud For i = 0 To 4 Text1(i).Text = "" Next Option1(0).Value = True Text1(0).SetFocus Private Sub Command2_Click() Close #1 End Private Sub Form_Load() Open "xs1.dat" For Random As #1 Len = Len(Stud) 7.5 Private Type student No As String * 5 Name As String * 10 Sex As String * 2 De1 As Integer De2 As Integer De3 As Integer Avg As Integer End Type Dim Stud As student Private Sub Command1_Click() Dim Recnum, totalrec As Integer Recnum = InputBox(" ", " ") Open "xs1.dat" For Random As #2 Len = Len(Stud) totalrec = LOF 2 / Len(Stud)

360 B 349 If Recnum <= 0 Or Recnum > totalrec Then Exit Sub Get #2, Recnum, Stud Text1(0).Text = Stud.No Text1(1).Text = Stud.Name Option1(0) = IIf(Stud.Sex = " ", True, False) Text1(2).Text = Stud.De1 Text1(3).Text = Stud.De2 Text1(4).Text = Stud.De3 Close #2 Private Sub Command2_Click() End text1 command1 command2 Private Sub Command1_Click() Clipboard.SetText Text1.SelText Command2.Enabled = True Private Sub Command2_Click() Dim Str1 As String Dim Str2 As String Dim Str3 As String Str2 = Clipboard.GetText() Str1 = Mid(Text1.Text, 1, Text1.SelStart) Str3 = Mid(Text1.Text, Text1.SelStart + 1, Len(Text1.Text)) Text1.Text = Str1 + Str2 + Str3 Private Sub Form_Load() Clipboard.Clear Command2.Enabled = False 8.2 label1 AutoSize True Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Label1.Caption = "(" + Trim(Str(X)) + "," + Trim(Str(Y)) + ")"

361 350 Visual Basic 8.3 Drive1 Dir1 File1 Picture1 Label1 Private Sub Dir1_Change() File1.Path = Dir1.Path Private Sub Drive1_Change() Dir1.Path = Drive1.Drive Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, On Error Resume Next Dim Fn As String Fn = Dir1.Path + "\" + File1.FileName Label1.Caption = Fn Picture1.Picture = LoadPicture(Fn) Y As Single) 8.4 Picture1 picture2 Image1 Image1 Stretch True Private Sub Image1_DragDrop(Source As Control, X As Single, Y As Single) If Source.Name = "Picture1" Then Image1.Picture = LoadPicture("e:\media\happy.bmp") Else Image1.Picture = LoadPicture("e:\media\sad.bmp") End If 8.5 label1 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Label1.Caption = Chr(KeyCode) + " ---" + Str(KeyCode) 8.6 Form1 image1 Picture e:\diamond.bmp Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case &H25 Image1.Left = Image1.Left If Image1.Left < 0 Then Image1.Left = 0 Case &H26 Image1.Top = Image1.Top If Image1.Top < 0 Then Image1.Top = 0 Case &H27 Image1.Left = Image1.Left + 100

362 B 351 If Image1.Left + Image1.Width >= Form1.Width Then Image1.Left = _ Form1.Width - Image1.Width Case &H28 Image1.Top = Image1.Top '405 Height If Image1.Top + Image1.Height >= Form1.Height Then _ Image1.Top = Form1.Height - 2 * Image1.Height End Select Class1 Public x As Integer Private Sub Class_Initialize() MsgBox " Initialize " Private Sub Class_Terminate() MsgBox " Terminate " Public Sub Add() x = x + 1 command1 Private Sub Command1_Click() Set myobject = New Class1 myobject.x = 1 ' Initialize myobject.add Print myobject.x myobject.x=1 Class1 Initialize Print myobject.x myobject Class1 Terminate 9.2 Class2 Public mainstr As String Public substr As String Public count As Integer

363 352 Visual Basic Private Sub Class_Initialize() count = 0 Public Sub compcount() Dim i As Integer Dim j As Integer Dim k As Integer For i = 1 To Len(mainstr) j = i k = 1 Do While (j <= Len(mainstr) And k <= Len(substr) And _ Mid$(mainstr, j, 1) = Mid$(substr, k, 1)) j = j + 1 k = k + 1 Loop If (k = Len(substr) + 1) Then count = count + 1 Next Private Sub Class_Terminate() MsgBox " " + str(count), vbokonly, " " label1 label2 text1 text2 command1 Private Sub Command1_Click() Set myobject = New Class2 myobject.substr = Trim(Text1.Text) myobject.mainstr = Trim(Text2.Text) myobject.compcount 9.3 Class3 Public f As Single Public c As Single Public Sub trans() c = (5 / 9) * (f - 32) Form3 Command1 Private Sub Command1_Click() Set myobject = New Class3 myobject.f = Val(Text1.Text) myobject.trans

364 B 353 Text2.Text = myobject.c Caption 2 Private SizeStatus As Boolean True False 3 Property Get Sizer() As Boolean Sizer=SizeStatus End Property 4 Property Let Sizer(x As Boolean) SizeStatus=x If x=false Then SizeStatus=False Me.Width=Width/1.5 Me.Height=Height/1.5 Else SizeStatus=True Width=Width*1.5 Height=Height*1.5 End If End Property Sizer True False Me 5 Private Sub Command_Click() Sizer=False Private Sub Command2_Click Sizer=True Sizer False Sizer True 6

365 354 Visual Basic Private Sub Command3_Click() FontSize=12 If Sizer=False Then Print " Sizer=" If Sizer=True Then Print " Sizer=" x=sizer Print x Sizer ( ) Sizer Private IsCentered As Bollean 3 Public Property Let Center(x As Boolean) IsCentered=x If x Then Me.Move(Screen.Width-Me.Width) 2 (Screen.Height-Me.Height) 2 End If End Property Public Property Get Center() As Boolean Center=IsCentered End Property Property Let Center True 4 Center Private Sub Command1_Click() FontSize=12 If Me.Center=False Then Print " Center=" Center End If If Me.Center=True Then Print " Center=" Center End If 5

366 B 355 Private Sub Command2_Click() Me.Center=True 6 Private Sub Command3_Click() t=rnd*4000 l=rnd*2000 Me.Move t,l Center=False Center VB 3 Jet Jet Microsoft Access VB Jet ISAM (ISAM) Dbase FoxPro Text Files Paradox VB ODBC ODBC Microsoft SQL Server Oracle Sybase VB ODBC 10.2 VB (Data ) DAO 2 (DAO) DAO/Jet ISAM DAO/ODBC Direct RDO DAO DAO 3 (Jet) DAO Access ODBC Jet

367 356 Visual Basic Jet 4 (ODBC) ODBC 5 (RDC) RDO 6 (RDO) ODBC RDO ODBC API ODBC 7 ADO OLE DB Microsoft OLE DB API ADO 10.3 (Recordset) VB Recordset 1 Data 4 Recordset 4 MoveFirst MoveLast MoveNext MovePrevious 2 AddNew Update Delete MoveNext Edit Update 10.4 Data DataSource DataField DataSource RDO ADO DataField DataSource DataField Recordset

368 B ADO ADO ADO Connectionstring RecordSource Connectionstring ADO ADO OLE DB Provider RecordSource SQL ADO 1 ADO ADODC Connectionstring 2 Microsoft Jet 3.51 OLE DB Provider (3) ( ) 4 2-adCmdTable VB Data DAO ADO VB 6.0 OLE DB Web IMS VSAM ADO ADO Microsoft ADO DataList DataCombo DataGrid Data DBGrid DBList DBCombo DAO cmdadd cmddelete cmdupdate cmdclose Data Click Private Sub cmdadd_click() Data1.Recordset.AddNew Private Sub cmddelete_click() Data1.Recordset.Delete Data1.Recordset.MoveNext

369 358 Visual Basic Private Sub cmdupdate_click() Data1.UpdateRecord Data1.Recordset.Bookmark = Data1.Recordset.LastModified Private Sub cmdclose_click() Unload Me 10.8 ADO Data Adodc1 Frame1 5 Label1 5 Text1 3 Command1 Text1 0 DataSource="adodc1" DataField=" " Private Sub Adodc1_MoveComplete(ByVal adreason As ADODB.EventReasonEnum, _ ByVal perror As ADODB.Error, adstatus As ADODB.EventStatusEnum, _ ByVal precordset As ADODB.Recordset) ' ADO Adodc1.Caption = " :" & (Adodc1.Recordset.AbsolutePosition) & _ "/" & Adodc1.Recordset.RecordCount Private Sub Command1_Click(Index As Integer) Select Case Index Case 0' If Command1(0).Caption = " " Then Command1(0).Caption = " " Command1(1).Caption = " " Adodc1.Recordset.AddNew Tenable (False) Else Command1(0).Caption = " " Command1(1).Caption = " " Adodc1.Recordset.UpdateBatch adaffectall Tenable (True) End If Case 1' If Command1(1).Caption = " " Then Command1(0).Caption = " " Command1(1).Caption = " " Tenable (False) Else

370 B 359 Command1(0).Caption = " " Command1(1).Caption = " " Adodc1.Recordset.CancelUpdate Adodc1.Refresh Tenable (True) End If Case 2' Adodc1.Recordset.Delete Adodc1.Recordset.MoveNext End Select Text1(0).SetFocus Private Sub Tenable(ByVal setvalue As Boolean) ' Dim x As TextBox For Each x In Text1 x.locked = setvalue Next Command1(2).Visible = setvalue Adodc1.Enabled = setvalue Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) ' Enter If KeyAscii = 13 Then i = (Index + 1) Mod 5 Text1(i).SetFocus End If Jet RDO VB DAO 11.1 DAO Database Database

371 360 Visual Basic 11.1 Microsoft Jet DBEngine Workspaces ( ) Workspace Workspace Databases Database Database TableDef TableDef DAO DAO 11.2 Private Sub Form_Load() Dim Ws As Workspace Dim Db As Database Dim Tb As TableDef Dim myfield As Field Dim Idx As Index Dim IdxField As Field ' Set Ws = DBEngine.Workspaces(0) ' Set Db = Ws.CreateDatabase("E:\VB\sample", dblanggeneral) ' : Db stud Set Tb = Db.CreateTableDef("stud") ' : Tb 5 Set myfield = Tb.CreateField(" ", dbinteger) Tb.Fields.Append myfield Set myfield = Tb.CreateField(" ", dbtext, 8) Tb.Fields.Append myfield Set myfield = Tb.CreateField(" ", dbtext, 2) Tb.Fields.Append myfield Set myfield = Tb.CreateField(" ", dbtext, 12) Tb.Fields.Append myfield Set myfield = Tb.CreateField(" ", dbtext, 5) Tb.Fields.Append myfield ' Set Idx = Tb.CreateIndex(" ") ' Set IdxField = Idx.CreateField(" ") ' Tb.Indexes.Append Idx ' Tb Db Db.TableDefs.Append Tb

372 B Private Sub CreateNewDatabase DatabaseName As String 'DatabaseName Dim myws As Workspace Dim mydb As Database Set myws=dbengine.workspaces(0) If Dir(DatabaseName)<> "" Then Kill DatabaseName Set mydb=myws.createdatabase(databasename,dblanggeneral) mydb.close 2 Private Sub CreateTable(DatabaseName As String,TableName As String, _ FieldCount As Integer,FieldName() As String, _ FieldType() As Integer,FieldLength() As Integer) 'DatabaseName TableName 'FieldCount FieldName 'FieldType FieldLength Dim mydb As Database Dim mytable As TableDef Dim myfield As Field ' Set mydb=workspaces(0).opendatabase(databasename) ' Set mytable=mydb.createtabledef(tablename) ' For i=1 To FieldCount If FieldLength(i)=0 Then Set myfield=mytable.createfield(fieldname(i),fieldtype(i)) Else Set myfield=mytable.createfield(fieldname(i),fieldtype(i), _ FieldLength(i)) End If mytable.fields Append myfield Next ' mydb.tabledefs.append mytable ' mydb.close 3 Private Sub AddNewRecord(DatabaseName As String,TableName As String, _ FieldCount As Integer,FieldName() As String, _

373 362 Visual Basic FieldValue() As Variant) 'DatabaseName TableName 'FieldCount FieldName 'FieldValue Dim mydb As Database Dim myrecs As Recordset ' Set mydb=workspaces(0).opendatabase(databasename) ' Set myrecs=mydb.openrecordset(tablename,dbopendynaset) ' myrecs.addnew ' For i=1 to FieldCount myrecs(fieldname(i))=fieldvalue(i) Next ' myrecs.update ' mydb.close 11.4 Frame1 Command1 Command2 Command3 Command4 Dim mydb As Database Dim myrecs As Recordset Private Sub Form_Load() Set mydb = Workspaces(0).OpenDatabase("e:\vb\student") Set myrecs = mydb.openrecordset("select * from ") myrecs.movefirst RecordDisplay Private Sub Command1_Click() myrecs.movefirst RecordDisplay Private Sub Command2_Click() myrecs.moveprevious If myrecs.bof Then myrecs.movenext Exit Sub Else

374 B 363 RecordDisplay End If Private Sub Command3_Click() myrecs.movenext If myrecs.eof Then myrecs.moveprevious Exit Sub Else RecordDisplay End If Private Sub Command4_Click() myrecs.movelast RecordDisplay Private Sub RecordDisplay() Text1(0).Text = myrecs.fields(" ") Text1(1).Text = myrecs.fields(" ") Text1(2).Text = myrecs.fields(" ") Text1(3).Text = myrecs.fields(" ") Text1(4).Text = myrecs.fields(" ") Text1(5).Text = str(myrecs.absoluteposition + 1) Connection ADO Recordset Connection SQL Connection Connection ' ADO 2.0 Private Conn As ADODB.Connection Private Rs As ADODB.Recordset Public Sub RecordQuery() Set Conn = New ADODB.Connection Set Rs = New Recordset Conn.ConnectionStrin = "DRIVER={Microsoft Access Driver(.mdb)};" & _ "DBQ=e:\vb\person.mdb" Conn.Open Set Rs = Conn.Execute("Select * From person")

375 364 Visual Basic Conn.Close ADO Recorset Open ' ADO 2.0 Private Rs As ADODB.Recordset Public Sub RecordQuery() Dim ConnString As String Set Rs = New Recordset ConnString = "DRIVER={Microsoft Access Driver(.mdb)}; & _ "DBQ=e:\vb\person.mdb" Rs.0pen "Select * From person",connstring 12.2 Recordset Update AddNew Update UpdateBatch AddNew Update Delete UpdateBatch Status ADO 1 Recordset 2 Recordset AddNew 3 Recordset 4 Recordset Update ADO 1 Recordset 2 Recordset Edit 3 Recordset 4 Recordset Update Recordset Private Conn As ADODB.Connection Private Rs As ADODB.Recordset Private Sub Form_Load() Set Conn = New ADODB.Connection Set Rs = New Recordset Conn.Open "DSN=newstudent" 'newstudent student.mdb

376 B 365 Set Rs.ActiveConnection = Conn Rs.LockType = adlockoptimistic Rs.CursorType = adopenkeyset Rs.Open "Select * from " Rs.AddNew Rs.Fields(" ") = "10" Rs.Fields(" ") = " " Rs.Fields(" ") = " " Rs.Fields(" ") = " " Rs.Fields(" ") = "99101" Rs.Update Conn.Close Recordset 10 Private Conn As ADODB.Connection Private Rs As ADODB.Recordset Private Sub Form_Load() Set Conn = New ADODB.Connection Set Rs = New Recordset Conn.Open "DSN=newstudent" 'newstudent student.mdb Set Rs.ActiveConnection = Conn Rs.LockType = adlockoptimistic Rs.CursorType = adopenkeyset ' Rs.Open "Select from Where ='10'" If Rs.BOF Then MsgBox " 10 " Else Rs.Fields(" ") = " " Rs.Update End If Conn.Close 12.3 Frame1 7 Command1 Command7 Frame1 6 Label1 6 5 Text1 Text2 Private Conn As ADODB.Connection Private Rs As ADODB.Recordset Private Sub Form_Load() Set Conn = New ADODB.Connection

377 366 Visual Basic Set Rs = New Recordset Set comm = New ADODB.Command Conn.CursorLocation = aduseclient Conn.Open "DSN=newstudent", "", "" Private Sub Command1_Click() Dim strquery As String Set Rs.ActiveConnection = Conn Rs.CursorType = adopenforwardonly If Text2.Text = "" Then strquery = "select * from " Else strquery = "select * from where " & Text2.Text End If Rs.Open strquery ' Rs.MoveFirst Text1(0).Text = Rs.Fields(" ") Text1(1).Text = Rs.Fields(" ") Text1(2).Text = Rs.Fields(" ") Text1(3).Text = Rs.Fields(" ") Text1(4).Text = Rs.Fields(" ") Rs.Close Private Sub Command2_Click() Dim strquery As String Set Rs.ActiveConnection = Conn Rs.LockType = adopenoptimistic Rs.CursorType = adopenkeyset strquery = "select * from " Rs.Open strquery Rs.AddNew Rs.Fields(" ") = Text1(0).Text Rs.Fields(" ") = Text1(1).Text Rs.Fields(" ") = Text1(2).Text Rs.Fields(" ") = Text1(3).Text Rs.Fields(" ") = Text1(4).Text Rs.Update Rs.Close Private Sub Command3_Click() Dim strquery As String Set Rs.ActiveConnection = Conn

378 B 367 Rs.LockType = adlockoptimistic Rs.CursorType = adopenkeyset ' strquery = "Select * from " & _ "Where ='" & Text1(0).Text & "'" Rs.Open strquery Rs.Fields(" ") = Text1(0).Text Rs.Fields(" ") = Text1(1).Text Rs.Fields(" ") = Text1(2).Text Rs.Fields(" ") = Text1(3).Text Rs.Fields(" ") = Text1(4).Text Rs.Update Rs.Close Private Sub Command4_Click() ' Dim strquery As String Set Rs.ActiveConnection = Conn Rs.CursorType = adopenforwardonly strquery = "Select * from " Rs.Open strquery Rs.MoveFirst Text1(0).Text = Rs.Fields(" ") Text1(1).Text = Rs.Fields(" ") Text1(2).Text = Rs.Fields(" ") Text1(3).Text = Rs.Fields(" ") Text1(4).Text = Rs.Fields(" ") Rs.Close Private Sub Command5_Click() ' Dim strquery As String Set Rs.ActiveConnection = Conn Rs.CursorType = adopendynamic strquery = "Select * from " Rs.Open strquery ', Rs.Find (" ='" & Text1(0).Text + "'") Rs.MovePrevious If Rs.BOF Then Rs.MoveLast Text1(0).Text = Rs.Fields(" ") Text1(1).Text = Rs.Fields(" ") Text1(2).Text = Rs.Fields(" ") Text1(3).Text = Rs.Fields(" ")

379 368 Visual Basic Text1(4).Text = Rs.Fields(" ") Rs.Close Private Sub Command6_Click() ' Dim strquery As String Set Rs.ActiveConnection = Conn Rs.CursorType = adopendynamic strquery = "Select * from " Rs.Open strquery ', Rs.Find (" ='" & Text1(0).Text + "'") Rs.MoveNext If Rs.EOF Then Rs.MoveFirst Text1(0).Text = Rs.Fields(" ") Text1(1).Text = Rs.Fields(" ") Text1(2).Text = Rs.Fields(" ") Text1(3).Text = Rs.Fields(" ") Text1(4).Text = Rs.Fields(" ") Rs.Close Private Sub Command7_Click() ' Dim strquery As String Set Rs.ActiveConnection = Conn Rs.CursorType = adopendynamic strquery = "Select * from " Rs.Open strquery Rs.MoveLast Text1(0).Text = Rs.Fields(" ") Text1(1).Text = Rs.Fields(" ") Text1(2).Text = Rs.Fields(" ") Text1(3).Text = Rs.Fields(" ") Text1(4).Text = Rs.Fields(" ") Rs.Close