Diễn Đàn » Hướng Dẫn Lập trình

Tham khảo nhanh VB 6.0

10 trả lời, 3.942 lượt xem — Trang 1 / 1
HÀM

HAM ABS

Dim MyNumber
MyNumber = Abs(50.3)
MyNumber = Abs(-50.3)

HAM ARRAY

Dim MyWeek, MyDay
MyWeek = Array("Mon", "Tue", "Wed", _
"Thu", "Fri", "Sat", "Sun")
MyDay = MyWeek(2)
MyDay = MyWeek(4)

HAM ASC

Dim MyNumber
MyNumber = Asc("A")
MyNumber = Asc("a")
MyNumber = Asc("Apple")

HAM ATN

Dim pi
pi = 4 * Atn(1)
MsgBox pi

HAM CALLBYNAME

Private Sub Command1_Click()
CallByName Text1, "MousePointer", VbLet, _
vbCrosshair
Result = CallByName(Text1, "MousePointer", _
VbGet)
CallByName Text1, "Move", VbMethod, 100, 100
End Sub

HAM CHOOSE

Private Sub Command1_Click()
i = GetChoice(2)
MsgBox i
End Sub
Function GetChoice(Ind As Integer)
GetChoice = _
Choose(Ind, "Speedy", "United", "Federal")
End Function

HAM CHR

Private Sub Command1_Click()
Dim MyChar
MyChar = Chr(65)
MyChar = Chr(97)
MyChar = Chr(62)
MyChar = Chr(37)
End Sub

HAM COS

Private Sub Command1_Click()
Dim MyAngle, MySecant
MyAngle = 1.3
MySecant = 1 / Cos(MyAngle)
MsgBox MySecant
End Sub

HAM CREATEOBJECT

Private Sub Command1_Click()
Dim Conn, Rst
Dim strData As String, strCon As String
Set Conn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")
strCon= "Provider=Microsoft.Jet.OLEDB.3.51;"
strCon=strConn &"Persist Security Info=False;"
strCon=strConn&"Data Source=C:\Northwind.mdb"
Conn.Open strCon
Rst.CursorLocation = 3
Rst.Open "Select * from Customers", Conn, 0, 3
If Rst.RecordCount > 0 Then
Rst.MoveFirst
Do Until Rst.EOF
strData = strData & Rst("CompanyName")
Rst.MoveNext
Loop
End If
Rst.Close
Conn.Close
Set Rst = Nothing
Set Conn = Nothing
End Sub

HAM CURDIR

Private Sub Command1_Click()
Dim strPath As String
strPath = CurDir()
MsgBox strPath
End Sub
Private Sub Command1_Click()
Dim strPath As String
strPath = App.Path()
MsgBox strPath
End Sub

HAM DATE

Private Sub Command1_Click()
MsgBox Date$
MsgBox Date
End Sub

HAM DATEADD

Private Sub Command1_Click()
Dim FirstDate As Date
Dim IntervalType As String
Dim Number As Integer
Dim Msg As String
IntervalType = "m"
FirstDate = Date
Number= _
InputBox("Enter number of months to add")
Msg = "New date: " & DateAdd(IntervalType, _
Number, FirstDate)
MsgBox Msg

IntervalType = "d"
Number = InputBox("Enter number of day to add")
Msg = "New date: " & DateAdd(IntervalType, _
Number, FirstDate)
MsgBox Msg
End Sub

HAM DATEDIFF

Dim TheDate As Date
Dim Msg
TheDate = InputBox("Enter a date")
Msg = "Days from today: " & _
DateDiff("d", Now, TheDate)
MsgBox Msg

HAM DATEPART

Dim TheDate As Date
Dim Msg
TheDate = InputBox("Enter a date")
Msg = "Quarter: " & DatePart("q", TheDate)
MsgBox Msg

HAM DATESERIAL

Private Sub Command1_Click()
Dim MyDate
MyDate = DateSerial(1969, 2, 12)
MsgBox MyDate
MyDate = DateSerial(1969, 35, 12)
MsgBox MyDate
MyDate = DateSerial(1990 - 10, 8 - 2, 1 - 1)
MsgBox MyDate
End Sub

HAM DATEVALUE

Private Sub Command1_Click()
Dim MyDate
MyDate = DateValue("February 12, 1969")
MsgBox MyDate
MyDate = DateValue("Feb 12, 1999")
MsgBox MyDate
MyDate = DateValue("25/12/2000")
MsgBox MyDate
MyDate = DateValue("28-12-2003")
MsgBox MyDate
MyDate = DateValue("28-Apr-2004") + 2
MsgBox MyDate
End Sub

HAM DAY

Private Sub Command1_Click()
Dim MyDate, MyDay
MyDate = #12/25/2004#
MyDay = Day(MyDate)
MsgBox MyDay
MyDate = #12/25/2004#
MyDay = Day(MyDate)
MsgBox MyDay
End Sub

HAM DDB

Private Sub Command1_Click()
Dim Fmt, InitCost, SalvageVal
Dim MonthLife, LifeTime
Dim DepYear, Depr
Const YRMOS = 12
Fmt = "###,##0.00"
InitCost = _
InputBox("Nhaäp trò giaù ban ñaàu cuûa taøi saûn?")
SalvageVal = _
InputBox("Nhaäp trò giaù cuoái cuøng cuûa taøi saûn.")
MonthLife = _
InputBox("Nhaäp trò giaù thaùng söû duïng?")
Do While MonthLife < YRMOS
MsgBox " THôøi gian cuûa taøi saûn phaûi treân 1 naêm."
MonthLife = _
InputBox("Nhaäp trò giaù thaùng söû duïng?")
Loop
LifeTime = MonthLife / YRMOS
If LifeTime <> Int(MonthLife / YRMOS) Then
LifeTime = Int(LifeTime + 1)
End If
DepYear = _
CInt(InputBox("Nhaäp soá naêm tính khaáu hao."))
Do While DepYear < 1 Or DepYear > LifeTime
MsgBox "Baïn phaûi nhaäp ít nhaát 1 " & _
" naêm nhöng khoâng lôùn hôn " & LifeTime
DepYear = _
InputBox("Nhaäp soá naêm tính khaáu hao.")
Loop
Depr = DDB(InitCost, SalvageVal, _
LifeTime, DepYear)
MsgBox "Khaáu hao laø " & _
DepYear & " is " & Format(Depr, Fmt) & "."
End Sub

HAM DIR

Private Sub Command1_Click()
Dim MyFile, MyPath, MyName
MyPath = "c:\"
If MyName <> "." And MyName <> ".." Then
If (GetAttr(MyPath & MyName) And
vbDirectory) = vbDirectory Then
Debug.Print MyName
End If
End If
MyName = Dir
Loop
End Sub

HAM DOEVENTS

Private Sub Command1_Click()
Form2.Show
Dim I, OpenForms
For I = 1 To 150000
If I Mod 1000 = 0 Then

OpenForms = DoEvents
End If
Next I

MsgBox OpenForms
End Sub

HAM ENVIRON

Private Sub Command1_Click()
Dim EnvString, Indx, Msg, PathLen

Indx = 1

Do
EnvString = Environ(Indx)

If Left(EnvString, 5) = "PATH=" Then

PathLen = Len(Environ("PATH"))
Msg = "PATH entry = " & Indx & _
" and length = " & PathLen
Exit Do
Else
Indx = Indx + 1

End If
Loop Until EnvString = ""
If PathLen > 0 Then
MsgBox Msg

Else
MsgBox "No PATH environment variable exists."
End If
End Sub

HAM EOF

Private Sub Command1_Click()
Dim InputData
Open "C:\arrays.cs" For Input As #1

Do While Not EOF(1)

Line Input #1, InputData

Debug.Print InputData
Loop

Close #1
End Sub

HAM ERROR

Private Sub Command1_Click()
On Error Goto myErr
Dim InputData

Open "C:\arrays.cs" For Input As #1

Do While Not EOF(1)

Line Input #1, InputData

Debug.Print InputData
Loop

Close #1
Exit Sub
myErr:

Debug.Print Error(Err.Number)

End Sub

HAM EXP

Private Sub Command1_Click()
Dim MyAngle, MyHSin

MyAngle = 1.3

MyHSin = (Exp(MyAngle) - Exp(-1 * MyAngle)) / 2
MsgBox MyHSin
End Sub

HAM FILEATTR

Private Sub Command1_Click()
On Error Resume Next
Dim FileNum, Mode, Handle
FileNum = 1

Open "C:\arrays.cs" For Append As FileNum

Mode = FileAttr(FileNum, 1)

Handle = FileAttr(FileNum, 2)

Close FileNum

MsgBox Handle
MsgBox Mode
End Sub

HAM FILEDATETIME

Private Sub Command1_Click()
On Error Resume Next
Dim MyStamp

MyStamp = FileDateTime("C:\AUTOEXEC.BAT")

MsgBox MyStamp
End Sub

HAM FILELEN
Private Sub Command1_Click()
On Error Resume Next
Dim MySize
MySize = FileLen("C:\logo_RCV.gif")

MsgBox MySize
End Sub

HAM FORMAT

Private Sub Command1_Click()
On Error Resume Next
Dim MyTime, MyDate, MyStr
MyTime = #5:04:23 PM#
MyDate = #1/27/1993#

MyStr = Format(Time, "Long Time")
MsgBox MyStr

MyStr = Format(Date, "Long Date")
MsgBox MyStr
MyStr = Format(MyTime, "h:m:s")

MsgBox MyStr
MyStr = Format(MyTime, "hh:mm:ss AMPM")

MsgBox MyStr
MyStr = Format(MyDate, "dddd, mmm d yyyy")

MsgBox MyStr

MyStr = Format(23)

MsgBox MyStr

MyStr = Format(5459.4, "##,##0.00")

MsgBox MyStr
MyStr = Format(334.9, "###0.00")
MsgBox MyStr
MyStr = Format(5, "0.00%")

MsgBox MyStr
MyStr = Format("HELLO", "<")

MsgBox MyStr
MyStr = Format("This is it", ">")

MsgBox MyStr
End Sub

HAM FORMATCURRENCY

Private Sub Command1_Click()
On Error Resume Next
Dim cr, st

cr = 100000.23

st = FormatCurrency(cr, 2, vbTrue)

MsgBox st
cr = 0.23
st = FormatCurrency(cr, 2, vbFalse)

MsgBox st
st = FormatCurrency(cr, 2, vbTrue)

MsgBox st
cr = -100000.23
st = FormatCurrency(cr, 2, vbTrue, vbTrue)

MsgBox st
st = FormatCurrency(cr, 2, vbTrue, vbFalse)

MsgBox st
st = _
FormatCurrency(cr,2,vbTrue,vbFalse,vbTrue)

MsgBox st
st = _
FormatCurrency(cr,2,vbTrue,vbFalse,vbFalse)

MsgBox st
End Sub

HAM FORMATDATETIME

Private Sub Command1_Click()
On Error Resume Next
Dim dstr, st
dstr = Date
st = FormatDateTime(dstr, vbGeneralDate)

MsgBox st
st = FormatDateTime(dstr, vbLongDate)

MsgBox st
st = FormatDateTime(dstr, vbLongTime)

MsgBox st
st = FormatDateTime(dstr, vbShortDate)

MsgBox st
st = FormatDateTime(dstr, vbShortTime)

MsgBox st
End Sub

HAM FORMATNUMBER


Private Sub Command1_Click()
On Error Resume Next
Dim cr, st
cr = 100000.23

st = FormatNumber(cr, 2, vbTrue)

MsgBox st
cr = 0.23
st = FormatNumber(cr, 2, vbFalse)

MsgBox st
st = FormatNumber(cr, 2, vbTrue)

MsgBox st
cr = -100000.23
st = FormatNumber(cr, 2, vbTrue, vbTrue)

MsgBox st
st = FormatNumber(cr, 2, vbTrue, vbFalse)

MsgBox st
st = _
FormatNumber(cr, 2, vbTrue, vbFalse, vbTrue)

MsgBox st
st = _
FormatNumber(cr, 2, vbTrue, vbFalse, vbFalse)

MsgBox st
End Sub

HAM FORMATPERCENT


Private Sub Command1_Click()
On Error Resume Next
Dim cr, st

cr = 0.215

st = FormatPercent (cr, 2, vbTrue)

MsgBox st
cr = 0.035
st = FormatPercent (cr, 2, vbFalse)

MsgBox st
st = FormatPercent (cr, 2, vbTrue)

MsgBox st
cr = -0.3
st = FormatNumber(cr, 2, vbTrue, vbTrue)

MsgBox st
st = FormatPercent (cr, 2, vbTrue, vbFalse)

MsgBox st
st = FormatPercent (cr, 2, _
vbTrue, vbFalse, vbTrue)

MsgBox st
st = FormatPercent (cr, 2, _
vbTrue, vbFalse, vbFalse)

MsgBox st
End Sub

HAM FREEFILE

Private Sub Command1_Click()
On Error Resume Next
Dim MyIndex, FileNumber
For MyIndex = 1 To 5

FileNumber = FreeFile

Open "TEST" & _
MyIndex For Output As #FileNumber

Write #FileNumber, "This is a sample."

Close #FileNumber

Next MyIndex
End Sub

HAM FV
Private Sub Command1_Click()
On Error Resume Next
Dim Fmt, Payment, APR, TotPmts
Dim PayType, PVal, FVal

Const ENDPERIOD = 0, BEGINPERIOD = 1

Fmt = "###,###,##0.00"

Payment = InputBox("Moãi thaùng göûi bao nhieâu ?”)

APR = InputBox("Laõi suaát tieàn göûi.")
If APR > 1 Then APR = APR / 100

TotPmts = InputBox("Soá thaùng göûi")

PayType = MsgBox("Göû tieàn vaøo cuoái thaùng?", _
vbYesNo)
If PayType = vbNo Then
PayType = BEGINPERIOD
Else
PayType = ENDPERIOD
End If

PVal = InputBox("Soá tieàn hieän haønh")

FVal = FV(APR / 12, TotPmts, -Payment, -PVal, _
PayType)
MsgBox "Tieàn seõ nhaän ñöôïc trong töông lai " & _
Format(FVal, Fmt) & "."
End Sub

HAM GETALLSETTINGS

Private Sub Command1_Click()
On Error Resume Next


Dim MySet As Variant
Dim intSettings As Integer

SaveSetting appname:="MyApp", _
section:="Startup", _
Key:="Top", setting:=75

SaveSetting "MyApp", "Startup", "Left", 50

MySet = GetAllSettings( _
appname:="MyApp", section:="Startup")

For intSettings = _
LBound(MySet, 1) To UBound(MySet, 1)
Debug.Print MySet (intSettings, 0), _
MySettings(intSettings, 1)
Next intSettings

DeleteSetting "MyApp", "Startup"
End Sub

HAM GETATTR


Private Sub Command1_Click()
On Error Resume Next
Dim MyAttr

MyAttr = GetAttr("TESTFILE")

Debug.Print MyAttr And vbHidden


MyAttr = GetAttr("TESTFILE")

Debug.Print MyAttr And (vbHidden + vbReadOnly)


MyAttr = GetAttr("MYDIR")

Debug.Print MyAttr
End Sub

HAM GETAUTOSERVERSETTINGS

Private Sub Command1_Click()
On Error Resume Next

Dim oRegClass As New RegClass
Dim vRC As Variant
vRC = oRegClass.GetAutoServerSettings _
("HelloProj.HelloClass")
If Not (IsEmpty(vRC)) Then
If vRC(1) Then
MsgBox "Hello is registered remotely on a " _
& "server named: " & vRC(1)
Else
MsgBox "Hello is registered locally."
End If
End If
End Sub

HAM GETSETTING


Private Sub Command1_Click()
On Error Resume Next

SaveSetting appname:="MyApp", _
section:="Startup", _
Key:="Top", setting:=75

SaveSetting "MyApp", "Startup", "Left", 50

Debug.Print GetSetting(appname := "MyApp", _
section := "Startup", _ key := "Left", _
default := "25")

DeleteSetting "MyApp", "Startup"
End Sub

HAM HEX


Private Sub Command1_Click()
On Error Resume Next
Dim MyHex
MyHex = Hex(5)

MyHex = Hex(10)

MyHex = Hex(459)

End Sub

HAM HOUR


Private Sub Command1_Click()
On Error Resume Next
Dim MyTime, MyHour
MyTime = #4:35:17 PM#

MyHour = Hour(MyTime)

End Sub

HAM IIF

Private Sub Command1_Click()
result = CheckIt(5000)
End Function
Function CheckIt(TestMe As Integer)
CheckIt = IIf(TestMe > 1000, "Large", "Small")
End Function

HAM INPUT


Private Sub Command1_Click()
Dim MyChar

Open "TESTFILE" For Input As #1

Do While Not EOF(1)

MyChar = Input(1, #1)

Debug.Print MyChar
Loop

Close #1
End Function

HAM INPUTBOX


Private Sub Command1_Click()
Dim Message, Title, Default, MyValue

Message = "Enter a value between 1 and 3"

Title = "InputBox Demo"

Default = "1"

MyValue = InputBox(Message, Title, Default)


MyValue = InputBox(Message, Title, , , , _
"DEMO.HLP", 10)


MyValue = InputBox(Message, Title, Default, 100, 100)
End Sub

HAM INSTR


Private Sub Command1_Click()
Dim SearchString, SearchChar, MyPos

SearchString = "http://www.huukhang.com"

SearchChar = "h"

MyPos = InStr(13, SearchString, SearchChar, 1)

MyPos = InStr(2, SearchString, SearchChar, 0)


MyPos = InStr(SearchString, SearchChar)

MyPos = InStr(1, SearchString, "W")

End Sub

HAM INSTRREV


Private Sub Command1_Click()
Dim StrCheck, StrMatch, MyPos

StrCheck = "phamhuukhang"

StrMatch = "h"
MyPos = InStrRev(StrCheck, StrMatch, 4, 1)

MsgBox MyPos
MyPos = InStrRev(StrCheck, StrMatch, 6, 1)

MsgBox MyPos
MyPos = InStrRev(StrCheck, StrMatch, 10, 1)

MsgBox MyPos
End Sub

HAM INT VAØ FIX

Private Sub Command1_Click()
Dim MyNumber
MyNumber = Int(99.8)

MyNumber = Fix(99.2)


MyNumber = Int(-99.8)

MyNumber = Fix(-99.8)

MyNumber = Int(-99.2)

MyNumber = Fix(-99.2)

End Sub


HAM IPMT

Private Sub Command1_Click()
On Error Resume Next
Dim FVal, Fmt, PVal, APR, TotPmts, PayType
Dim Period, IntPmt, TotInt, Msg
Const ENDPERIOD = 0, BEGINPERIOD = 1

FVal = 0

Fmt = "###,###,##0.00"

PVal = InputBox( _
"Soá tieàn baïn vay?")
APR = _
InputBox("Tyû giaù töøng kyø traû?")
If APR > 1 Then APR = APR / 100

TotPmts = InputBox("Soá thaùng caàn traû?")
PayType = MsgBox("Baïn muoán traû cuoái thaùng?", _
vbYesNo)
If PayType = vbNo Then
PayType = BEGINPERIOD
Else
PayType = ENDPERIOD
End If
For Period = 1 To TotPmts

IntPmt = IPmt(APR / 12, Period, TotPmts, _
-PVal, FVal, PayType)
TotInt = TotInt + IntPmt
Next Period
Msg = _
Format(TotInt, Fmt)
Msg = Msg & " in interest for this loan."
MsgBox Msg

End Sub

HAM ISARRAY

Private Sub Command1_Click()
On Error Resume Next

Dim MyArray(1 To 5) As Integer

Dim YourArray, MyCheck

YourArray = Array(1, 2, 3)

MyCheck = IsArray(MyArray)

MyCheck = IsArray(YourArray)

End Sub

HAM ISDATE


Private Sub Command1_Click()
On Error Resume Next
Dim MyDate, YourDate, NoDate, MyCheck
MyDate = "February 12, 1969"
YourDate = #2/12/1969#
NoDate = "Hello"
MyCheck = IsDate(MyDate)

MyCheck = IsDate(YourDate)

MyCheck = IsDate(NoDate)

End Sub

HAM ISEMPTY

Private Sub Command1_Click()
On Error Resume Next
Dim MyVar, MyCheck
MyCheck = IsEmpty(MyVar)

MyVar = Null

MyCheck = IsEmpty(MyVar)

MyVar = Empty

MyCheck = IsEmpty(MyVar)

End Sub

HAM ISERROR

Private Sub Command1_Click()
On Error Resume Next
Dim ReturnVal, MyCheck
UserFunction = CVErr(32767)
ReturnVal = UserFunction
MyCheck = IsError(ReturnVal)

End Sub

HAM ISNULL

Private Sub Command1_Click()
On Error Resume Next
Dim MyVar, MyCheck
MyCheck = IsNull(MyVar)
MyVar = ""
MyCheck = IsNull(MyVar)

MyVar = Null
MyCheck = IsNull(MyVar)

End Sub

HAM ISNUMERIC

Private Sub Command1_Click()
On Error Resume Next
Dim MyVar, MyCheck
MyVar = "53"

MyCheck = IsNumeric(MyVar)

MyVar = "459.95"
MyCheck = IsNumeric(MyVar)

MyVar = "45 Help"

MyCheck = IsNumeric(MyVar)

End Sub

HAM ISOBJECT

Private Sub Command1_Click()
Dim MyInt As Integer, YourObject, MyCheck

Dim MyObject As Object
Set YourObject = MyObject

MyCheck = IsObject(YourObject)

MyCheck = IsObject(MyInt)

End Sub

HAM JOIN


Private Sub Command1_Click()
Dim MyWeek, MyDay
MyWeek = Array("Mon","Tue","Wed","Thu", "Fri",
"Sat", "Sun")
MyDay = Join(MyWeek)

MsgBox MyDay
MyDay = Join(MyWeek, ",")

MsgBox MyDay
End Sub

HAM LBOUND

Private Sub Command1_Click()
Dim MyWeek, MinElement
MyWeek = Array("Mon", "Tue", "Wed", "Thu", _
"Fri", "Sat", "Sun")
MinElement = LBound(MyWeek)

MsgBox MinElement
Dim A(1 To 100, 0 To 3, -3 To 4)
MinElement = LBound(A)

MsgBox MinElement
MinElement = LBound(A, 1)

MsgBox MinElement
MinElement = LBound(A, 2)

MsgBox MinElement
MinElement = LBound(A, 3)

MsgBox MinElement
End Sub

HAM LCASE

Private Sub Command1_Click()
Dim UpperCase, LowerCase
UpperCase = "Hello HuuKhang.COM"

LowerCase = LCase(UpperCase)

MsgBox LowerCase
End Sub

HAM LEFT

Private Sub Command1_Click()
Dim AnyString, MyStr
AnyString = "Hello World"

MyStr = Left(AnyString, 1)

MsgBox MyStr
MyStr = Left(AnyString, 7)

MsgBox MyStr
MyStr = Left(AnyString, 20)

MsgBox MyStr
End Sub

HAM LEN

Private Sub Command1_Click()
Type CustomerRecord

ID As Integer

Name As String * 10

Address As String * 30
End Type

Dim Customer As CustomerRecord

Dim MyInt As Integer, MyCur As Currency
Dim MyString, MyLen
MyString = "Hello World"

MyLen = Len(MyInt)

MyLen = Len(Customer)

MyLen = Len(MyString)

MyLen = Len(MyCur)

End Sub

HAM LOADPICTURE

Private Sub Command1_Click()
Dim Msg As String

On Error Resume Next

Height = 3990
Width = 4890
Picture1.Picture = _
LoadPicture("PAPER.CUR", vbLPCustom, _
vbLPColor, 32, 32)

If Err Then
MsgBox Msg
Exit Sub

End If

Msg = "Choose OK to clear the bitmap from the picturebox."
MsgBox Msg
Picture1.Picture = LoadPicture()

End Sub

HAM LOC

Private Sub Command1_Click()
Dim MyLocation, MyLine
Open "TESTFILE" For Binary As #1

Do While MyLocation < LOF(1)

MyLine = MyLine & Input(1, #1)

MyLocation = Loc(1)

Debug.Print MyLine; Tab; MyLocation
Loop
Close #1

End Sub

HAM LOF

Private Sub Command1_Click()
Dim FileLength
Open "TESTFILE" For Input As #1

FileLength = LOF(1)

Close #1

End Sub

HAM LOG

Private Sub Command1_Click()
Dim MyAngle, MyLog

MyAngle = 1.3

MyLog = _
Log(MyAngle + Sqr(MyAngle * MyAngle + 1))
End Sub

HAM LTRIM, RTRIM, TRIM


Private Sub Command1_Click()
Dim MyString, TrimString
MyString = " <-Trim-> "

TrimString = LTrim(MyString)

TrimString = RTrim(MyString)

TrimString = LTrim(RTrim(MyString))


TrimString = Trim(MyString)

End Sub

HAM MID

Private Sub Command1_Click()
Dim AnyString, MyStr
AnyString = "Hello World"

MyStr = Mid(AnyString, 7,1)

MsgBox MyStr
MyStr = Mid(AnyString, 7,6)

MsgBox MyStr
MyStr = Mid(AnyString, 7)

MsgBox MyStr
End Sub

HAM MINUTE

Private Sub Command1_Click()
On Error Resume Next
Dim MyTime, MyMinute
MyTime = #4:35:17 PM#

MyMinute = Minute(MyTime)

End Sub

HAM MONTH

Private Sub Command1_Click()
Dim MyDate, MyMonth
MyDate = #11/25/2004#
MyMonth = Month(MyDate)
MsgBox MyMonth
MyDate = #12/25/2004#

MyMonth = Month(MyDate)

MsgBox MyMonth
End Sub

HAM MONTHNAME

Private Sub Command1_Click()
Dim MyDate, MyMonth
MyDate = #11/25/2004#
MyMonth = MonthName(Month(MyDate))
MsgBox MyMonth
MyDate = #12/25/2004#
MyMonth = MonthName(Month(MyDate), True)

MsgBox MyMonth
End Sub

HAM MSGBOX

Private Sub Command1_Click()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you want to continue ?"

Style = vbYesNo + vbCritical + vbDefaultButton2

Title = "MsgBox Demonstration"

Help = "DEMO.HLP"

Ctxt = 1000
Response = _
MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then

MyString = "Yes"
Else

MyString = "No"
End If
End Sub

HAM NOW

Private Sub Command1_Click()
Dim myCurrTime
myCurrTime = Now
MsgBox myCurrTime
End Sub

HAM NPER

Dim FVal, PVal, APR, Payment
Dim PayType, TotPmts
Const ENDPERIOD = 0, BEGINPERIOD = 1
FVal = 0

PVal = InputBox("Soá tieàn baïn caàn vay?")
APR = InputBox("Tyû giaù?")
If APR > 1 Then APR = APR / 100

Payment = _
InputBox("Traû bao nhieâu trong moät thaùng?")
PayType = MsgBox("Traû vaøo cuoái thaùng?", _
vbYesNo)
If PayType = vbNo Then
PayType = BEGINPERIOD
Else
PayType = ENDPERIOD
End If

TotPmts = _
NPer(APR / 12, -Payment, PVal, FVal, PayType)
If Int(TotPmts) <> TotPmts Then
TotPmts = Int(TotPmts) + 1
End If
MsgBox "Baûn phaûi " & TotPmts & " thaùng."

HAM NPV

Private Sub Command1_Click()
Dim Fmt, Guess, RetRate, NetPVal, Msg

Static Values(5) As Double
Fmt = "###,##0.00"
RetRate = 0.0625

Values(0) = -70000

Values(1) = 22000
Values(2) = 25000
Values(3) = 28000
Values(4) = 31000
NetPVal = NPV(RetRate, Values())

Msg = "NPV laø "
Msg = Msg & Format(NetPVal, Fmt) & "."
MsgBox Msg
End Sub

HAM OCT

Private Sub Command1_Click()
Dim MyOct
MyOct = Oct(4)

MyOct = Oct(8)
MyOct = Oct(459)

End Sub

HAM PMT

Private Sub Command1_Click()
Dim Fmt, FVal, PVal, APR, TotPmts
Dim PayType, Payment
Const ENDPERIOD = 0, BEGINPERIOD = 1
Fmt = "###,###,##0.00"
FVal = 0
PVal = InputBox("Soá tieàn vay?")
APR = InputBox("Laõi suaát?")
If APR > 1 Then APR = APR / 100
TotPmts = InputBox("Traû bao nhieâu thaùng?")
PayType = MsgBox("Traû vaøo cuoái thaùng", vbYesNo)
If PayType = vbNo Then
PayType = BEGINPERIOD
Else
PayType = ENDPERIOD
End If
Payment = Pmt(APR / 12, TotPmts, -PVal, _
FVal, PayType)
MsgBox "Baïn phaûi traû " & _
Format(Payment, Fmt) & " cho moãi thaùng."
End Sub

HAM PPMT

Private Sub Command1_Click()
Dim NL, TB, Fmt, FVal, PVal, APR
Dim TotPmts, PayType, Payment
Dim Msg, MakeChart, Period, P, I
Const ENDPERIOD = 0, BEGINPERIOD = 1

NL = Chr(13) & Chr(10)

TB = Chr(9)

Fmt = "###,###,##0.00"
FVal = 0
PVal = InputBox("Soá tieàn vay?")
APR = InputBox("Laõi suaát?")
If APR > 1 Then APR = APR / 100
TotPmts = InputBox("Traû bao nhieâu thaùng?")
PayType = MsgBox("Traû vaøo cuoái thaùng?", _
vbYesNo)
If PayType = vbNo Then
PayType = BEGINPERIOD
Else
PayType = ENDPERIOD
End If
Payment = Abs(-Pmt(APR / 12, TotPmts, PVal, _
FVal, PayType))

Msg = "Traû haøng thaùng " & _
Format(Payment, Fmt) & ". "
Msg = Msg & "Tính soá tieàn goác?"
MakeChart = MsgBox(Msg, vbYesNo)
If MakeChart <> vbNo Then
If TotPmts > 12 Then
MsgBox "Only first year will be shown."
Msg = "Month Payment Principal Interest" & NL
For Period = 1 To TotPmts
If Period > 12 Then Exit For

P = PPmt(APR / 12, Period, TotPmts, _
-PVal, FVal, PayType)
P = (Int((P + 0.005) * 100) / 100)

I = Payment - P
I = (Int((I + 0.005) * 100) / 100)

Msg = Msg & Period & TB & Format(Payment, Fmt)
Msg = Msg & TB & Format(P, Fmt) & TB & _
Format(I, Fmt) & NL
Next Period
MsgBox Msg
End If
End Sub

HAM PV

Private Sub Command1_Click()
Dim Fmt, APR, TotPmts, YrIncome
Dim FVal, PayType, PVal
Const ENDPERIOD = 0, BEGINPERIOD = 1
Fmt = "###,##0.00"
APR = 0.1

TotPmts = 12

YrIncome = 50000

FVal = 1000000

PayType = BEGINPERIOD

PVal = PV(APR, TotPmts, -YrIncome, _
FVal, PayType)
MsgBox "Giaù trò töông lai laø " & _
Format(PVal, Fmt) & "."
End Sub

HAM QBCOLOR


Sub ChangeBackColor(ColorCode As Integer, MyForm As Form)
MyForm.BackColor = QBColor(ColorCode)
End Sub

HAM RATE

Private Sub Command1_Click()
Dim Fmt, FVal, Guess, PVal
Dim Payment, TotPmts, PayType, APR
Const ENDPERIOD = 0, BEGINPERIOD = 1

FVal = 0
Guess = 0.1
PVal = InputBox("Baïn vay bao nhieâu?")
Payment = InputBox("Traû bao nhieâu thaùng?")
TotPmts = InputBox("Moi thang tra bao nhieu?")
PayType = MsgBox("Traû vaøo cuoái thaùng?", _
vbYesNo)
If PayType = vbNo Then
PayType = BEGINPERIOD
Else
PayType = ENDPERIOD
End If
APR = (Rate(TotPmts, -Payment, PVal, _
FVal, PayType, Guess) * 12) * 100
MsgBox "Laõi suaát laø " & _
Format(CInt(APR), Fmt) & " percent."
End Sub

HAM REPLACE

Private Sub Command1_Click()
Dim strSQL As String
strSQL = "Insert into Shippers"
End Sub

HAM RGB

Private Sub Command1_Click()
Dim RED, I, RGBValue, MyObject
RED = RGB(255, 0, 0)

I = 75

RGBValue = RGB(I, 64 + I, 128 + I)

MyObject.Color = RGB(255, 0, 0)

End Sub

HAM RIGHT

Private Sub Command1_Click()
Dim AnyString, MyStr
AnyString = "Hello World"

MyStr = Right(AnyString, 1)

MsgBox MyStr
MyStr = Right(AnyString, 7)
MsgBox MyStr
MyStr = Right(AnyString, 20)

MsgBox MyStr
End Sub

HAM RND

Private Sub Command1_Click()
For I = 1 To 100
Randomize (I)
Debug.Print Rnd(I)
Next I
End Sub

HAM ROUND

Private Sub Command1_Click()
Dim Amount
Amount = 15.1464
MsgBox Round(Amount, 3)

MsgBox Round(Amount, 2)

End Sub

HAM SECOND

Private Sub Command1_Click()
On Error Resume Next
Dim MyTime, MyMinute
MyTime = #4:35:17 PM#
MyMinute = Second(MyTime)
End Sub

HAM SEEK

Private Sub Command1_Click()
Dim MyChar
Open "D:\Csharp\arrays.cs" For Input As #1

Do While Not EOF(1)

MyChar = Input(1, #1)

Debug.Print Seek(1)

Loop
Close #1
End Sub

HAM SGN

Private Sub Command1_Click()
Dim MyVar1, MyVar2, MyVar3, MySign
MyVar1 = 12: MyVar2 = -2.4: MyVar3 = 0
MySign = Sgn(MyVar1)

MySign = Sgn(MyVar2)

MySign = Sgn(MyVar3)

End Sub

HAM SHELL

Private Sub Command1_Click()

Dim RetVal
RetVal = Shell("C:\WINDOWS\CALC.EXE", 1)

End Sub

HAM SIN

Private Sub Command1_Click()
Dim MyAngle, MySecant
MyAngle = 1.3

MySecant = 1 / Sin(MyAngle)

MsgBox MySecant
End Sub

HAM SLN

Private Sub Command1_Click()
Dim Fmt, InitCost, SalvageVal
Dim MonthLife, LifeTime, PDepr
Const YEARMONTHS = 12

Fmt = "###,##0.00"

InitCost=InputBox("Giaù trò ban ñaàu cuûa TS?")
SalvageVal=InputBox("Giaù trò coøn laïi cuûa TS?")
MonthLife = InputBox("Soá thaùng tính khaáu hao?")
Do While MonthLife < YEARMONTHS

MsgBox "Soá thaùng lôùn hôn vaø baèng 1 naêm."
MonthLife= _
InputBox("Soá thaùng tính khaàu hao?")
Loop
LifeTime = MonthLife / YEARMONTHS

If LifeTime <> Int(MonthLife / YEARMONTHS) Then
LifeTime = Int(LifeTime + 1)

End If
PDepr = SLN(InitCost, SalvageVal, LifeTime)
MsgBox "Giaù trò khaáu hao laø " & _
Format(PDepr, Fmt) & " per year."
End Sub

HAM SPACE

Private Sub Command1_Click()
Dim MyString

MyString = Space(10)

MyString = "Hello" & Space(10) & "World"
End Sub

HAM SPLIT

Private Sub Command1_Click()
Dim myString As String
Dim MyArr() As String
Dim MyArrs() As String
Dim i As Integer
myString = "Welcome to Saigon"

MyArr = Split(myString)

For i = 0 To UBound(MyArr)
Debug.Print MyArr(i)
Next

myString = "Xin,chao,cac,ban"
MyArrs = Split(myString, ",", 1)
For i = 0 To UBound(MyArrs)
Debug.Print MyArrs(i)
Next
End Sub

HAM SQR

Private Sub Command1_Click()
Dim MySqr
MySqr = Sqr(4)

MySqr = Sqr(23)

MySqr = Sqr(0)

MySqr = Sqr(-4)

End Sub

HAM STR

Private Sub Command1_Click()
Dim MyString
MyString = Str(459)
MyString = Str(-459.65)
MyString = Str(459.001)
End Sub

HAM STRCONV


Private Sub Command1_Click()
Dim i As Long
Dim x() As Byte
x = StrConv("ABCDEFG", vbFromUnicode)

For i = 0 To UBound(x)
Debug.Print x(i)
Next
End Sub

HAM STRING

Private Sub Command1_Click()
Dim MyString As String
MyString = String(5, "*")
Debug.Print MyString

MyString = String(5, 42)
Debug.Print MyString

MyString = String(10, "ABC")
Debug.Print MyString

End Sub


Private Sub Command1_Click()
Dim MyString As String
MyString = "ABC"
MyString = StrReverse(MyString)
Debug.Print MyString

End Sub

HAM SYD


Private Sub Command1_Click()
Dim Fmt, InitCost, SalvageVal
Dim MonthLife, LifeTime, DepYear, PDepr
Const YEARMONTHS = 12

Fmt = "###,##0.00"

InitCost= _
InputBox("Giaù trò ban ñaàu cuûa taøi saûn?")
SalvageVal = _
InputBox (Giaù trò coøn laïi cuûa taøi saûn sau khi
keát thuùc thôøi kyø khaáu hao?")
MonthLife = InputBox("Soá thaùng tính khaáu hao?")
Do While MonthLife < YEARMONTHS

MsgBox "Ñôøi soáng cuûa taøi saûn laø 1 naêm hay lôùn
hôn."
MonthLife = _
InputBox("Soá thaùng tính khaáu hao?")
Loop
LifeTime = MonthLife / YEARMONTHS

If LifeTime <> Int(MonthLife / YEARMONTHS) Then
LifeTime = Int(LifeTime + 1)
End If
DepYear = _
CInt(InputBox("Giaù trò khaáu hao cuûa naêm?"))
Do While DepYear < 1 Or DepYear > LifeTime
MsgBox “Ñôøi soáng cuûa taøi saûn laø 1 naêm hay lôùn
hôn " & LifeTime
DepYear = _
CInt(InputBox("Giaù trò khaáu hao cuûa naêm?"))
Loop
PDepr = _
SYD(InitCost, SalvageVal, LifeTime, DepYear)
MsgBox "Khaáu hao naêm " & DepYear & " laø " & _
Format(PDepr, Fmt) & "."
End Sub

HAM TAB

Private Sub Command1_Click()

Open "C:\TESTFILE.txt" For Output As #1

Print #1, "Hello"; Tab(20); "World."

Print #1, "Hello"; Tab; "World"
Close #1

End Sub

HAM TAN

Private Sub Command1_Click()
Dim MyAngle, MyCotangent
MyAngle = 1.3
MyCotangent = 1 / Tan(MyAngle)

End Sub

HAM TIME

Private Sub Command1_Click()
Dim MyTime
MyTime = Time

End Sub

HAM TIMESERIAL

Private Sub Command1_Click()
Dim MyTime
MyTime = TimeSerial(16, 35, 17)
Debug.Print MyTime

MyTime = TimeSerial(19, -35, -17)
Debug.Print MyTime

End Sub

HAM TIMEVALUE

Private Sub Command1_Click()
Dim MyTime
MyTime = TimeValue("4:35:17 PM")
Debug.Print MyTime

MyTime = TimeValue("4:35:17 AM")
Debug.Print MyTime

End Sub

HAM TYPENAME

Private Sub Command1_Click()

Dim NullVar, MyType, StrVar As String
Dim IntVar As Integer, CurVar As Currency
Dim ArrayVar(1 To 5) As Integer
NullVar = Null

MyType = TypeName(StrVar)

MyType = TypeName(IntVar)

MyType = TypeName(CurVar)

MyType = TypeName(NullVar)

MyType = TypeName(ArrayVar)

End Sub

HAM UBOUND

Private Sub Command1_Click()
Dim Upper
Dim MyArray(1 To 10, 5 To 15, 10 To 20)

Dim AnyArray(10)
Upper = UBound(MyArray, 1)

Upper = UBound(MyArray, 3)

Upper = UBound(AnyArray)

End Sub

HAM UCASE


Private Sub Command1_Click()
Dim Upper
Dim MyString As String

MyString =”Hello World”
Upper = UCase(MyString)

End Sub

HAM VAL


Private Sub Command1_Click()
Dim MyValue
MyValue = Val("2457")+1
Debug.Print MyValue

MyValue = Val(" 2 45 7")
Debug.Print MyValue

MyValue = Val("24 and 57")
Debug.Print MyValue

MyValue = Val("A 24 and 57")
Debug.Print MyValue

MyValue = Val("")
Debug.Print MyValue

End Sub

HAM WEEKDAY

Private Sub Command1_Click()
Dim MyDate, MyWeekDay
MyDate = #2/12/1969#

MyWeekDay = Weekday(MyDate)
Debug.Print MyWeekDay

MyWeekDay = Weekday(Date)
Debug.Print MyWeekDay
End Sub

HAM WEEKDAYNAME

Private Sub Command1_Click()
Dim MyDate, MyWeekDay
MyWeekDay = 4
MyDate = WeekdayName(MyWeekDay)
Debug.Print MyDate
MyDate = WeekdayName(6, True)
Debug.Print MyDate
End Sub

HAM YEAR


Private Sub Command1_Click()
Dim MyDate, MyYear
MyDate = #2/12/2003#
MyYear = Year(MyDate)
Debug.Print MyDate
End Sub
Love mickey,
Đăng nhập để trả lời
0
KHAI BÁO


KHAI BAO APPACTIVATE

Private Sub Command1_Click()
Dim MyAppID, ReturnValue
AppActivate "Microsoft Word"
MyAppID = Shell("C:\WORD\WINWORD.EXE", 1)
AppActivate MyAppID
ReturnValue = Shell("c:\EXCEL\EXCEL.EXE", 1)
AppActivate ReturnValue
End Sub

KHAI BAO BEEP

Private Sub Command1_Click()
Dim Str As String
Str = "Welcome to huu khang . com"
Beep
End Sub

KHAI BAO CALL

Private Sub Command1_Click()
Dim str As String
str = " huu khang . com"
ABC()
Call ABCD(str)
Dim i As Integer
I=XYZ
End Sub

Sub ABC()
MsgBox "Welcome to huukhang.com"
End Sub

Sub ABCD(ByVal strname As String)
MsgBox " Welcome to " & strname
End Sub

Function XYZ() As Integer
XYZ = 10
End Function

KHAI BAO CHDIR

Private Sub Command1_Click()
ChDir "MYDIR"
ChDir "D:\WINDOWS\SYSTEM"
End Sub

KHAI BAO CHDRIVE

Private Sub Command1_Click()
ChDrive ""
ChDrive "D:\"
End Sub

KHAI BAO CLOSE

Private Sub Command1_Click()
Dim I, FileName
For I = 1 To 3
FileName = "TEST" & I
Open FileName For Output As #I
Print #I, "This is a test."
Next I
Close
End Sub


Function getDBInfo() As String
On Error GoTo err
Dim f As Integer
Dim strWord As String
f = FreeFile
Open App.Path & "\config.ini" For Input As f
Do While Not EOF(f)
Line Input #f, strWord
Loop
Close f
getDBInfo = strWord
Exit Function
err:
getDBInfo = Error
End Function

KHAI BAO CONST

Const MyVar = 459

Public Const MyString = "HELP"

Private Const MyInt As Integer = 5

Const MyStr = "Hello", MyDouble As Double = 3.4567

Private Const myBoolean As Boolean = True

Private Sub Command1_Click()
Debug.Print MyVar
Debug.Print MyInt
Debug.Print MyStr
Debug.Print MyDouble
Debug.Print MyString
End Sub

KHAI BAO DECLARE

Declare Function GetUserName Lib _
"advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Command1_Click()
Dim sbuf As String, nl As Integer
Dim Uname As String
sbuf = String$(10, 0)
nl = GetUserName(sbuf, 10)
Uname = UCase(sbuf)
If Uname <> "" Then
MsgBox ("Username: " & Uname)
End If
End Sub

KHAI BAO DELETESETTING

Private Sub Command1_Click()
SaveSetting appname:="huukhang.com", _
section:="Startup", Key:="Top", setting:=75
SaveSetting "huukhang.com", _
"Startup", "Left", 50
DeleteSetting "huukhang.com", "Startup"
End Sub

KHAI BAO DIM

Private Sub Command1_Click()
Dim AnyValue, MyValue

Dim Number As Integer

Dim AnotherVar, Choice As Boolean

Dim DayArray(50)

Dim Matrix(3, 4) As Integer

Dim MyMatrix(1 To 5, 4 To 9, 3 To 5) As Double

Dim BirthDay(1 To 10) As Date

Dim MyArray()
End Sub

KHAI BAO DO..LOOP

Private Sub Command1_Click()
Dim Check, Counter
Check = True: Counter = 0
Do
Do While Counter < 20
Counter = Counter + 1
Debug.Print Counter
If Counter = 10 Then
Check = False
Exit Do
End If
Loop
Loop Until Check = False
End Sub

KHAI BAO END

Private Sub Command1_Click()
Dim Password, Pword
Password = "123456"
Pword = InputBox("Type in your password")
If Pword <> Password Then
MsgBox "Sorry, incorrect password"
End
End If
End Sub

KHAI BAO ERASE


Private Sub Command1_Click()
Dim NumArray(10) As Integer
Dim StrVarArray(10) As String
Dim StrFixArray(10) As String * 10
Dim VarArray(10) As Variant
Dim DynamicArray() As Integer
ReDim DynamicArray(10)
Erase NumArray
Erase StrVarArray
Erase StrFixArray
Erase VarArray
Erase DynamicArray
End Sub

KHAI BAO ERROR
Private Sub Command1_Click()
On Error Resume Next
Error 11
Debug.Print Err.Description
Debug.Print Err.Source
Debug.Print Err.Number
End Sub

KHAI BAO EXIT
Private Sub Command1_Click()
Dim I, MyNum
Do
For I = 1 To 1000
MyNum = Int(Rnd * 1000)
Select Case MyNum
Case 7: Exit For
Case 29: Exit Do
Case 54: Exit Sub
End Select
Next I
Loop
End Sub

KHAI BAO FILECOPY

Private Sub Command1_Click()
Dim SourceFile, DestinationFile
SourceFile = "C:\CONFIG.SYS"
DestinationFile = "D:\CONFIG.SYS"
FileCopy SourceFile, DestinationFile
End Sub

KHAI BAO FOR EACH..NEXT

Private Sub Command1_Click()
Dim Found, MyObject, MyCollection
Found = False
For Each MyObject In MyCollection
If MyObject.Text = "Hello" Then
Found = True
Exit For
End If
Next
End Sub

KHAI BAO FOR..NEXT

Private Sub Command1_Click()
Dim Words, Chars, MyString
For Words = 10 To 1 Step -1
For Chars = 0 To 9
MyString = MyString & Chars
Next Chars
MyString = MyString & " "
Debug.Print MyString
Next Words
End Sub

KHAI BAO FUNCTION

Function CalculateSquareRoot( _
NumberArg As Double) As Double
If NumberArg < 0 Then
Exit Function
Else
CalculateSquareRoot = Sqr(NumberArg)
End If
End Function

Function CalSum (ByVal FirstArg As Integer, _
ParamArray OtherArgs()) As Integer
If FirstArg < 0 Then
Exit Function
Else
CalSum = FirstArg+Total
End If
End Function

Function MyFunc(MyArg As Integer, _
Optional MyArg1 As Integer = 5, _
Optional MyArg2 = 10) As Integer
MyFunc MyArg + MyArg1 + MyArg2
End Function

Private Sub Command1_Click()
Debug.Print CalculateSquareRoot(10)
Debug.Print CalSum(10, 1, 2, 3, 4, 5)
Dim RetVal
RetVal = MyFunc(1, 2, 2)
Debug.Print RetVal
RetVal = MyFunc(1, , 5)
Debug.Print RetVal
RetVal = MyFunc(MyArg:=10, MyArg2:=7)
Debug.Print RetVal
RetVal = MyFunc(1)
Debug.Print RetVal
End Sub

KHAI BAO GOTO

Private Sub Command1_Click()
Dim Number, MyString
Number = 1
If Number = 1 Then
GoTo Line1
Else
GoTo Line2
End If
Line1:
MyString = "Number equals 1"
GoTo LastLine
Line2:
MyString = "Number equals 2"
LastLine:
Debug.Print MyString
End Sub

PHAUT BIEU ¥IEAU KHIEN IF..THEN..ELSE..END IF

Private Sub Command1_Click()
Dim A, B, C
A = InputBox("Please enter value of A:")
If IsNumeric(A) Then A = A + 1: B = B + A: C = C + B
Debug.Print A
B = InputBox("Please enter value of B:")
If B > 0 Then
A = A + B
ElseIf B = 0 Then
A = A - B
Else
A = B
End If
End Sub

KHAI BAO INPUT #

Private Sub Command1_Click()
Dim MyString, MyNumber
Open "C:\TESTFILE.txt" For Input As #1
Do While Not EOF(1)
Input #1, MyString, MyNumber
Debug.Print MyString, MyNumber
Loop
Close #1
End Sub

KHAI BAO KILL

Private Sub Command1_Click()
Kill "C:\TestFile.txt"
Kill "C:\*.TXT"
End Sub

KHAI BAO LINE INPUT #

Private Sub Command1_Click()
Dim MyString
Open "C:\TESTFILE.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, MyString
Debug.Print MyString
Loop
Close #1
End Sub

KHAI BAO LOAD

Private Sub Command1_Click()
Dim Answer, Msg As String
Unload Form1
Msg = "Form1 ch”a na‹p. "
Msg = Msg & "Cho‹n Yes ¤e† na‹p vao hie†n th• form "
Msg = Msg & "CHo‹n No na‹p form vao khoƒng hie†n th•."
Answer = MsgBox(Msg, vbYesNo)
If Answer = vbYes Then
Show
Else
Load Form1
Msg = "Form1 ¤ao na‹p. "
Msg = Msg & "Cho‹n OK ¤e† hie†n th• form."
MsgBox Msg
Show
End If
End Sub

KHAI BAO LOCK, UNLOCK

Private Sub Command1_Click()
Dim MyRecord As Record, RecordNumber
Open "C:\TESTFILE.txt" For _
Random Shared As #1 Len = Len(MyRecord)
RecordNumber = 4
Lock #1, RecordNumber
Get #1, RecordNumber, MyRecord
MyRecord.ID = 234
MyRecord.Name = "John Smith"
Put #1, RecordNumber, MyRecord
Unlock #1, RecordNumber
Close #1
End Sub

KHAI BAO MID

Private Sub Command1_Click()
Dim MyString
MyString = "The dog jumps"
Debug.Print MyString
Mid(MyString, 5, 3) = "fox"
Debug.Print MyString
Mid(MyString, 5) = "cow"
Debug.Print MyString
Mid(MyString, 5) = "cow jumped over"
Debug.Print MyString
Mid(MyString, 5, 3) = "duck"
Debug.Print MyString
End Sub

KHAI BAO MKDIR

Private Sub Command1_Click()
Dim MyFolder
MyFolder = "C:\myVb6"
MkDir MyFolder
End Sub

KHAI BAO NAME


Private Sub Command1_Click()
Dim OldName, NewName
OldName = "OLDFILE": NewName = "NEWFILE"
Name OldName As NewName
OldName = "C:\MYDIR\OLDFILE"
NewName = "C:\YOURDIR\NEWFILE"
Name OldName As NewName
End Sub

KHAI BAO ON ERROR

Private Sub Command1_Click()
On Error GoTo ErrorHandler
Open "TESTFILE" For Output As #1
Kill "TESTFILE"
On Error GoTo 0
On Error Resume Next
ObjectRef = GetObject("MyWord.Basic")
If err.Number = 440 Or err.Number = 432 Then
Msg = "There was an error attempting to open "
Msg = Msg & "the Automation object!"
MsgBox Msg, , "Deferred Error Test"
err.Clear
End If
Exit Sub
ErrorHandler:
Select Case err.Number
Case 55
Close #1
Case Else
End Select
Resume
End Sub

KHAI BAO OPEN

Private Sub Command1_Click()
Dim MyString
Open "C:\TESTFILE.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, MyString
Debug.Print MyString
Loop
Close #1
End Sub

KHAI BAO OPTION BASE

Option Base 1

Private Sub Command1_Click()
Dim Lower
Dim MyArray(20), TwoDArray(3, 4)
Dim ZeroArray(0 To 5)
Lower = LBound(MyArray)
Debug.Print Lower
Lower = LBound(TwoDArray, 1)
Debug.Print Lower
Lower = LBound(TwoDArray, 2)
Debug.Print Lower
Lower = LBound(ZeroArray)
Debug.Print Lower
End Sub

KHAI BAO PRINT #


Private Sub Command1_Click()
Open "TESTFILE" For Output As #1
Print #1, "This is a test"
Print #1,
Print #1, "Zone 1"; Tab; "Zone 2"
Print #1, "Hello"; " "; "World"
Print #1, Spc(5); "5 leading spaces "
Print #1, Tab(10); "Hello"

Dim MyBool, MyDate, MyNull, MyError
MyBool = False: MyDate = #2/12/1969#
MyNull = Null: MyError = CVErr(32767)

Print #1, MyBool; " is a Boolean value"
Print #1, MyDate; " is a date"
Print #1, MyNull; " is a null value"
Print #1, MyError; " is an error value"
Close #1
End Sub

KHAI BAO PUBLIC

Public piAs Integer
Private Sub Command1_Click()
Dim AnyValue, MyValue

Dim Number As Integer
Number=5
piAs=100+ Number
End Sub

Private Sub Command1_Click()
Dim AnyValue, MyValue

Dim Number As Integer
Number=15
piAs= piAs + Number
End Sub

KHAI BAO PUT

Type Record
ID As Integer
Name As String * 20
End Type

Private Sub Command1_Click()
Dim MyRecord As Record, RecordNumber
Open "TESTFILE" For Random As #1 _
Len = Len(MyRecord)
For RecordNumber = 1 To 5
MyRecord.ID = RecordNumber
MyRecord.Name = "My Name" & RecordNumber
Put #1, RecordNumber, MyRecord
Next RecordNumber
Close #1
End Sub

KHAI BAO RAISEEVENT

Private WithEvents mText As TimerState
Private Sub Command1_Click()
Text1.Text = "From Now"
Text1.Refresh
Text2.Text = "0"
Text2.Refresh
Call mText.TimerTask(9.84)
End Sub

Private Sub Form_Load()
Command1.Caption = "Click to Start Timer"
Text1.Text = ""
Text2.Text = ""
Label1.Caption = _
"The fastest 100 meters ever run took this long:"
Set mText = New TimerState
End Sub

Private Sub mText_ChangeText()
Text1.Text = "Until Now"
Text2.Text = "9.84"
End Sub

Private Sub mText_UpdateTime(ByVal dblJump As Double)
Text2.Text = Str(Format(dblJump, "0"))
DoEvents
End Sub

Option Explicit
Public Event UpdateTime(ByVal dblJump As Double)
Public Event ChangeText()

Public Sub TimerTask(ByVal Duration As Double)
Dim dblStart As Double
Dim dblSecond As Double
Dim dblSoFar As Double
dblStart = Timer
dblSoFar = dblStart

Do While Timer < dblStart + Duration
If Timer - dblSoFar >= 1 Then
dblSoFar = dblSoFar + 1
RaiseEvent UpdateTime(Timer - dblStart)
End If
Loop
RaiseEvent ChangeText
End Sub

KHAI BAO RANDOMIZE

Private Sub Command1_Click()
Dim MyValue
Randomize
MyValue = Int((6 * Rnd) + 1)
Debug.Print MyValue
End Sub

KHAI BAO REDIM

Private Sub Command1_Click()
Dim MyArray() As Integer
ReDim MyArray(5)
For I = 1 To 5
MyArray(I) = I
Next I


ReDim MyArray(10)
For I = 1 To 10
MyArray(I) = I
Next I


ReDim Preserve MyArray(15)
End Sub

KHAI BAO REM

Private Sub Command1_Click()
Dim MyStr1, MyStr2
MyStr1 = "Hello"
Rem Comment after a statement separated by a colon.
MyStr2 = "Goodbye"
End Sub

KHAI BAO RESET

Private Sub Command1_Click()
Dim FileNumber
For FileNumber = 1 To 5
Open "TEST" & _
FileNumber For Output As #FileNumber
Write #FileNumber, "Hello World"
Next FileNumber
Reset
End Sub


KHAI BAO RMDIR

Private Sub Command1_Click()
RmDir "C:\myFolder"
End Sub

KHAI BAO SAVEPICTURE

Private Sub Command1_Click()
Dim CX, CY, Limit
Dim Radius As Integer, Msg As String
ScaleMode = vbPixels
AutoRedraw = True
Width = Height
CX = ScaleWidth / 2
CY = ScaleHeight / 2
Limit = CX
For Radius = 0 To Limit
Circle (CX, CY), Radius, RGB(Rnd * 255, _
Rnd * 255, Rnd * 255)
DoEvents
Next Radius
Msg = "Choose OK to save the graphics "
Msg = Msg & "from this form to a bitmap file."
MsgBox Msg
SavePicture Me.Image, "C:\TEST1.jpg"
End Sub

KHAI BAO SAVESETTING

Private Sub Command1_Click()
SaveSetting appname:="huukhang.com", _
section:="Startup", Key:="Top", setting:=75
SaveSetting "huukhang.com", _
"Startup", "Left", 50
DeleteSetting "huukhang.com", "Startup"
End Sub

KHAI BAO SEEK


Private Sub Command1_Click()
Dim MyRecord As Record, MaxSize, RecordNumber
Open "TESTFILE" For Random As #1 Len = Len(MyRecord)
MaxSize = LOF(1) \ Len(MyRecord)
For RecordNumber = MaxSize To 1 Step -1
Seek #1, RecordNumber
Get #1, , MyRecord
Next RecordNumber
Close #1
End Sub

KHAI BAO SELECT CASE

Private Sub Command1_Click()
Dim Number
Number = InputBox("Please enter number")
Select Case Number
Case 1 To 5
Debug.Print "Between 1 and 5"
Case 6, 7, 8
Debug.Print "Between 6 and 8"
Case 9 To 10
Debug.Print "Greater than 8 & less than 10"
Case Is > 10
Debug.Print "More than 10"
Case Else
Debug.Print "Not more than 1"
End Select
End Sub

KHAI BAO SENDKEYS

Private Sub Command1_Click()
Dim ReturnValue, I
ReturnValue = Shell("CALC.EXE", 1)
AppActivate ReturnValue
For I = 1 To 100
SendKeys I & "{+}", True
Next I
SendKeys "=", True
SendKeys "%{F4}", True
End Sub

KHAI BAO SET

Private Sub Command1_Click()
Dim myCon, myRst
Set myCon = CreateObject("ADODB.Connection")
Set myRst = CreateObject("ADODB.Recordset")
myCon.Open strCon
Set myRst = Nothing
Set myCon = Nothing
End Sub

KHAI BAO SETATTR

Private Sub Command1_Click()
SetAttr "c:TESTFILE.txt", vbHidden
SetAttr "TESTFILE", vbHidden + vbReadOnly
End Sub

KHAI BAO STATIC

Function KeepTotal(Number)
Static Accumulate
Accumulate = Accumulate + Number
KeepTotal = Accumulate
End Function

Static Function MyFunction(Arg1, Arg2, Arg3)
Accumulate = Arg1 + Arg2 + Arg3
Half = Accumulate / 2
MyFunction = Half
End Function

Private Sub Command1_Click()
Dim ldTotal As Double
ldTotal = KeepTotal(10)
ldTotal = ldTotal + MyFunction(1, 2, 3)
Debug.Print ldTotal
End Sub

KHAI BAO STOP

Private Sub Command1_Click()
Dim ldTotal As Double
ldTotal = 10
Debug.Print ldTotal
Stop
ldTotal = ldTotal + 20
Debug.Print ldTotal
End Sub

KHAI BAO SUB


Public Accumulate As Integer
Sub KeepTotal(Number)
Accumulate = Accumulate + Number
Number = Number + 10
End Sub


Private Sub Command1_Click()
Dim ldTotal As Double
Accumulate = 0
ldTotal = 10
KeepTotal (ldTotal)
ldTotal = Accumulate
Debug.Print Accumulate
ldTotal = Number
Debug.Print ldTotal
End Sub

KHAI BAO TYPE

Type EmployeeRecord
ID As Integer
Name As String
Address As String
Phone As Long
HireDate As Date
End Type
Private Sub Command1_Click()
Dim Employees(10) As EmployeeRecord
Dim i As Integer
For i = 0 To 9
Employees(i).ID = i
Employees(i).Name = "Pham Huu Khang " & i
Next
For i = 0 To 9
Debug.Print Employees(i).ID & " " & _
Employees(i).Name
Next
End Sub

KHAI BAO UNLOAD

Private Sub Command1_Click()
Unload frmEmployee
Unload Me
End Sub

KHAI BAO WHILE..WEND

Private Sub Command1_Click()
Dim Counter
Counter = 0
While Counter < 20
Counter = Counter + 1
Wend
Debug.Print Counter
End Sub

KHAI BAO WIDTH
Private Sub Command1_Click()
Dim I
Open "TESTFILE" For Output As #1
M“– ta„p tin ¤e† ghi
VBA.Width 1, 5
For I = 0 To 9
Print #1, Chr(48 + I);
Next I
Close #1
End Sub

KHAI BAO WITH..END WITH

Private Sub Command1_Click()
Dim MyObject As Object
Set MyObject = Me
With MyObject
.Width = 100
.Caption = "Hello World"
End With
End Sub

KHAI BAO WRITE

Private Sub Command1_Click()
Open "C:\teo.txt" For Output As #1
Write #1, "Hello World", 234
Write #1,
Dim MyBool, MyDate, MyNull, MyError
MyBool = False: MyDate = #2/12/1969#
MyNull = Null
MyError = CVErr(32767)
Write #1, MyBool; " is a Boolean value"
Write #1, MyDate; " is a date"
Write #1, MyNull; " is a null value"
Write #1, MyError; " is an error value"
Close #1
End Sub
Love mickey,
Đăng nhập để trả lời
0
PHÉP TOÁN


PHEP TOAN &


Private Sub Command1_Click()
Dim MyStr
MyStr = "Hello" & " World"
Debug.Print MyStr
MyStr = "Check " & 123 & " Check"
Debug.Print MyStr
End Sub

PHEP TOAN *

Private Sub Command1_Click()
Dim MyNum
MyNum = 10
Debug.Print MyStr
MyNum = MyNum*20
Debug.Print MyStr
End Sub

PHEP TOAN +

Private Sub Command1_Click()
Dim MyNum
MyNum = 10
Debug.Print MyNum
MyNum = MyNum+20
Debug.Print MyNum
MyNum = "Pham" + " Huu Khang"
Debug.Print MyNum
End Sub

PHEP TOAN -

Private Sub Command1_Click()
Dim MyNum
MyNum = 10
Debug.Print MyNum
MyNum = MyNum-20
Debug.Print MyNum
End Sub

PHEP TOAN /

Private Sub Command1_Click()
Dim MyNum
MyNum = 100
Debug.Print MyNum
MyNum = MyNum/20
Debug.Print MyNum
MyNum = 0/MyNum
Debug.Print MyNum
End Sub

PHEP TOAN \

Private Sub Command1_Click()
Dim MyNum
MyNum = 107
Debug.Print MyNum
MyNum = MyNum\20
Debug.Print MyNum
MyNum = 0\MyNum
Debug.Print MyNum
End Sub

PHEP TOAN ^

Private Sub Command1_Click()
Dim MyNum
MyNum = 10
Debug.Print MyNum^2
MyNum = MyNum^0
Debug.Print MyNum
MyNum = 0^MyNum
Debug.Print MyNum
End Sub

PHEP TOAN AND

Private Sub Command1_Click()
Dim A, B, C, D, MyCheck
A = 10: B = 8: C = 6: D = Null
MyCheck = A > B And B > C
Debug.Print MyCheck
MyCheck = B > A And B > C
Debug.Print MyCheck
MyCheck = A > B And B > D
Debug.Print MyCheck
MyCheck = A And B
Debug.Print MyCheck
End Sub

PHEP TOAN EQV

Private Sub Command1_Click()
Dim A, B, C, D, MyCheck
A = 10: B = 8: C = 6: D = Null
MyCheck = A > B Eqv B > C
Debug.Print MyCheck
MyCheck = B > A Eqv B > C
Debug.Print MyCheck
MyCheck = A > B Eqv B > D
Debug.Print MyCheck
MyCheck = A Eqv B
Debug.Print MyCheck
End Sub

PHEP TOAN IMP

Private Sub Command1_Click()
Dim A, B, C, D, MyCheck
A = 10: B = 8: C = 6: D = Null
MyCheck = A > B Imp B > C
Debug.Print MyCheck
MyCheck = A > B Imp C > B
Debug.Print MyCheck
MyCheck = B > A Imp C > B
Debug.Print MyCheck
MyCheck = B > A Imp C > D
Debug.Print MyCheck
MyCheck = C > D Imp B > A
Debug.Print MyCheck
MyCheck = B Imp A
Debug.Print MyCheck
End Sub

PHEP TOAN IS

Private Sub Command1_Click()
Dim MyObject, YourObject, ThisObject
Dim OtherObject, ThatObject, MyCheck
Set YourObject = MyObject
Set ThisObject = MyObject
Set ThatObject = OtherObject
MyCheck = YourObject Is ThisObject
Debug.Print MyCheck
MyCheck = ThatObject Is ThisObject
Debug.Print MyCheck
MyCheck = MyObject Is ThatObject
Debug.Print MyCheck
End Sub

PHEP TOAN MOD

Private Sub Command1_Click()
Dim MyNum
MyNum = 107
Debug.Print MyNum
MyNum = MyNum Mod 20
Debug.Print MyNum
MyNum = 0 Mod MyNum
Debug.Print MyNum
End Sub

PHEP TOAN NOT

Private Sub Command1_Click()
Dim A, B, C, D, MyCheck
A = 10: B = 8: C = 6: D = Null
MyCheck = Not (A > B)
MyCheck = Not (B > A)
MyCheck = Not (C > D)
MyCheck = Not A
End Sub

PHEP TOAN OR

Private Sub Command1_Click()
Dim A, B, C, D, MyCheck
A = 10: B = 8: C = 6: D = Null
MyCheck = A > B Or B > C
Debug.Print MyCheck
MyCheck = B > A Or B > C
Debug.Print MyCheck
MyCheck = A > B Or B > D
Debug.Print MyCheck
MyCheck = B > D Or B > A
Debug.Print MyCheck
MyCheck = A Or B
Debug.Print MyCheck
End Sub

PHEP TOAN XOR

Private Sub Command1_Click()
Dim A, B, C, D, MyCheck
A = 10: B = 8: C = 6: D = Null
MyCheck = A > B Xor B > C
Debug.Print MyCheck
MyCheck = B > A xOr B > C
Debug.Print MyCheck
MyCheck = B > A xOr C > B
Debug.Print MyCheck
MyCheck = B > D XOr A > B
Debug.Print MyCheck
MyCheck = A XOr B
Debug.Print MyCheck
End Sub
TOAUN T™U (OPERATORS) A-Z 3-1

Love mickey,
Đăng nhập để trả lời
0
THUỘC TÍNH


THUOC TINH ACTION

Private Sub Command1_Click()
Me.CommonDialog1.Action = 1
Me.CommonDialog1.Action = 2
Me.CommonDialog1.Action = 3
Me.CommonDialog1.Action = 4
Me.CommonDialog1.Action = 5
End Sub

Private Sub Command1_Click()
Me.CommonDialog1.ShowOpen
Me.CommonDialog1.ShowSave Me.CommonDialog1.ShowColor
Me.CommonDialog1.ShowFont
Me.CommonDialog1.ShowPrinter
End Sub

THUOC TINH ACTIVECONNECTION

‘ Khai baùo vaø khôûi taïo ñoái töôïng
Dim rdoCn As New rdoConnection
Dim rdoCn2 As New rdoConnection
Dim rdoQy As New rdoQuery
Dim rdoRs As rdoResultset
Dim rdoCol As rdoColumn
Dim rdoEn As rdoEnvironment

‘ Khai baùo trong bieán coá Load cuûa Form1
Private Sub Form_Load()
On Error GoTo CnEh

‘ Gaùn ñoái töôïng RDOEnviroment
Set rdoEn = rdoEnvironments(0)

With rdoCn
‘ THUOC TINH Connect vôùi chuoãi keát noái cô sôû döõ lieäu
.Connect = "UID=sa;PWD=concat;Database=Northwind;" _
& "Server=.;Driver={SQL Server}" _
& "DSN='';"
.LoginTimeout = 5
.EstablishConnection rdDriverNoPrompt, True
rdoEn.rdoConnections.Add rdoCn
End With

With rdoCn2
.Connect = "UID=sa;PWD=concat;Database=Northwind;" _
& "Server=.;Driver={SQL Server}" _
& "DSN='';"
.LoginTimeout = 5
.EstablishConnection rdDriverNoPrompt, True
rdoEn.rdoConnections.Add rdoCn2
End With

‘ Lieät keâ taát caû caùc ñoái töôïng cô sôû döõ lieäu do ngöôøi söû duïng taïo
‘ ra trong cô sôû döõ lieäu Northwind
With rdoQy
Set .ActiveConnection = rdoCn
.SQL = "Select Name, refDate " _
& " from Sysobjects where type = 'U' "
.LockType = rdConcurReadOnly
.RowsetSize = 1
.CursorType = rdUseServer
End With

For Each rdoCn In rdoEn.rdoConnections
Set rdoQy.ActiveConnection = rdoCn
Set rdoRs = rdoQy.OpenResultset(rdOpenForwardOnly)
With rdoRs
For Each rdoCol In rdoRs.rdoColumns
Debug.Print rdoCol.Name,
Next
Debug.Print
Do Until rdoRs.EOF
For Each rdoCol In rdoRs.rdoColumns
Debug.Print rdoCol
Next
rdoRs.MoveNext
Loop
End With
Next
Exit Sub
CnEh:
Beep
MsgBox Error
End Sub

THUOC TINH ACTIVECONTROL

Private Sub Form_Click()
If TypeOf Screen.ActiveControl Is TextBox Then
Label1.Caption = Screen.ActiveControl.Text
Else
Label1.Caption = _
"Button: " + Screen.ActiveControl.Caption
End If
End Sub

THUOC TINH ACTIVEFORM

' Maõ trong MDI form.
Private Sub MDIForm_Load()
Dim NewForm As New Form1
' Taïo moät ñoái töôïng môùi cuûa Form
NewForm.Show
End Sub

Private Sub Command1_Click()
' In time treân Form ñang kích hoaït
ActiveForm.Print "The time is " & _
Format(Now, "Long Time")
End Sub

THUOC TINH ALIGN

' Theâm PictureBox vaøo Form
' Theâm CommandButton vaøo trong PictureBox
Private Sub Command1_Click()
If Picture1.Align = vbAlignTop Then
Picture1.Align = vbAlignBottom
' Canh leà cho PictureBox beân döôùi form.
Else
Picture1.Align = vbAlignTop
' Canh leà cho PictureBox treân ñaàu form.
End If
End Sub

THUOC TINH ALIGNMENT

' Theâm PictureBox vaøo Form
' Theâm CommandButton vaøo trong PictureBox
Private Sub Command1_Click()
If Picture1.Align = vbAlignTop Then
Picture1.Align = vbAlignBottom
' Canh leà cho PictureBox beân döôùi form.
Else
Picture1.Align = vbAlignTop
' Canh leà cho PictureBox treân ñaàu form.
End If
End Sub

THUOC TINH ALLOWROWS

Dim strName As String
'Theâm moät ñieàu khieån DataGrid vaøo Form
Private Sub DataGrid1_BeforeColEdit( _
ByVal ColIndex As Integer, _
ByVal KeyAscii As Integer, Cancel As Integer)
If strName = "Phil" Then
Cancel = False
' Neáu teân laø "Phil" thì chöông trình cho pheùp kích hoaït noäi dung
‘ cuûa DataGrid.
Else
Cancel = True
MsgBox "You've attempted to edit " & _
" column number " & _
ColIndex + 1 & _
" without the proper authorization."
' Khoâng cho pheùp ngöôøi khaùc kích hoaït noäi dung treân DataGrid.
End If

End Sub


Private Sub Form_Load()
strName = InputBox("Please enter your name")
DataGrid1.AllowArrows = True
' Cho pheùp ngöôøi söû duïng di chuyeån treân DataGrid
‘ baèng phím arrow keys.
DataGrid1.WrapCellPointer = True
End Sub

THUOC TINH ALLOWVERTICAL

Private Sub Form_Load()
' Gaùn captions nhaän daïng cho moãi Band
cbrMain.Bands(1).Caption = "1"
cbrMain.Bands(2).Caption = "2"
cbrMain.Bands(3).Caption = "3"
' Gaùn THUOC TINH AllowVertical cuûa Band 2
cbrMain.Bands(2).AllowVertical = False
End Sub

Private Sub Form_Click()
' Thay ñoåi höôùng cuûa ñieàu khieån CoolBar
If cbrMain.Orientation = _
cc3OrientationHorizontal Then
cbrMain.Orientation = _
cc3OrientationVertical
cbrMain.Align = vbAlignLeft
Else
cbrMain.Orientation = _
cc3OrientationHorizontal
cbrMain.Align = vbAlignTop
End If
End Sub

THUOC TINH ARCHIVE, HIDDEN, NORMAL, SYSTEM

Private Sub Command1_Click()
File1.Archive = True
File1.Hidden = True
File1.Normal = True
File1.System = True
End Sub

THUOC TINH ARRANGE

Private Sub Option1_Click(Index As Integer)
' Gaùn THUOC TINH Arrange vaøo THUOC TINH Index cuûa ñieàu
‘ khieån Option1.
ListView1.Arrange = Index
End Sub

Private Sub Form_Load()
' Ñònh nghóa nhaõn cho ñieàu khieån OptionButton
Option1(0).Caption = "No Arrange"
Option1(1).Caption = "Align Auto Left"
Option1(2).Caption = "Align Auto Top"
' Khai baùo bieán ñeå taïo ñoái töôïng ListView vaø ImageList.
Dim i As Integer
Dim itmX As ListItem
Dim imgX As ListImage
' Khai baùo bieán ñoái töôïng cho ñoái töôïng ListImages.

' Theâm ñoái töôïng ListImage vaøo ñieàu khieån ImageList.
Set imgX = ImageList1.ListImages. _
Add(, , LoadPicture("icons\mail01a.ico"))

ListView1.Icons = ImageList1
' Choïn bieåu töôïng öùng vôùi ñieàu khieån ImageList.

' Theâm 10 ñoái töôïng ListItem, moãi ñoái töôïng öùng vôùi 1 Icon.
For i = 1 To 10
Set itmX = ListView1.ListItems.Add()
itmX.Icon = 1
itmX.Text = "ListItem " & i
Next i
End Sub

THUOC TINH ATTACHMENTCOUNT

Private Sub Command4_Click()
MAPIMessages1.Compose
MAPIMessages1.RecipDisplayName = Text1.Text
MAPIMessages1.MsgSubject = Text2.Text
MAPIMessages1.MsgNoteText = Text4.Text
MAPIMessages1.AttachmentName =”test.txt"
MAPIMessages1.AttachmentPathName = _
"C:\test.txt"
i = MAPIMessages1.AttachmentCount
MAPIMessages1.ResolveName
MAPIMessages1.Send
End Sub

THUOC TINH ATTACHMENTNAME

Private Sub Command2_Click()
MAPIMessages1.Compose
MAPIMessages1.RecipDisplayName = Text1.Text
MAPIMessages1.MsgSubject = Text2.Text
MAPIMessages1.MsgNoteText = Text4.Text
MAPIMessages1.AttachmentName =”test.txt"
MAPIMessages1.AttachmentPathName = _
"C:\test.txt"
i = MAPIMessages1.AttachmentCount
MAPIMessages1.ResolveName
MAPIMessages1.Send
End Sub

THUOC TINH ATTACHMENTPATHNAME

Private Sub Command5_Click()
MAPIMessages1.Compose
MAPIMessages1.RecipDisplayName = Text1.Text
MAPIMessages1.MsgSubject = Text2.Text
MAPIMessages1.MsgNoteText = Text4.Text
MAPIMessages1.AttachmentName =”test.txt"
MAPIMessages1.AttachmentPathName = _
"C:\test.txt"
i = MAPIMessages1.AttachmentCount
MAPIMessages1.ResolveName
MAPIMessages1.Send
End Sub

THUOC TINH ATTRIBUTES

Private Sub Command1_Click()
Dim fs, f, r
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(fs.GetFileName(filespec))
If f.Attributes And 32 Then
r = MsgBox("The Archive bit is set, " & _
" do you want to clear it?", vbYesNo, _
"Set/Clear Archive Bit")
If r = vbYes Then
f.Attributes = f.Attributes - 32
MsgBox "Archive bit is cleared."
Else
MsgBox "Archive bit remains set."
End If
Else
r = MsgBox("The Archive bit is not set. " & _
"Do you want to set it?", vbYesNo, _
"Set/Clear Archive Bit")
If r = vbYes Then
f.Attributes = f.Attributes + 32
MsgBox "Archive bit is set."
Else
MsgBox "Archive bit remains clear."
End If
End If
End Sub

THUOC TINH AUTOINCREAMENT

Private Sub Command1_Click()
With MSChart1
' Trình baøy bieàu ñoà daïng 3d vôùi 8 coät vaø 8 haøng döõ lieäu.
.ChartType = VtChChartType3dBar
.ColumnCount = 8
.AutoIncrement = False
.RowCount = 8
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, index1, _
index2, index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, _
index1, index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH AUTOPLAY

Private Sub Command1_Click()
With CommonDialog1
.Filter = "avi (*.avi)|*.avi"
.ShowOpen
End With
With Animation1
.Autoplay = True
.Open CommonDialog1.FileName
End With
End Sub

THUOC TINH AUTODRAW

‘ Theâm ñieàu khieån PictureBox treân form
Private Sub Form_Load()
Picture1.ScaleHeight = 100
' Gaùn tyû leä 100.
Picture1.ScaleWidth = 100
Picture1.AutoRedraw = True
' Gaùn THUOC TINH AutoRedraw.
Picture1.ForeColor = 0
' Gaùn maøu chöõ (ForeColor).
Picture1.FillColor = QBColor(9)
' Gaùn THUOC TINH toâ maøu (FillColor).
Picture1.FillStyle = 0
' Set FillStyle.
Picture1.Circle (50, 50), 30
' Veõ hình troø.
Picture1.AutoRedraw = False
' Turn off AutoRedraw.
End Sub

Private Sub Picture1_Click()
Dim I
' Khai baùo bieán
Picture1.ForeColor = RGB(Rnd * 255, 0, 0)
' Choïn maøu ngaãu nhieân.
For I = 5 To 95 Step 10
' Veõ ñöôøng thaúng
Picture1.Line (I, 0)-(I, 100)
Next
End Sub

THUOC TINH AUTOSHOWCHILDREN

‘ Khai baùo trong MDIForm
Private Sub MDIForm_Load()
MDIForm1.AutoShowChildren = False
' Che daáu Form daïng Child moãi khi noù naïp leân.
Dim HideForm As New Form1
' Khai baùo ñoái töôïng Form.
HideForm.Caption = "HideForm"
' gaùn THUOC TINH Caption.
Load HideForm
' Naïp vaø che daáu
MDIForm1.AutoShowChildren = True
' Gaùn THUOC TINH AutoShowChildren laø True ñeå Form con
‘ xuaát hieän moãi khi chuùng naïp leân MDIForm.
Dim ShowForm As New Form1
' Khai baùo ñoái töôïng form.
ShowForm.Caption = "ShowForm"
' Gaùn THUOC TINH caption.
Load ShowForm
' Naïp vaø hieån thò
End Sub

THUOC TINH AUTOSIZE (PANEL)

' Theâm moät ñieàu khieån StatusBar vaø PictureBox vaøo Form
Private Sub Form_Load()
Dim pnlX As Panel
' Gaùn THUOC TINH tag cho moäi ñieàu khieån vaø Form.
Form1.Tag = "Project 1 Form"
Command1.Tag = "A command button"
Picture1.Tag = "Picture Box Caption"
StatusBar1.Tag = "Application StatusBar1"
' Gaùn THUOC TINH AutoSize cuûa Panel ñaàu tieân vôùi noäi dung.
StatusBar1.Panels(1).AutoSize = sbrContents
' Theâm 2 Panel vaø gaùn noäi dung cho chuùng.
Set pnlX = StatusBar1.Panels.Add
pnlX.AutoSize = sbrContents
Set pnlX = StatusBar1.Panels.Add
pnlX.AutoSize = sbrContents
End Sub

Private Sub Form_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
' Hieån thò giaù trò THUOC TINH Tag cuûa ñieàu khieån trong Panel 1,
' vaø toaï ñoä x,y treân Panel 2 vaø 3. Bôûi vì THUOC TINH AutoSize
' baèng Contents coøn Panel htöù nhaát seõ keùo daøi.
StatusBar1.Panels(1).Text = Form1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

' Khai baùo trong bieán coá MouseMove cuûa nuùt Command1
Private Sub Command1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
StatusBar1.Panels(1).Text = Command1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

' Khai baùo trong bieán coá MouseMove cuûa ñieàu khieån PictureBox
Private Sub Picture1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
StatusBar1.Panels(1).Text = Picture1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

' Khai baùo trong bieán coá MouseMove cuûa ñieàu khieån StatusBar
Private Sub StatusBar1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
StatusBar1.Panels(1).Text = StatusBar1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

THUOC TINH BACKCOLOR, BACKCOLORBKG, BACKCOLORFIXED, BACKCOLORSEL

Private Sub Form_Load()
Timer1.Interval = 500
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.BackColorBkg = QBColor(Rnd * 15)
MSHFlexGrid1.BackColorFixed = _
QBColor(Rnd * 10)
MSHFlexGrid1.BackColorSel = QBColor(Rnd * 10)
End Sub

THUOC TINH BACKCOLOR, FORECOLOR

Private Sub Form_Load()
Timer1.Interval = 500
End Sub

Private Sub Timer1_Timer()
BackColor = QBColor(Rnd * 15)
ForeColor = QBColor(Rnd * 10)
Picture1.BackColor = QBColor(Rnd * 15)
Picture1.ForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH BACKCOLOR, FORECOLOR

Ñeå thöïc hieän ví duï sau, baïn theâm ñieàu khieån Timer1 vaø RichTextBox1 vaøo Form1.

Private Sub Form_Load()
Timer1.Interval = 500
End Sub

Private Sub Timer1_Timer()
BackColor = QBColor(Rnd * 15)
ForeColor = QBColor(Rnd * 10)
RichTextBox1.BackColor = QBColor(Rnd * 15)
End Sub

THUOC TINH BACKCOLORBAND, BACKCOLORHEADER, BACKCOLORINDENT, BACKCOLORUNPOPULATED

Private Sub Form_Load()
Timer1.Interval = 500
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.Cols = 3
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Col = 0
MSHFlexGrid1 = "ASAS"
MSHFlexGrid1.BackColorBand(0) = _
QBColor(Rnd * 2)
MSHFlexGrid1.BackColorHeader(0) = _
QBColor(Rnd * 15)
MSHFlexGrid1.BackColorIndent(0) = _
QBColor(Rnd * 10)
MSHFlexGrid1.BackColorUnpopulated = _
QBColor(Rnd * 10)
End Sub

THUOC TINH BANDBORDERS

Private Sub Form_Load()
' Khai baùo Caption cho moãi Band
cbrMain.Bands(1).Caption = "One"
cbrMain.Bands(2).Caption = "Two"
cbrMain.Bands(3).Caption = "Three"
End Sub

Private Sub Form_Click()
If cbrMain.BandBorders = True Then
' Che daáu ñöôøng vieàn
cbrMain.BandBorders = False
Else
' Trình baøy ñöôøng vieàn
cbrMain.BandBorders = True
End If
End Sub

THUOC TINH BOF VAØ EOF

Private Sub Command1_Click()
' Khai baùo vaø khôûi taïo ñoái töôïng ADO
Dim myCon As New ADODB.Connection
Dim myRs As New ADODB.Recordset
Dim strCon As String
' Khai baùo chuoãi keát noái cô sôû döõ lieäu SQL Server
strCon = "Provider=SQLOLEDB.1;"
strCon=strCon & "Persist Security Info=False;"
strCon = strCon & "UID=sa;PWD=concat;"
strCon = strCon & "Initial Catalog=Northwind;"
strCon = strCon & "Server.;"
' Môû keát noái cô sôû döõ lieäu
myCon.Open strCon
myRs.CursorLocation = adUseClient
' Môû taäp döõ lieäu
myRs.Open "Select * from Customers", _
myCon, adOpenDynamic, adLockReadOnly
If myRs.RecordCount > 0 Then
' Kieåm tra THUOC TINH EOF
Do Until myRs.EOF
Debug.Print myRs("CompanyName")
myRs.MoveNext
Loop
End If
Set myRs = Nothing
Set myCon = Nothing
End Sub

THUOC TINH BOLD

Private Sub Form_Click()
Font.Bold = Not Font.Bold
Font.Strikethrough = Not Font.Strikethrough
Font.Italic = Not Font.Italic
Font.Underline = Not Font.Underline
Font.Size = 16
If Font.Bold Then
Print "Font weight is " & _
Font.Weight & " (bold)."
Else
Print "Font weight is " & _
Font.Weight & " (not bold)."
End If
End Sub

THUOC TINH BOLD

Private Sub cmdMake_Click()
tvwDB.Sorted = True
Set mNode = tvwDB.Nodes.Add()
mNode.Text = "Publisher"
Set mNode = tvwDB.Nodes.Add()
mNode.Text = "Private"
Set mNode = tvwDB.Nodes.Add(1, tvwChild)
mNode.Text = "DEF"
Set mNode = tvwDB.Nodes.Add(1, tvwChild)
mNode.Text = "GHI"
Set mNode = tvwDB.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-1"
mNode.Bold = True
Set mNode = tvwDB.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-2"
Set mNode = tvwDB.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-1"
Set mNode = tvwDB.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-2"
Set mNode = tvwDB.Nodes.Add(1, tvwChild)
mNode.Text = "ABCD"
End Sub

THUOC TINH BOOKMARK

Private Sub DataGrid1_UnboundDeleteRow(Bookmark As Variant)
For i% = Bookmark + 1 To RowCount - 1
For j% = 0 To MAXCOLS - 1
UserData(j%, i% - 1) = UserData(j%, i%)
Next j%
Next i%
End Sub

THUOC TINH BORDERCOLOR

Private Sub Command1_Click()
Shape1.BorderColor = &H80000001
End Sub

THUOC TINH BORDERWIDTH

Private Sub Form_Load()
Combo1(0).Width = 1440 * 1.5
Load Combo1(1)
Combo1(1).Top = _
Combo1(0).Top + Combo1(0).Height * 1.5
Combo1(1).Visible = True
For i = 0 To 6
Combo1(0).AddItem "BorderStyle = " & i
Next i
For i = 1 To 10
Combo1(1).AddItem "BorderWidth = " & i
Next i
Combo1(0).ListIndex = 1
Combo1(1).ListIndex = 0
End Sub

Private Sub Combo1_Click(Index As Integer)
If Index = 0 Then
Shape1.BorderStyle = Combo1(0).ListIndex
Else
Shape1.BorderWidth = Combo1(1).ListIndex + 1
End If
End Sub

THUOC TINH BOTTOMMARGIN, TOPMARGIN

Private Sub ChangeMargins(Optional fraction As Long)
If fraction = 0 Then fraction = 8
With DataReport1
.TopMargin = 1000
.BottomMargin = 1000
.LeftMargin = .Width / fraction
.RightMargin = .Width / fraction
End With
End Sub

THUOC TINH BOUNDTEXT

Private Sub DataCombo1_MouseUp(Button As _
Integer, Shift As Integer, x As Single, _
y As Single)
Dim recSource As String
recSource = "SELECT * FROM Products " & _
" WHERE SupplierID = " & DataCombo1.BoundText
Adodc1.RecordSource = recSource
Adodc1.Refresh
End Sub

Private Sub Form_Load()
' Söû duïng chung chuoãi keát noái cô sôû döõ lieäu cho hai ñieàu khieån
' ADO Data. Neáu loãi phaùt sinh thì kieåm tra ñöôøng daãn cuûa taäp
' tin Nwind.mdb.

Dim ConnectionString As String
ConnectionString = "Driver={Microsoft " & _
" Access Driver (*.mdb)};Dbq=C:\Program " & _
" Files\Microsoft Visual Studio\VB98\ " & _
" Nwind.mdb;Uid=;Pwd="

' Löu yù raèng, caû hai ñieàu khieån ADO Data,
' Recordsource phaûi söû duïng chung SupplierID.
' Ñaây laø tröôøng döõ lieäu thoâng thöôøng ñöôïc söû duïng
' baèng caùch thay ñoåi trong ñieàu khieån DataCombo
' khi recordset traû veà bôûi ADODC1. ADODC2.
With Adodc1
.RecordSource = "SELECT ProductName, " & _
"ProductID, SupplierID FROM Products"
.ConnectionString = ConnectionString
.Refresh
.Caption = "Products"
.Visible = False
End With

With Adodc2
.RecordSource = "SELECT CompanyName," & _
"SupplierID FROM Suppliers"
.ConnectionString = ConnectionString
.Refresh
.Caption = "Suppliers"
.Visible = False
End With

Set DataGrid1.DataSource = Adodc1

With DataCombo1
Set .DataSource = Adodc1
.DataField = "SupplierID"
' Coät döõ lieäu ñaõ thay ñoåi.
.BoundColumn = "SupplierID"
' Coät döõ lieäu trong ADODC2 thay ñoåi DataField.
Set .RowSource = Adodc2
.ListField = "CompanyName"
' Coät döõ lieäu trình baøy baèng DataCombo.
End With

' Ñoàng boä giöõa ñieàu khieån DataGrid vaø DataCombo baèng
' caùch di chuyeån ñeán maåu tin ñaàu tieân cuûa ADODC1.
Adodc1.Recordset.MoveFirst
End Sub

THUOC TINH BUTTONHEIGHT, BUTTONWIDTH

Private Sub Form_Load()
' Taïo bieán ñoái töôïng cho ImageList.
Dim imgX As ListImage

' Naïp pictures vaøo ñieàu khieån ImageList
Set imgX = ImageList1.ListImages. _
Add(, "open", LoadPicture("Graphics\open.bmp"))
Set imgX = ImageList1.ListImages. _
Add(, "save", LoadPicture("Graphics\save.bmp"))
Toolbar1.ImageList = ImageList1

' Create object variable for the Toolbar.
Dim btnX As Button
' Theâm ñoái töôïng button vaøo Buttons collection baèng caùch
' söû duïng phöông thöùc Add. Sau khi theâm moãi button, baïn
' gaùn hai THUOC TINH Description vaø ToolTipText.
Toolbar1.Buttons.Add , , , tbrSeparator
Set btnX = Toolbar1.Buttons.Add(, "open", _
, tbrDefault, "open")
btnX.ToolTipText = "Open File"
btnX.Description = btnX.ToolTipText
Set btnX = Toolbar1.Buttons.Add(, "save", , _
tbrDefault, "save")
btnX.ToolTipText = "Save File"
btnX.Description = btnX.ToolTipText
Set btnX = Toolbar1.Buttons.Add(, , , tbrSeparator)

' Nuùt keá tieáp coù kieåu Placeholder style.
' ñieàu khieån ComboBox naèm treân ñaàu cuûanuùt naøy.
Set btnX = Toolbar1.Buttons.Add(, "combo1", , tbrPlaceholder)
btnX.Width = 1500

Show
' Hieån thò formtieáp tuïc caáu hình ñieàu khieån ComboBox.

' Caáu hình ñieàu khieån ComboBox cuøng vò trí vôùi
' ñoái töôïng Button vôùi kieåu PlaceHolder (key = "combo1").
With Combo1
.Width = Toolbar1.Buttons("combo1").Width
.Top = Toolbar1.Buttons("combo1").Top
.Left = Toolbar1.Buttons("combo1").Left
.AddItem "Black"
' Theâm maøu vaøo cho text.
.AddItem "Blue"
.AddItem "Red"
.ListIndex = 0
End With

End Sub

Private Sub Form_Resize()
' Configure ComboBox control.
With Combo1
.Width = Toolbar1.Buttons("combo1").Width
.Top = Toolbar1.Buttons("combo1").Top
.Left = Toolbar1.Buttons("combo1").Left
End With

End Sub
Private Sub toolbar1_ButtonClick(ByVal Button As Button)
' söû duïng THUOC TINH Key vôùi phaùt bieåu SelectCase ñeå chæ ñònh
‘ haønh ñoäng cuûa nuùt ñöôïc choïn
Select Case Button.Key
Case Is = "open"
' Môû taäp tin.
MsgBox "Add code to open file here!"
Case Is = "save"
' Löu taäp tin
MsgBox "Add code to save file here!"
End Select
End Sub

Private Sub Combo1_Click()
' Thay ñoåi maøu neàn cuûa form baèng caùch choïn trong ComboBox.
Select Case Combo1.ListIndex
Case 0
Form1.BackColor = vbBlack
Case 1
Form1.BackColor = vbBlue
Case 2
Form1.BackColor = vbRed
End Select
End Sub

THUOC TINH CANGROW

If MsgBox("Do you want to show abbreviated titles?",vbYesNo + vbDefaultButton2) = vbYes Then
ptNwind.Sections("Products_Detail").Controls( _
"txtProductName").CanGrow = False
Else
rptNwind.Sections("Products_Detail").Controls( "txtProductName").CanGrow = True
End If

THUOC TINH CAPTION

Private Sub Command1_Click()
' Kieåm tra Caption, sau ñoù thay ñoåi giaù trò cho THUOC TINH naøy
If Command1.Caption = "Clicked" Then
Command1.Caption = "OK"
Else
Command1.Caption = "Clicked"
End If
End Sub

THUOC TINH CELLALIGNMENT

‘ Theâm moät ñieàu khieån MSHFlexGrid vaøo Form
Sub Form1_Load()
MSHFlexGrid1.CellAlignment = _
flexAlignLeftCenter
End Sub

THUOC TINH CELLBACKCOLOR, CELLFORECOLOR

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLFONTBOLD

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontBold = 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLFONTITALIC

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontItalic = 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLFONTNAME


Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontBold = 1
MSHFlexGrid1.CellFontName = Screen.Fonts(3)
MSHFlexGrid1.Text = Screen.Fonts(3)
' Hieån thò Font Name
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLFONTSIZE

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontItalic = 1
MSHFlexGrid1.CellFontName = Screen.Fonts(3)
MSHFlexGrid1.Text = Screen.Fonts(3)
MSHFlexGrid1.CellFontSize = 12
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLFONTSTRIKETHROUGH

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontStrikeThrough= 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLFONTUNDERLINE


Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontUnderline= 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLFONTWIDTH

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontWidth= 5
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CELLHEIGHT, CELLLEFT, CELLTOP, CELLWIDTH

Private Sub Form_Load()
' Di hcuyeån ñieàu khieån textbox khi Form naïp.
MoveTextBox
End Sub

Private Sub MSFlexGrid1_EnterCell()
' Khi ngöôøi söû duïng nhaäp vaøo oâ, thuû tuïc naøy cheùp noäi
' dung cuûa oâ hieän haønh vaøo ñieàu khieån TextBox
MoveTextBox
Text1.Text = MSFlexGrid1.Text
Text1.SetFocus
End Sub

Private Sub MSFlexGrid1_LeaveCell()
' Töông töï nhö vaäy, sau khi ngöôøi söû duïng thoaùt khoûi oâ, thuû tuïc
' naøy seõ cheùp noäi dung cuûa dkh TextBox vaøo oâ hieän haønh.
MSFlexGrid1.Text = Text1.Text
End Sub

Private Sub MoveTextBox()
' Di hcuyeån ñieàu khieån textbox leân treân ñaàu cuûa oâ hieän haønh
' vaø coù kích thöôùc baèng vôùi kích thöôùc cuûa oâ hieän haønh.
Text1.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
Text1.Top = MSFlexGrid1.CellTop
Text1.Height = MSFlexGrid1.CellHeight
Text1.Width = MSFlexGrid1.CellWidth
End Sub

THUOC TINH CELLPICTURE

Private Sub Form_Click()
' Naïp icons vaøo ñieàu khieån.
MSHFlexGrid1.Row = 1
MSHFlexGrid1.Col = 1
Set MSHFlexGrid1.CellPicture =_
LoadPicture ("Icons\Computer\Trash02a.ico")
MSHFlexGrid1.Row = 1
MSHFlexGrid1.Col = 2
Set MSHFlexGrid1.CellPicture =_
LoadPicture ("Icons\Computer\Trash02b.ico")
End Sub

THUOC TINH CELLPICTUREALIGNMENT

Private Sub Form_Click()
' Naïp icons vaøo Cell.
MSHFlexGrid1.Row = 1
MSHFlexGrid1.Col = 1
Set MSHFlexGrid1.CellPicture =_
LoadPicture ("Icons\Computer\Trash02a.ico")
MSHFlexGrid1.CellPictureAlignment =_
flexAlignRightCenter
MSHFlexGrid1.Row = 1
MSHFlexGrid1.Col = 2
Set MSHFlexGrid1.CellPicture =_
LoadPicture ("Icons\Computer\Trash02b.ico")
MSHFlexGrid1.CellPictureAlignment =_
flexAlignRightCenter
End Sub

THUOC TINH CELLTEXTSTYLE

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellTextStyle = flexTextInset
MSHFlexGrid1.CellFontUnderline= 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH CHARTDATA

Option Explicit
Option Base 1

Private Sub Form_Load()
Dim arrData(3, 1 To 3)
arrData(1, 1) = "Jan"
' Gaùn nhaõn cho haøng ñaàu tieân.
arrData(2, 1) = "Feb"
arrData(3, 1) = "Mar"

arrData(1, 2) = 8
arrData(2, 2) = 4
arrData(3, 2) = 0.3

arrData(1, 3) = 0.2
arrData(2, 3) = 3
arrData(3, 3) = 6.3
MSChart1.ChartData = arrData
End Sub

THUOC TINH CHARTTYPE

Private Sub Command1_Click()
With MSChart1
' Trình baøy kieåu 3d vôùi 8 coät vaø 8 haøng döõ lieäu
.chartType = VtChChartType3dBar
.ColumnCount = 8
.RowCount = 8
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, _
index1, index2, _
index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, index1, _
index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH CHECKBOX

Private Sub Form_Load()
DateTimePicker.CheckBox = True
End Sub

THUOC TINH CHECKBOXES

Private Sub Form_Load()
TreeView1.CheckBoxes=True
TreeView1.Sorted = True
Set mNode = TreeView1.Nodes.Add()
mNode.Text = "Publisher"
Set mNode = TreeView1.Nodes.Add()
mNode.Text = "Private"
Set mNode = TreeView1.Nodes.Add(1, tvwChild)
mNode.Text = "DEF"
Set mNode = TreeView1.Nodes.Add(1, tvwChild)
mNode.Text = "GHI"
Set mNode = TreeView1.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-1"
Set mNode = TreeView1.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-2"
Set mNode = TreeView1.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-1"
Set mNode = TreeView1.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-2"
Set mNode = TreeView1.Nodes.Add(1, tvwChild)
mNode.Text = "ABCD"
End Sub

THUOC TINH CHECKED

Private Sub Form_Load()
mnOpen.Checked = True
mnSave.Checked = True
End Sub

THUOC TINH CHECKED (WINDOWS COMMON CONTROLS)

Private Sub Form_Load()
TreeView1.CheckBoxes=True
TreeView1.Sorted = True
Set mNode = TreeView1.Nodes.Add()
mNode.Checked=True
mNode.Text = "Publisher"
Set mNode = TreeView1.Nodes.Add()
mNode.Text = "Private"
Set mNode = TreeView1.Nodes.Add(1, tvwChild)
mNode.Text = "DEF"
Set mNode = TreeView1.Nodes.Add(1, tvwChild)
mNode.Text = "GHI"
Set mNode = TreeView1.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-1"
Set mNode = TreeView1.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-2"
Set mNode = TreeView1.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-1"
Set mNode = TreeView1.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-2"
Set mNode = TreeView1.Nodes.Add(1, tvwChild)
mNode.Text = "ABCD"
End Sub

THUOC TINH CHILD

Private Sub Form_Load()
' Gaùn moät ñieàu khieån con vaøo moãi Band
Set cbrMain.Bands(1).Child = txtOne
Set cbrMain.Bands(2).Child = txtTwo
Set cbrMain.Bands(3).Child = txtThree
' Che daáu TextBox thö 4
txtFour.Visible = False
End Sub

Private Sub Form_Click()
' Thay ñoåi ñieàu khieån con cuûa Band 1
If cbrMain.Bands(1).Child = txtOne Then
Set cbrMain.Bands(1).Child = txtFour
' Che daáu TextBox thöù nhaát
txtOne.Visible = False
Else
Set cbrMain.Bands(1).Child = txtOne
' Che daáu TextBox thö 4
txtFour.Visible = False
End If
End Sub

THUOC TINH CHILD

Private Sub Form_Load()
' Taïo 3 ñoái töôïng Node
TreeView1.Style = tvwTreelinesPlusMinusText
' Daïng caây.
TreeView1.LineStyle = tvwRootLines
'Daïng ñöôøng .

' Theâm nhieàu ñoái töôïng Node
Dim nodX As Node
' Khai baùo bieán.

Set nodX = TreeView1.Nodes.Add(, , "r", "Root")
Set nodX = TreeView1.Nodes.Add("r", _
tvwChild, "c1", "Child 1")

nodX.EnsureVisible
' Trình baøy taát caû caùc nodes.
Set nodX = TreeView1.Nodes.Add("c1", _
tvwChild, "c2", "Child 2")
Set nodX = TreeView1.Nodes.Add("c1", _
tvwChild, "c3", "Child 3")
nodX.EnsureVisible
' Trình baøy taát caû caùc nodes.
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As Node)
' Neáu Node khoâng coù con, thì trình baøy chuoãi cho Node con naøy.
If Node.Children Then
Caption = Node.Child.Text
End If
End Sub

THUOC TINH CHILDREN

Private Sub Form_Load()
' Taïo 3 ñoái töôïng Node
TreeView1.Style = tvwTreelinesPlusMinusText
' Daïng caây.
TreeView1.LineStyle = tvwRootLines
'Daïng ñöôøng .

' Theâm nhieàu ñoái töôïng Node
Dim nodX As Node
' Khai baùo bieán.

Set nodX = TreeView1.Nodes.Add(, , "r", "Root")
Set nodX = TreeView1.Nodes.Add("r", _
tvwChild, "c1", "Child 1")

nodX.EnsureVisible
' Trình baøy taát caû caùc nodes.
Set nodX = TreeView1.Nodes.Add("c1", _
tvwChild, "c2", "Child 2")
Set nodX = TreeView1.Nodes.Add("c1", _
tvwChild, "c3", "Child 3")
nodX.EnsureVisible
' Trình baøy taát caû caùc nodes.
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As Node)
' Neáu Node khoâng coù con, thì trình baøy chuoãi cho Node con naøy.
If Node.Children Then
Caption = Node.Child.Text
End If
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As Node)
If Node.Children > 0 Then
MsgBox Node.Child.Text
End If
End Sub

THUOC TINH COL, ROW

Private Sub Form_Load()
Dim i As Integer
For i = 1 To MSFlexGrid1.Rows - 1
MSFlexGrid1.Row = i
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = _
"Welcome to www.huukhang.com"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = _
"You can donwload source code of any Books."
Next
End Sub

THUOC TINH COLALIGNMENT, COLALIGNMENTBAND, COLALIGNMENTHEADER

Private Sub Form_Load()
Dim i As Integer
MSFlexGrid1.Cols = 3
MSFlexGrid1.Rows = 10
MSFlexGrid1.ColAlignment(2) = _
flexAlignRightCenter
For i = 1 To MSFlexGrid1.Rows - 1
MSFlexGrid1.Row = i
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = _
"Welcome to www.huukhang.com"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "You can donwload source code of any Books."
Next
End Sub


Private Sub Form_Load()
Dim i As Integer
‘ Khai baùo soá coät
MSHFlexGrid1.Cols = 3
‘ Khai baùo soá haøng
MSHFlexGrid1.Rows = 10
‘ Canh leà coät thöù 3
MSHFlexGrid1.ColAlignment(2) = _
flexAlignRightCenter
For i = 1 To MSFlexGrid1.Rows - 1
MSHFlexGrid1.Row = i
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Text = _
"Welcome to www.huukhang.com"
MSHFlexGrid1.Col = 2
MSHFlexGrid1.Text = _
"You can donwload source code of any Books."
Next
End Sub

THUOC TINH COLALIGNMENTFIXED

Private Sub Form_Load()
Dim i As Integer
‘ Khai baùo soá coät
MSHFlexGrid1.Cols = 3
‘ Khai baùo soá haøng
MSHFlexGrid1.Rows = 10
‘ Canh leà coät thöù 3
MSHFlexGrid1.ColAlignment(2) = _
FlexAlignRightCenter
‘ Khai bao Header
MSHFlexGrid1.FormatString = "A|B|C"
‘ Khai baùo chieàu roäng cho töøng coät
MSHFlexGrid1.ColWidth(0) = 0
MSHFlexGrid1.ColWidth(1) = 2000
MSHFlexGrid1.ColWidth(2) = 2000
‘ Khai baùo canh leà cuûa oâ 0,0
MSHFlexGrid1.ColAlignmentFixed(0) = _
flexAlignRightCenter
For i = 1 To MSFlexGrid1.Rows - 1
MSHFlexGrid1.Row = i
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Text = _
"Welcome to www.huukhang.com"
MSHFlexGrid1.Col = 2
MSHFlexGrid1.Text = _
"You can donwload source code of any Books."
Next
End Sub

THUOC TINH COLDATA, ROWDATA


Sub CopySelectedPictureToClipboard(myFlex As _
MSHFlexGrid)
Dim i As Integer, tr As Long, lc As Long, _
hl As Integer
myFlex.Redraw = False
' Khai baùo chieàu cao.
hl = myFlex.HighLight
tr = myFlex.TopRow
lc = myFlex.LeftCol
myFlex.HighLight = 0
For i = myFlex.FixedRows To myFlex.Rows - 1
If i < myFlex.Row Or i > myFlex.RowSel Then
myFlex.RowData(i) = myFlex.RowHeight(i)
myFlex.RowHeight(i) = 0
End If
Next
For i = myFlex.FixedCols To myFlex.Cols - 1
If i < myFlex.Col Or i > myFlex.ColSel Then
myFlex.ColData(i) = myFlex.ColWidth(i)
myFlex.ColWidth(i) = 0
End If
Next
' Cuoän leân goùc beân traùi phía treân
myFlex.TopRow = myFlex.FixedRows
myFlex.LeftCol = myFlex.FixedCols
' Cheùp hình aûnh
Clipboard.Clear
On Error Resume Next
myFlex.PictureType = 0 ' Color.
Clipboard.SetData myFlex.Picture
If Error <> 0 Then
myFlex.PictureType = 1 ' Monochrome.
Clipboard.SetData myFlex.Picture
End If
' Phuïc hoài ñieàu khieån
For i = myFlex.FixedRows To myFlex.Rows - 1
If i < myFlex.Row Or i > myFlex.RowSel Then
myFlex.RowHeight(i) = myFlex.RowData(i)
End If
Next
For i = myFlex.FixedCols To myFlex.Cols - 1
If i < myFlex.Col Or i > myFlex.ColSel Then
myFlex.ColWidth(i) = myFlex.ColData(i)
End If
Next
myFlex.TopRow = tr
myFlex.LeftCol = lc
myFlex.HighLight = hl
myFlex.Redraw = True
End Sub

' Ví duï sau trình baøy laøm theá naøo gaùn THUOC TINH Picture cuûa
' ñieàu khieån MSHFlexGrid vaøo ñieàu khieån PictureBox

Private Sub Form_Click()
Set Picture1.Picture = MSHFlexGrid1.Picture
End Sub

THUOC TINH COLHEADER

Private Sub Form_Load()
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Cols = 5
MSHFlexGrid1.ColHeader(0) = flexColHeaderOn
MSHFlexGrid1.ColHeaderCaption(0, 1) = "AAAA"
MSHFlexGrid1.ColHeaderCaption(0, 2) = "BBBB"
End Sub

THUOC TINH COLHEADERCAPTION

Private Sub Form_Load()
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Cols = 5
MSHFlexGrid1.ColHeader(0) = flexColHeaderOn
MSHFlexGrid1.ColHeaderCaption(0, 1) = "AAAA"
MSHFlexGrid1.ColHeaderCaption(0, 2) = "BBBB"
End Sub

THUOC TINH COLISVISIBLE

Private Sub Form_Load()
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Cols = 5
MSHFlexGrid1.ColHeader(0) = flexColHeaderOn
MSHFlexGrid1.ColHeaderCaption(0, 1) = "AAAA"
MSHFlexGrid1.ColHeaderCaption(0, 2) = "BBBB"
MsgBox MSHFlexGrid1.ColIsVisible(0)
End Sub

THUOC TINH COLPOS

Private Sub Form_Load()
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Cols = 5
MSHFlexGrid1.ColHeader(0) = flexColHeaderOn
MSHFlexGrid1.ColHeaderCaption(0, 1) = "AAAA"
MSHFlexGrid1.ColHeaderCaption(0, 2) = "BBBB"
MsgBox MSHFlexGrid1.ColPos(1)
End Sub

THUOC TINH COLPOSITION, ROWPOSITION

Private Sub Form_Load()
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Cols = 5
MSHFlexGrid1.ColHeader(0) = flexColHeaderOn
MSHFlexGrid1.ColHeaderCaption(0, 1) = "AAAA"
MSHFlexGrid1.ColHeaderCaption(0, 2) = "BBBB"
End Sub

Sub MSHFlexGrid1_Click()
MSHFlexGrid1.ColPosition( _
MSFlexGrid1.MouseCol) = 1
End Sub

THUOC TINH COLS, ROWS

Private Sub Form_Load()
Dim i As Integer
MSFlexGrid1.Rows = 5
MSFlexGrid1.Cols = 3
For i = 1 To MSFlexGrid1.Rows - 1
MSFlexGrid1.Row = i
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = _
"Welcome to www.huukhang.com"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = _
"You can donwload source code of any Books."
Next
End Sub

THUOC TINH COLSEL, ROWSEL
Private Sub Form_Click()
MSHFlexGrid1.Text = MSHFlexGrid1.ColSel
End Sub

Private Sub Form_Load()
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Cols = 3
MSHFlexGrid1.ColHeader(0) = flexColHeaderOn
MSHFlexGrid1.ColHeaderCaption(0, 1) = "AAAA"
MSHFlexGrid1.ColHeaderCaption(0, 2) = "BBBB"
End Sub

THUOC TINH COLUMN

Private Sub Command1_Click()
With MSChart1
' Trình baøy bieàu ñoà 3 chieàu vôùi 8 columns vaø 8 haøng döõ lieäu
.chartType = VtChChartType3dBar
.ColumnCount = 8
.RowCount = 8
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, index1, _
index2, index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, index1, _
index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH COLUMNCOUNT

Private Sub Command1_Click()
With MSChart1
' Trình baøy bieàu ñoà 3 chieàu vôùi 8 columns vaø 8 haøng döõ lieäu
.chartType = VtChChartType3dBar
.ColumnCount = 8
.RowCount = 8
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, index1, _
index2, index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, index1, _
index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH COLUMNS

Private Sub Form_Load()
Dim I
' Khai baùo bieán
List1.Move 50, 50, 2000, 1750
' saép xeáp hai ñieàu khieån ListBox.
List2.Move 2500, 50, 3000, 1750
For I = 0 To Screen.FontCount - 1
' Ñieàn döõ lieäu vaøo hai ñieàu khieån ListBox vôùi danh saùch Font
‘ cuûa heä thoáng
List1.AddItem Screen.Fonts(I)
' Teân cuûa Font
List2.AddItem Screen.Fonts(I)
Next I
End Sub

THUOC TINH COLWIDTH

Sub MSHFlexGrid1_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
MSHFlexGrid1.Text = MSHFlexGrid1.ColWidth(0)
End Sub

Private Sub Form_Load()
MSHFlexGrid1.AllowUserResizing = True
MSHFlexGrid1.Rows = 5
MSHFlexGrid1.Cols = 3
MSHFlexGrid1.ColHeader(0) = flexColHeaderOn
MSHFlexGrid1.ColHeaderCaption(0, 1) = "AAAA"
MSHFlexGrid1.ColHeaderCaption(0, 2) = "BBBB"
End Sub

THUOC TINH COMMANDTEXT

Private Sub Command1_Click()
' Khai baùo bieán ñoái töôïng ADO
Dim myCon, myCom, i As Integer
' Khôûi taïo ñoái töôïng ADO
Set myCon = CreateObject("ADODB.Connection")
Set myCom = CreateObject("ADODB.Command")
' Môû keát noái CSDL SQL Server
myCon.Open "driver={SQL Server};server=.;Database=Northwind;UID=sa;PWD="
' Khai baùo loaïi caâu leänh
myCom.CommandType = adCmdText
' Khai baùo chuoãi cho THUOC TINH CommandText ñeå theâm khaùch
‘ haøng vaøo baûng Customers
Dim strSQL As String
strSQL = "Insert into Customers(CustomerID,"
strSQL = strSQL & " CompanyName,ContactTitle)"
strSQL = strSQL & " values('" & txtNo & "','"
strSQL=strSQL & txtName & "','" & txtDesc & "')"
myCom.CommandText = strSQL
' Gaén keát noái CSDL
myCom.ActiveConnection = myCon
' Thöïc thi phaùt bieåu SQL daïng Insert

myCom.Execute i
' Ñoùng vaø giaûi phoùng boä nhôù
myCon.Close
Set myRst = Nothing
Set myCon = Nothing
End Sub

Private Sub Form_Load()
' Khôûi taïo giaù trò ñeå theâm vaøo baûng Customers
' trong CSDL Northwind cuûa SQL Server
txtNo = "ASPN"
txtName = "ASP.NET and SQL Server"
txtDesc = "Web Programming with ASP.NET"
End Sub

TÍNH COMMANDTIMEOUT

Private Sub Command1_Click()
' Khai baùo bieán ñoái töôïng ADO
Dim myCon, myCom, i As Integer
' Khôûi taïo ñoái töôïng ADO
Set myCon = CreateObject("ADODB.Connection")
Set myCom = CreateObject("ADODB.Command")
' Môû keát noái CSDL SQL Server
myCon.Open "driver={SQL Server};server=.;Database=Northwind;UID=sa;PWD="
' Khai baùo loaïi caâu leänh
myCom.CommandType = adCmdText
myCom.CommandTimeout=40
' Khai baùo chuoãi cho THUOC TINH CommandText duøng ñeå xoaù
‘ khaùch haøng coù maõ baèng vôùi giaù trò nhaäp treân txtNo
Dim strSQL As String
strSQL = "Delete From Customers Where "
strSQL = strSQL & " CustomerID=’"
strSQL = strSQL & txtNo & "'"
myCom.CommandText = strSQL
' Gaén keát noái CSDL
myCom.ActiveConnection = myCon
' Thöïc thi phaùt bieåu SQL daïng Delete

myCom.Execute i
' Ñoùng vaø giaûi phoùng boä nhôù
myCon.Close
Set myRst = Nothing
Set myCon = Nothing
End Sub

Private Sub Form_Load()
' Khôûi taïo giaù trò ñeå xoaù khaùch haøng trong baûng Customers
' cuûa CSDL Northwind coù maõ laø giaù trò nhaäp trong txtNo
txtNo = "ASPN"
End Sub

THUOC TINH COMMANDTYPE

Private Sub Command1_Click()
' Khai baùo bieán ñoái töôïng ADO
Dim myCon, myCom, i As Integer
' Khôûi taïo ñoái töôïng ADO
Set myCon = CreateObject("ADODB.Connection")
Set myCom = CreateObject("ADODB.Command")
' Môû keát noái CSDL SQL Server
myCon.Open "driver={SQL Server};server=.;Database=Northwind;UID=sa;PWD="
' Khai baùo loaïi caâu leänh
myCom.CommandType = adCmdText
' Khai baùo chuoãi cho THUOC TINH CommandText duøng ñeå xoaù
‘ khaùch haøng coù maõ baèng vôùi giaù trò nhaäp treân txtNo
Dim strSQL As String
strSQL="Update Customers Set CompnayName=’" & _
txtName & "’, ContactTitle=’" & txtDesc & _
"’ Where CustomerID=’" & txtNo & "'"
myCom.CommandText = strSQL
' Gaén keát noái CSDL
myCom.ActiveConnection = myCon
' Thöïc thi phaùt bieåu SQL daïng Delete

myCom.Execute i
' Ñoùng vaø giaûi phoùng boä nhôù
myCon.Close
Set myRst = Nothing
Set myCon = Nothing
End Sub

Private Sub Form_Load()
' Khôûi taïo giaù trò ñeå caäp nhaät khaùch haøng trong baûng Customers
' cuûa CSDL Northwind coù maõ laø giaù trò nhaäp trong txtNo
txtNo = "VBNET"
txtName = "VB.NET and SQL Server"
txtDesc = "Desktop Application with VB.NET"
End Sub

THUOC TINH CONNECT


Private Sub Command1_Click()
' Taïo moät keát noái DSN
' söû duïng ñoái töôïng rdoConnection vaø thieát laäp phaàn töû keát noái
Dim cn As New rdoConnection
Dim qd As New rdoQuery
' Keát noái vôùi CSDL SQL server
cn.Connect = "uid=sa;pwd=;server=.;" _
& "driver={SQL Server};database=Northwind;" _
& "DSN='';"
cn.CursorDriver = rdUseOdbc
cn.EstablishConnection rdDriverNoPrompt
Debug.Print cn.Connect
Set qd.ActiveConnection = cn
cn.Execute "Delete from Customers " & _
" where CustomerID='" & txtNo & "'"
End Sub

Private Sub Form_Load()
' Khôûi taïo giaù trò ñeå xoaù khaùch haøng trong baûng Customers
' cuûa CSDL Northwind coù maõ laø giaù trò nhaäp trong txtNo
txtNo = "ASPN"
End Sub

THUOC TINH CONTAINER

Private Sub Form_Click()
Static intX As Integer
Select Case intX
Case 0
Set Command1.Container = Picture1
Command1.Top = 0
Command1.Left = 0
Case 1
Set Command1.Container = Frame1
Command1.Top = 0
Command1.Left = 0
Case 2
Set Command1.Container = Form1
Command1.Top = 0
Command1.Left = 0
End Select
intX = intX + 1
End Sub

Private Sub Form_Load()
' Khôûi taïo giaù trò ñeå xoaù khaùch haøng trong baûng Customers
' cuûa CSDL Northwind coù maõ laø giaù trò nhaäp trong txtNo
txtNo = "ASPN"
End Sub

THUOC TINH COUNT

Private Sub Form_Load()
Dim a, d, i
Taïo moät soá bieán
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"
Theâm khoaù vaø phaàn töû.
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
a = d.Keys
' Ñoïc khoaù
For i = 0 To d.Count - 1
' Laëp laïi maûng
Debug.Print a(i)
' In ra khoaù
Next
End Sub

' Theâm ListBox vaøo Form1 vaø ñaët teân lstForms
Private Sub Form_Activate()
Dim I
lstForms.Clear
For I = 0 To Forms.Count - 1
lstForms.AddItem Forms(I).Caption
Next I
End Sub

THUOC TINH CURRENTCELLMODIFIED

Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
DataGrid1.CurrentCellModified = False
End If
End Sub

THUOC TINH CURRENTCELLVISIBLE

Private Sub cmdCurCelVis_Click()
DataGrid1.CurrentCellVisible = True
End Sub

Private Sub DataGrid1_AfterColEdit(ByVal ColIndex As Integer)
Dim msgEdited As String
msgEdited = "You changed a cell in column " & ColIndex + 1
msgEdited = msgEdited & ", row " & DataGrid1.Row + 1
MsgBox msgEdited
End Sub

Private Sub Form_Load()
Dim objFont As New StdFont
objFont.Bold = True
objFont.Size = 18
objFont.Name = "Impact"

DataGrid1.HeadFont = objFont
DataGrid1.MarqueeStyle = dbgDottedCellBorder

End Sub

Private Sub Opt_Click(Index As Integer)
Select Case Index
Case 0
DataGrid1.MarqueeStyle = _
dbgDottedCellBorder
Case 1
DataGrid1.MarqueeStyle = dbgSolidCellBorder
Case 2
DataGrid1.MarqueeStyle = dbgHighlightCell
Case 3
DataGrid1.MarqueeStyle = dbgFloatingEditor
Case 4
DataGrid1.MarqueeStyle = dbgHighlightRow
Case 5
DataGrid1.MarqueeStyle = dbgNoMarquee
Case 6
DataGrid1.MarqueeStyle = _
dbgHighlightRowRaiseCell
End Select

End Sub

THUOC TINH CURRENTRECORD

Private Sub Form_Load()
CongfigureADO Adodc1
ConfigureDataRepeater DataRepeater1
End Sub

Private Sub CongfigureADO(adoDC As adoDC)
Dim strPath As String
' Thay ñoåi ñöôøng daãn cuûa cô sôû döõ lieäu
strPath = "C:\NorthWind.MDB"
' Caáu hình cho ñieàu khieån ADODC nhö döõ lieäu nguoàn.
With adoDC
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strPath & _
"; Mode=Read|Write"
.CommandType = adCmdTable
.RecordSource = "Products"
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Mode = adModeRead
.Refresh
End With
End Sub

Private Sub ConfigureDataRepeater(Repeater As DataRepeater)
With Repeater
Set .DataSource = Adodc1
' Gaùn teân cuûa DataRepeater (RepeatedControlName) tröôùc khi
' theâm ñoái töôïng RepeaterBinding vaøo taäp, ngöôïc laïi
‘ DataRepeater khoâng bieát THUOC TINH ñang coù ñeå noái keát.
.RepeatedControlName = _
"RichText.RichTextCtrl"
.RepeaterBindings.Add "Text", "ProductName"
End With
End Sub

THUOC TINH CURSORLOCATION

' Keát noái cô sôû döõ lieäu SQL Server
Private Sub Form_Load()
On Error GoTo err
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
' Khai baùo chuoãi keát noái cô sôû döõ lieäu SQL Server
myStr = "driver={SQL Server};server=.;" & _
" Database=Northwind;UID=sa;PWD="
myCon.Open myStr
myStr = "select * from Customers"
' Khai baùo THUOC TINH CursorLocation
myRst.CursorLocation = adUseClient
myRst.Open myStr, myCon
' Kieåm tra maåu tin toàn taïi?
If myRst.RecordCount > 0 Then
' Neáu coù maåu tin thì trình baøy treân ListBox
Do Until myRst.EOF
List1.AddItem myRst("CustomerID") & _
vbTab & myRst("CompanyName")
myRst.MoveNext
Loop
Else
MsgBox "There is no record"
End If
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
err:
Beep
MsgBox Error
End Sub

' Keát noái cô sôû döõ lieäu Access
Private Sub Command1_Click()
On Error GoTo err
List1.Clear
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
' Khai baùo chuoãi keát noái cô sôû döõ lieäu Access
myStr="Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Program Files\Microsoft " & _
"Office\Office\Samples\Northwind.mdb"
myCon.Open myStr
' Khai baùo THUOC TINH CursorLocation
myRst.CursorLocation = adUseClient
myStr = "select * from Customers"
myRst.Open myStr, myCon, 0, 3
' Kieåm tra coù maåu tin toàn taïi hay khoâng
If myRst.RecordCount > 0 Then
' Neáu coù maåu tin thì trình baøy treân ListBox
Do Until myRst.EOF
List1.AddItem myRst("CustomerID") & _
vbTab & myRst("CompanyName")
myRst.MoveNext
Loop
Else
MsgBox "There is no record"
End If
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
err:
Beep
MsgBox Error
End Sub

THUOC TINH CURSORTYPE

' Keát noái cô sôû döõ lieäu Access
Private Sub Form_Load()
On Error GoTo err
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
' Khai baùo chuoãi keát noái cô sôû döõ lieäu Access
myStr="Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Program Files\Microsoft " & _
"Office\Office\Samples\Northwind.mdb"
myCon.Open myStr
' Khai baùo THUOC TINH CursorType
myRst.CursorType = adOpenDynamic
myRst.LockType = adLockOptimistic
myStr = "Customers"
myRst.Open myStr, myCon
myRst.AddNew
myRst("CustomerID") = txtNo
myRst("CompanyName") = txtName
myRst("ContactTitle") = txtDesc
myRst.Update
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
err:
Beep
MsgBox Error
End Sub

' Keát noái cô sôû döõ lieäu SQL Server
Private Sub Form_Load()
On Error GoTo err
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
' Khai baùo chuoãi keát noái cô sôû döõ lieäu SQL Server
myStr = "driver={SQL Server};server=.;" & _
" Database=Northwind;UID=sa;PWD="
myCon.Open myStr
' Khai baùo THUOC TINH CursorType
myRst.CursorType = adOpenDynamic
myRst.LockType = adLockOptimistic
myStr = "Customers"
myRst.Open myStr, myCon
myRst.AddNew
myRst("CustomerID") = txtNo
myRst("CompanyName") = txtName
myRst("ContactTitle") = txtDesc
myRst.Update
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
err:
Beep
MsgBox Error
End Sub

THUOC TINH CUSTOMFORMAT

‘ Maûng baét ñaàu phaàn töû thöù 1
Option Base 1
‘ Khai baùo maûng
Private sSpanishMonthLong(12) As String

‘ Khai baùo ñònh daïng ñieàu khieån DateTimePicker
Private Sub DTPicker1_Format( _
ByVal CallbackField As String, _
FormattedString As String)
If CallbackField = "XXXX" Then
FormattedString = _
sSpanishMonthLong(DTPicker1.Month)
End If
End Sub

‘ Ñieàu chænh ñieàu khieån DateTimePicker
Private Sub DTPicker1_FormatSize( _
ByVal CallbackField As String, Size As Integer)
Dim iMaxMonthLen As Integer

If CallbackField = "XXXX" Then
iMaxMonthLen = 0
For I = 1 To 12
If iMaxMonthLen < _
Len(sSpanishMonthLong(I)) Then
iMaxMonthLen = Len(sSpanishMonthLong(I))
End If
Next
End If
Size = iMaxMonthLen
End Sub

Private Sub Form_Load()
DTPicker1.CustomFormat = "MMMM(XXXX) dd, yyy"
DTPicker1.Format = dtpCustom

sSpanishMonthLong(1) = "Enero"
sSpanishMonthLong(2) = "Febrero"
sSpanishMonthLong(3) = "Marzo"
sSpanishMonthLong(4) = "Abril"
sSpanishMonthLong(5) = "Mayo"
sSpanishMonthLong(6) = "Junio"
sSpanishMonthLong(7) = "Julio"
sSpanishMonthLong(8) = "Agosto"
sSpanishMonthLong(9) = "Septiembre"
sSpanishMonthLong(10) = "Octubre"
sSpanishMonthLong(11) = "Noviembre"
sSpanishMonthLong(12) = "Diciembre"
End Sub

THUOC TINH DATA

Private Sub Command1_Click()
With MSChart1
' Trình baøy bieåu ñoà 3 chieàu vôùi 8 coät vaø 8 haøng döõ lieäu
.chartType = VtChChartType3dBar
.ColumnCount = 8
.RowCount = 8
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, _
index1, index2, index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, index1, _
index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH DATABASE

Sub PrintTableNames()
Dim Td As TableDef
' Gaùn teân cô sôû döõ lieäu
Data1.DatabaseName = "BIBLIO.MDB"
Data1.Refresh
' Môû cô sôû döõ lieäu, sau ñoù ñoïc vaø in ra teân cuûa töøng ñoái töôïng.
' baûng toàn taïi trong cô sôû döõ lieäu
For Each Td In Data1.Database.TableDefs
Debug.Print Td.Name
Next
End Sub

THUOC TINH DATABASENAME

Sub PrintTableNames()
Dim Td As TableDef
' Gaùn teân cô sôû döõ lieäu
Data1.DatabaseName = "BIBLIO.MDB"
Data1.Refresh
' Môû cô sôû döõ lieäu, sau ñoù ñoïc vaø in ra teân cuûa töøng ñoái töôïng.
' baûng toàn taïi trong cô sôû döõ lieäu
For Each Td In Data1.Database.TableDefs
Debug.Print Td.Name
Next
End Sub

THUOC TINH DATAFIELD

Sub Command1_Click()
Adodc1.RecordSource = "Select AVG(Sales)" _
& " AS AverageSales From SalesTable"
Text1.DataField = "AverageSales"
Adodc1.Refresh
End Sub

THUOC TINH DATASOURCE

Sub Command1_Click()
Data.RecordSource = "Select AVG(Sales)" _
& " AS AverageSales From SalesTable"
Set Text1.DataSource = Data1

End Sub

THUOC TINH DATECREATED

Sub Command1_Click()
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
‘ Ñoïc teân taäp tin nhaäp trong Text1
Set f = fs.GetFile(Text1.Value)
s = "Created: " & f.DateCreated
MsgBox s
End Sub

THUOC TINH DATELASTACCESSED

Sub Command1_Click()
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
‘ Ñoïc teân taäp tin nhaäp trong Text1
Set f = fs.GetFile(Text1.Value)
s = "LastAccessed: " & f.DateLastAccessed
MsgBox s
End Sub

THUOC TINH DATELASTMODIFIED

Sub Command1_Click()
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
‘ Ñoïc teân taäp tin nhaäp trong Text1
Set f = fs.GetFile(Text1.Value)
s = "LastModified: " & f.DateLastModified
MsgBox s
End Sub

THUOC TINH DAY

Private Sub Form_Load()
Me.MonthView1.Day = 3
End Sub

THUOC TINH DAYBOLD

Private Sub Form_Load()
With MonthView1
.DayBold(MonthView1.VisibleDays(1)) = True
.DayBold(MonthView1.VisibleDays(42)) = True
End With
End Sub

THUOC TINH DAYOFWEEK

Private Sub MonthView1_SelChange( _
ByVal StartDate As Date, _
ByVal EndDate As Date, Cancel As Boolean)

Select Case MonthView1.DayOfWeek
Case 1
Label1.Caption = "You selected a Sunday."
Case 2
Label1.Caption = "You selected a Monday."
Case 3
Label1.Caption = "You selected a Tuesday."
Case 4
Label1.Caption = "You selected a Wednesday."
Case 5
Label1.Caption = "You selected a Thursday."
Case 6
Label1.Caption = "You selected a Friday."
Case 7
Label1.Caption = "You selected a Saturday."
End Select
End Sub

THUOC TINH DEFAULT

Private Sub Form_Load()
Me.Command1.Default = True
End Sub

THUOC TINH DESCRIPTOIN

Private Sub Form_Load()
On Error GoTo err
Dim btnX As Button
' Theâm Button vôùi khoaù laø "save."
Set btnX = Toolbar1.Buttons.Add(, "save")
btnX.Description = "Save a file."
Exit Sub
err:
MsgBox err.Description
Beep
End Sub

THUOC TINH DIALOGTITLE

Private Sub Command1_Click()
' Gaùn CancelError baèng True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Gaùn flags
CommonDialog1.Flags = cdlOFNHideReadOnly
' gaùn THUOC TINH loïc taäp tin
CommonDialog1.Filter = _
"All Files (*.*)|*.*|Text Files" & _
"(*.txt)|*.txt|Batch Files (*.bat)|*.bat"
' Chæ ñònh loaïi taäp tin maëc ñònh
CommonDialog1.FilterIndex = 2
' Hieån thò töïa ñeà
CommonDialog1.DialogTitle=”Download file”
' Hieån thò hoäp hoäi thoaïi Open
CommonDialog1.ShowOpen
' Lieät keâ danh saùch taäp tin choïn loïc
MsgBox CommonDialog1.FileName
Exit Sub

ErrHandler:
Exit Sub
End Sub

THUOC TINH DOCUMENT


Private Sub btnGetHTMLDoc_Click()
With Inet1
.URL = "http://www.huukhang.com/"
.Document = " popupsubcribe.htm "
.Execute , "GET"
End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
Dim strHTML As String
Dim vtData As String
Select Case state
' Tröôøng hôïp khaùc thì khoâng trình baøy
Case icResponseCompleted
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
strHTML = strHTML & vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
txtHTML.Text = strHTML
End Select
End Sub

THUOC TINH DRIVE (ÑIEÀU KHIEÅN DRIVELISTBOX)

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
' Khi oå ñóa thay ñoåi.
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
' Khi htö muïc thay ñoåi
End Sub

THUOC TINH DRIVE (ÑOÁI TÖÔÏNG FILE VAØ FOLDER)

Private Sub Command1_Click()
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = f.Name & " on Drive " & UCase(f.Drive) & _
vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & _
f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
MsgBox s, 0, "File Access Info"
End Sub

THUOC TINH DRIVELETTER (ÑOÁI TÖÔÏNG DRIVE)

Private Sub Command1_Click()
Dim fs, d, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(drvPath))
s = "Drive " & d.DriveLetter & ": - "
s = s & d.VolumeName & vbCrLf
s = s & "Free Space: " & _
FormatNumber(d.FreeSpace / 1024, 0)
s = s & " Kbytes"
MsgBox s
End Sub

THUOC TINH DRIVENAME

Private Sub Command1_Click()
Dim X As Printer
For Each X In Printers
Debug.Print X.DriverName
If X.Orientation = vbPRORPortrait Then
' Gaùn maùy in maëc ñònh
Set Printer = X
' Ngöøng tìm kieám maùy in
Exit For
End If
Next
End Sub

THUOC TINH DRIVES

Private Sub Command1_Click()
On Error Resume Next
Dim fs, d, dc, s, n
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
s = s & d.DriveLetter & " - "
If d.DriveType = 3 Then
n = d.ShareName
Else
n = d.VolumeName
End If
s = s & n & vbCrLf
Next
MsgBox s
End Sub

THUOC TINH DRIVETYPE

Private Sub Command1_Click()
Dim fs, d, s, t
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive("C:\")
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
s = "Drive " & d.DriveLetter & ": - " & t
MsgBox s
End Sub

THUOC TINH EFFECT

Private Sub Command1_Click()
' Yeâu caàu ngöôøi söû duïng cung caáp töïa ñeà.
MSChart1.Title.Text = InputBox("Title?")
' Hieån thò töïa ñeà cuûa bieåu ñoà
MSChart1.Title.Location.Visible = True
' Gaùn Font cho Chart Title.
With MSChart1.Title.VtFont
.Name = "Times New Roman"
.Size = 18
.Style = VtFontStyleBold Or _
VtFontStyleItalic
' Söû duïng caû hai hieäu öùng StrikeThrough vaø Underline cho
' chuoãi trình baøy t.
.Effect = VtFontEffectStrikeThrough Or _
VtFontEffectUnderline
' Gaùn maøu Blue cho chuoãi.
.VtColor.Set 0, 0, 255
End With
End Sub

THUOC TINH ELEVATION
THUOC TINH Elevation traû veà hay gaùn giaù trò laø goùc ñoä quay 3 chieàu cuûa ñoái töôïng View3D cho ñieàu khieån MSChart.
Cuù phaùp:
object.Elevation [=number]
Dieãn giaûi:
THUOC TINH naøy bao goàm caùc phaàn sau:

Tham soá Dieãn giaûi
---------------------------------------------- object Ñoái töôïng View3D ñöôïc aùp duïng
laø ñieàu khieån MSChart.

number Soá nguyeân öùng vôùi haèng hôïp leä
töø 0 ñeán 90 ñoä.
----------------------------------------------

Ví duï:
Ñeå söû duïng THUOC TINH naøy, baïn theâm ñieàu khieån MSChart vaø CommandButton vaøo Form1 nhö ví duï sau.

Private Sub Command1_Click()
' Gaùn ChartType laø 3 D
MSChart1.chartType = VtChChartType3dBar
With MSChart1.Plot.View3d
.Elevation = 90
' Nhìn tröïc tieáp xuoáng phaàn ñaàu cuûa Chart
.Rotation = 90
End With
End Sub

THUOC TINH ENABLED

Private Sub Form_Load()
Me.MonthView1.Enabled = False
End Sub

THUOC TINH ERRORNUMBER

Private Sub DataReport_Error(ByVal JobType As _
MSDataReportLib.AsyncTypeConstants, _
ByVal Cookie As Long, ByVal ErrObj As _
MSDataReportLib.RptError, _
ShowError As Boolean)
Dim lngFileNum As Long
lngFileNum = FreeFile()
Open "C:\Temp\DataReportError.txt" _
For Output As #lngFileNum
Print #lngFileNum, JobType, _
ErrObj.ErrorNumber, _
ErrObj.Description, ErrObj.Source
Close #lngFileNum
End Sub

THUOC TINH EXPORTFORMAT

Private Sub ExportDailyReport()
DataReport1.Title = "Daily Report"
' Title xuaát hieän treân Report
Dim strTemplate As String
' Taïo moät template.
strTemplate = _
"<HTML>" & vbCrLf & _
"<HEAD>" & vbCrLf & _
"<TITLE>" & "MyCompany: " & rptTagTitle & _
"</TITLE>" & vbCrLf & _
"<BODY>" & vbCrLf & _
rptTagBody & vbCrLf & _
"<BODY>" & vbCrLf & _
"</HTML>"

' Theâm môùi ñoái töôïng ExportFormat baèng caùch söû duïng template.
DataReport1.ExportFormats.Add _
Key:="DailyReport", _
FormatType:=rptFmtHTML, _
FileFormatString:="Daily Report (*.htm)", _
FileFilter:="*.HTM", _
Template:=strTemplate

' Xuaát report baèng caùch söû duïng ñoái töôïng ExportFormat
DataReport1.ExportReport _
FormatIndexOrKey:="DailyReport", _
FileName:="C:\Temp\DailyRpt", _
Overwrite:=True, _
ShowDialog:=False, _
Range:=rptRangeFromTo, _
Pagefrom:=1, _
Pageto:=10
End Sub

THUOC TINH FILES

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("D:\Baiday")
Set fc = f.Files
For Each f1 In fc
s = s & f1.Name
s = s & vbCrLf
Next
MsgBox s
End Sub

THUOC TINH FILESYSTEM

Private Sub Command1_Click()
Dim fs, d, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive("C:")
s = d.FileSystem
MsgBox s
End Sub

THUOC TINH FILL

Private Sub Command1_Click()
With MSChart1.Backdrop.Fill
' Toâ maøu neàn cuûa ñieàu khieån MSChart
.Style = VtFillStyleBrush
.Brush.Style = VtBrushPattern50Percent
End With
End Sub

THUOC TINH FILLCOLOR

Private Sub Form_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
FillColor = QBColor(Int(Rnd * 15))
' Choïn maøu ngaãu nhieân.
FillStyle = Int(Rnd * 8)
' Choïn kieåu ngaãu nhieân.
Circle (X, Y), 250
' Veõ hình troøn.
End Sub

Private Sub Command1_Click()
MSChart1.Backdrop.Fill.Style = _
VtFillStyleBrush
With MSChart1.Backdrop.Fill.Brush.FillColor
.Red = 255
.Green = 0
.Blue = 0
End With
End Sub

THUOC TINH FILTER

Private Sub Command1_Click()
With CommonDialog1
.Filter = "avi (*.avi)|*.avi"
.ShowOpen
End With
With Animation1
.Autoplay = True
.Open CommonDialog1.FileName
End With
End Sub

THUOC TINH FIXEDBACKGROUND

Private Sub Command1_Click()
If cbrMain.Bands(1).FixedBackground = True Then
' Gaùn hình chia moãi Band
cbrMain.Bands(1).FixedBackground = False
cbrMain.Bands(2).FixedBackground = False
cbrMain.Bands(3).FixedBackground = False
Else
' Gaùn hình cho moïi Band
cbrMain.Bands(1).FixedBackground = True
cbrMain.Bands(2).FixedBackground = True
cbrMain.Bands(3).FixedBackground = True
End If
End Sub

THUOC TINH FIXEDCOL, FIXEDROW

Sub Form1_Load()
MSHFlexGrid1.FixedCols = 2
MSHFlexGrid1.FixedRows = 1
End Sub

THUOC TINH FIXEDORDER

Private Sub Command1_Click()
cbrMain.FixedOrder=True
If cbrMain.Bands(1).FixedBackground = True Then
' Gaùn hình chia moãi Band
cbrMain.Bands(1).FixedBackground = False
cbrMain.Bands(2).FixedBackground = False
cbrMain.Bands(3).FixedBackground = False
Else
' Gaùn hình cho moïi Band
cbrMain.Bands(1).FixedBackground = True
cbrMain.Bands(2).FixedBackground = True
cbrMain.Bands(3).FixedBackground = True
End If
End Sub

THUOC TINH FOCUSRECT

Sub Form1_Load()
MSFlexGrid1.FocusRect =flexFocusLight
End Sub

THUOC TINH FONT

Private Sub Command1_Click()
txtName.Font.Bold = True
MSChart1.Title.Font.Bold = True
End Sub

THUOC TINH FONTBOLD, FONTITALIC, FONTSTRIKETHRU, FONTUNDERLINE

Private Sub Form_Load()
txtNo.FontItalic = True
txtName.FontStrikethru = True
End Sub

THUOC TINH FONTCOUNT

Private Sub Command1_Click()
Dim I
' Khai baùo bieán
For I = 0 To Printer.FontCount - 1
' Soá löôïng Font.
List1.AddItem Printer.Fonts(I)
' Gaùn Font vaøo ñieàu khieån ListBox.
Next I
End Sub

THUOC TINH FONTNAME

Private Sub Command1_Click()
Static I
' Khai baùo bieán
Dim OldFont
OldFont = FontName
' Giöõ laïi Font cuûa ñoái töôïng Screen
FontName = Screen.Fonts(I)
' Thay ñoåi Font môùi.
Print Screen.Fonts(I)
' In teân cuûa Font.
I = I + 1
' taêng soá ñeám
If I = FontCount Then I = 0
FontName = OldFont
' Phuïc hoà Font tröôùc ñoù
End Sub

THUOC TINH FONTS

Private Sub Command1_Click()
Dim I
' Khai baùo bieán
For I = 0 To Printer.FontCount - 1
' Soá löôïng Font.
List1.AddItem Printer.Fonts(I)
' Gaùn Font vaøo ñieàu khieån ListBox.
Next I
End Sub

THUOC TINH FONTSIZE

Private Sub Command1_Click()
FontSize = 24
' Gaùn FontSize.
Print "This is 24-point type."
' In kích thöôùc lôùn
FontSize = 8
' In FontSize.
Print "This is 8-point type."
End Sub

THUOC TINH FONTWIDTH, FONTWIDTHBAND, FONTWIDTHFIXED, FONTWIDTHHEADER

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontItalic = 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
MSHFlexGrid1.FontWidth = 8
End Sub

THUOC TINH FORECOLOR, FORECOLORBAND, FORECOLORFIXED, FORECOLORHEADER, FORECOLORSEL

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontItalic = 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
MSHFlexGrid1.FontWidth = 8
MSHFlexGrid1.ForeColor = QBColor(Rnd * 15)
End Sub

THUOC TINH FORMAT

Private Sub Form_Load()
Me.DTPicker1.Format = dtpLongDate
End Sub

THUOC TINH FORMATSTRING

Private Sub Form_Load()
' Gaùn töïa ñeà cho 4 coät cuûa haøng 0
s$ = "<Region |<Product |<Employee |>Sales "
MSHFlexGrid1.FormatString = s$

' Gaùn töïa ñeà 5 haøng cuûa coät thöù 0
s$ = _
";Name|Address|Telephone|Social Security#"
MSHFlexGrid2.FormatString = s$

' Gaùn töïa ñeà cho 5 coät cuûa haøng 0 vaø
‘ Gaùn töïa ñeà 4 haøng cuûa coät thöù 0.
s$ = _
"|Name|Address|Telephone|Social Security#"
s$ = s$ + ";|Robert|Jimmy|Bonzo|John Paul"
MSHFlexGrid3.FormatString = s$
End Sub

THUOC TINH FORMATTYPE

Private Sub ExportDailyReport()
DataReport1.Title = "Daily Report"
' Title xuaát hieän treân Report
Dim strTemplate As String
' Taïo moät template.
strTemplate = _
"<HTML>" & vbCrLf & _
"<HEAD>" & vbCrLf & _
"<TITLE>" & "MyCompany: " & rptTagTitle & _
"</TITLE>" & vbCrLf & _
"<BODY>" & vbCrLf & _
rptTagBody & vbCrLf & _
"<BODY>" & vbCrLf & _
"</HTML>"

' Theâm môùi ñoái töôïng ExportFormat baèng caùch söû duïng template.
DataReport1.ExportFormats.Add _
Key:="DailyReport", _
FormatType:=rptFmtHTML, _
FileFormatString:="Daily Report (*.htm)", _
FileFilter:="*.HTM", _
Template:=strTemplate

' Xuaát report baèng caùch söû duïng ñoái töôïng ExportFormat
DataReport1.ExportReport _
FormatIndexOrKey:="DailyReport", _
FileName:="C:\Temp\DailyRpt", _
Overwrite:=True, _
ShowDialog:=False, _
Range:=rptRangeFromTo, _
Pagefrom:=1, _
Pageto:=10
End Sub

THUOC TINH FREESPACE

Private Sub Command1_Click()
Dim fs, d, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName("C:\"))
s = "Drive " & UCase(drvPath) & " - "
s = s & d.VolumeName & vbCrLf
s = s & "Free Space: " & _
FormatNumber(d.FreeSpace / 1024, 0)
s = s & " Kbytes"
MsgBox s
End Sub

THUOC TINH FROMPAGE, TOPAGE

Private Sub Command1_Click()
Dim BeginPage, EndPage, NumCopies, i
' Gaùn THUOC TINH Cancel baèng True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Trình baøy Print dialog
CommonDialog1.ShowPrinter
' Laáy giaù trò ngöôøi söû duïng choïn dialog box
BeginPage = CommonDialog1.FromPage
EndPage = CommonDialog1.ToPage
NumCopies = CommonDialog1.Copies
For i = 1 To NumCopies
' Baïn coù theå vieát maõ ôû ñaây ñeå gôûi döõ lieäu ñeán printer
Next i
Exit Sub
ErrHandler:
' ngöôøi söû duïng nhaán nuùt Cancel
Exit Sub
End Sub

THUOC TINH FULLPATH

Private Sub Form_Load()
Dim nodX As Node
Set nodX = tvw1.Nodes.Add(, , , "Root")
Set nodX = tvw1.Nodes.Add(1, tvwChild, , "Dir1")
Set nodX = tvw1.Nodes.Add(2, tvwChild, , "Dir2")
Set nodX = tvw1.Nodes.Add(3, tvwChild, , "Dir3")
Set nodX = tvw1.Nodes.Add(4, tvwChild, , "Dir4")
nodX.EnsureVisible
' Trình baøy taát caû caùc Node.
tvw1.Style = tvwTreelinesText
' Loaïi 4.
End Sub

Private Sub tvw1_NodeClick(ByVal Node As Node)
MsgBox Node.FullPath
End Sub

THUOC TINH FULLROWSELECT

Private Sub Form_Load()
ListView1.FullRowSelect = True
End Sub

THUOC TINH GREEN

Private Sub Command1_Click()
MSChart1.Backdrop.Fill.Style = _
VtFillStyleBrush
' Gaùn chart toâ maøu ñoû.
With MSChart1.Backdrop.Fill.Brush.FillColor
.Red = 255
' söû duïng THUOC TINH ñeå gaùn maøu.
.Green = 0
.Blue = 0
End With
End Sub

THUOC TINH GRIDCOLOR, GRIDCOLORBAND, GRIDCOLORFIXED, GRIDCOLORHEADER, GRIDCOLORINDENT, GRIDCOLORUNPOPULATED

Private Sub Form_Load()
Timer1.Interval = 500
MSHFlexGrid1.Text = "Focus Here"
End Sub

Private Sub Timer1_Timer()
MSHFlexGrid1.CellFontItalic = 1
MSHFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSHFlexGrid1.CellForeColor = QBColor(Rnd * 10)
MSHFlexGrid1.FontWidth = 8
MSHFlexGrid1.GridColor = QBColor(Rnd * 15)
End Sub

THUOC TINH GRIDLINES

Private Sub Form_Load()
Me.ListView1.GridLines = True
End Sub

THUOC TINH GRIDLINEWIDTH

Private Sub Form_Load()
Me.MSFlexGrid1.GridLineWidth = 3
End Sub

THUOC TINH HEADFONT

Private Sub cmdCurCelVis_Click()
DataGrid1.CurrentCellVisible = True
End Sub

Private Sub DataGrid1_AfterColEdit(ByVal _
ColIndex As Integer)
Dim msgEdited As String
msgEdited = _
"You changed a cell in column " & ColIndex + 1
msgEdited = msgEdited & ", row " & _
DataGrid1.Row + 1
MsgBox msgEdited
End Sub

Private Sub Form_Load()
Dim objFont As New StdFont
objFont.Bold = True
objFont.Size = 18
objFont.Name = "Impact"

DataGrid1.HeadFont = objFont
DataGrid1.MarqueeStyle = dbgDottedCellBorder

End Sub

Private Sub Opt_Click(Index As Integer)
Select Case Index
Case 0
DataGrid1.MarqueeStyle = dbgDottedCellBorder
Case 1
DataGrid1.MarqueeStyle = dbgSolidCellBorder
Case 2
DataGrid1.MarqueeStyle = dbgHighlightCell
Case 3
DataGrid1.MarqueeStyle = dbgFloatingEditor
Case 4
DataGrid1.MarqueeStyle = dbgHighlightRow
Case 5
DataGrid1.MarqueeStyle = dbgNoMarquee
Case 6
DataGrid1.MarqueeStyle = dbgHighlightRowRaiseCell
End Select

End Sub

THUOC TINH HEADLINE

Private Sub cmdCurCelVis_Click()
DataGrid1.CurrentCellVisible = True
End Sub

Private Sub DataGrid1_AfterColEdit(ByVal _
ColIndex As Integer)
Dim msgEdited As String
msgEdited = _
"You changed a cell in column " & ColIndex + 1
msgEdited = msgEdited & ", row " & _
DataGrid1.Row + 1
MsgBox msgEdited
End Sub

Private Sub Form_Load()
Dim objFont As New StdFont
objFont.Bold = True
objFont.Size = 18
objFont.Name = "Impact"

DataGrid1.HeadFont = objFont
DataGrid1.HeadLine = 2
DataGrid1.MarqueeStyle = dbgDottedCellBorder

End Sub

THUOC TINH HEIGHT, WIDTH

Private Sub Form_Click()
Width = Screen.Width * 0.75
' Gaùn THUOC TINH width cuûa form.
Height = Screen.Height * 0.75
' Gaùn THUOC TINH height cuûa form.
Left = (Screen.Width - Width) / 2
' Canh leà form theo chieàu ngang.
Top = (Screen.Height - Height) / 2
' Canh giöõa theo chieàu doïc.
End Sub

THUOC TINH HELPCOMMAND

Option Explicit
Const HelpCNT = &HB

Private Sub Command1_Click()
With CommonDialog1
' Gaùn teân taäp tin Help.
' Thay ñoåi taäp tin help treân ñóa cöùng.
.HelpFile = "VB5.hlp"
' Trình baøy baûng noäi dung
' Hieån thò baûng noäi dung (khoâng coù phaàn Index hay Find)
.HelpCommand = HelpCNT Or cdlHelpSetContents
.ShowHelp
End With

End Sub

Private Sub Command2_Click()
With CommonDialog1
.HelpFile = "VB5.hlp"
' Trong bieán coá Click treân taäp tin Help.
.HelpContext = 916302
.HelpCommand = cdlHelpContext
.ShowHelp
End With
End Sub

Private Sub Command3_Click()
With CommonDialog1
.HelpFile = "VB5.hlp"
' Trình baøy phaàn trôï giuùp treân Help.
.HelpCommand = cdlHelpHelpOnHelp
.ShowHelp
End With
End Sub

Private Sub Command4_Click()
With CommonDialog1
.HelpFile = "VB5.hlp"
.HelpKey = "data"
' Trình baøy Index vôùi töø khoaù choïn loïc.
.HelpCommand = cdlHelpKey
.ShowHelp
End With
End Sub

Private Sub Command5_Click()
With CommonDialog1
.HelpFile = "VB5.hlp"
.HelpKey = "arrays,"
' Trình baøy moät danh saùch tìm thaáy trong HelpKey.
.HelpCommand = cdlHelpPartialKey
.ShowHelp
End With

End Sub

Private Sub Form_Load()
' Khai baùo nhaõn cho ñieàu khieån CommandButton.
Command1.Caption = "Contents"
Command2.Caption = "Specified Topic"
Command3.Caption = "Help On Help"
Command4.Caption = "Index of Topics"
Command5.Caption = "Found Topics"
End Sub

THUOC TINH HELPCONTEXT

Private Sub Command5_Click()
Dim Msg
err.Clear
On Error Resume Next
err.Raise 6 ' Generate "Overflow" error.
If err.Number <> 0 Then
Msg = "Press F1 or HELP to see " & err.HelpFile & " topic for" & _
" the following HelpContext: " & err.HelpContext
MsgBox Msg, , "Error: " & err.Description, _
err.HelpFile, err.HelpContext
End If
End Sub

THUOC TINH HELPFILE

Private Sub Command5_Click()
Dim Msg
err.Clear
On Error Resume Next
err.Raise 6 ' Generate "Overflow" error.
If err.Number <> 0 Then
Msg = "Press F1 or HELP to see " & _
err.HelpFile & " topic for" & _
" the following HelpContext: " & _
err.HelpContext
MsgBox Msg, , "Error: " & err.Description, _
err.HelpFile, err.HelpContext
End If
End Sub

THUOC TINH HOUR

Private Sub Form_Load()
Me.MonthView1.Hour = 3
End Sub

THUOC TINH ICON (FORM)

Private Sub Form_Resize()
Dim X, Y
' Khai baùo bieán.
If Form1.WindowState = vbMinimized Then
Form1.Icon = LoadPicture()
' Naïp vaøo bieåu töôïng toãng
Do While Form1.WindowState = vbMinimized
' Trong khi Form ôû cheá ñoä thu nhoû
Form1.DrawWidth = 10
' Gaùn kích thöôùc vaø maøu ngaãu nhieân cho chaám treân gorm.
Form1.ForeColor = QBColor(Int(Rnd * 15))
' Vò trí cho bieåu töôïng
X = Form1.Width * Rnd
Y = Form1.Height * Rnd
PSet (X, Y)
' Veõ dot treân bieåu töôïng.
DoEvents
' Cho pheùp caùc baèng caùch khaùc thöïc hieân.
Loop
End If
End Sub

‘ Trong tröôøng hôïp baïn muoán naïp moät bieåu töôïng coù saüng,
‘ baïn coù theå khai baùo nhö ví duï sau.
Private Sub Form_Resize()
Dim X, Y
' Khai baùo bieán
If Form1.WindowState = vbMinimized Then
Form1.Icon = LoadPicture("c:\myicon.ico")
' bieåu töôïng coù teân "myicon.ico" naèm trong thö muïc
' c:\ directory
End If
End Sub

THUOC TINH ICON (COMMON DIALOG)

Private Sub Form_Load()
' Giaû söû raèng ñieàu khieån ImageList coù ít nhaát moät Icon
Dim c As ColumnHeader
Dim i As Integer
For i = 1 To 4
' Taïo 4 ñoái töôïng ColumnHeader.
ListView1.ColumnHeaders.Add , , "Col " & i
Next i
ListView1.View = lvwReport
ImageList1.ListImages(1).Key = "Key1"
' Gaùn THUOC TINH Key cuûa ListImage.
ListView1.ColumnHeaderIcons = ImageList1
For Each c In ListView1.ColumnHeaders
c.Icon = "Key1"
Next
End Sub

THUOC TINH ICON, SMALLICON (LISTITEM)

Private Sub Option1_Click(Index As Integer)
' Gaùn THUOC TINH View cho ñieàu khieån ListView öùng vôùi THUOC TINH
' Index cuûa ñieàu khieån Option1
ListView1.View = Index
End Sub

Private Sub Form_Load()
' Taïo bieán ñoái töôïng cho ColumnHeader.
Dim clmX As ColumnHeader
' Theâm ColumnHeaders. Vôùi chieàu roäng cuûa coät laø chieàu roäng
' ñieàu khieån chia cho soá ñoái töôïng ColumnHeader.
Set clmX = ListView1.ColumnHeaders. _
Add(, , "Company", ListView1.Width / 3)
Set clmX = ListView1.ColumnHeaders. _
Add(, , "Address", ListView1.Width / 3)
Set clmX = ListView1.ColumnHeaders. _
Add(, , "Phone", ListView1.Width / 3)

ListView1.BorderStyle = ccFixedSingle
' Gaùn THUOC TINH BorderStyle
ListView1.View = lvwReport
' Gaùn THUOC TINH View laø Report.

' Theâm moät image vaøo ImageList1
Dim imgX As ListImage
Set imgX = ImageList1.ListImages. _
Add(, , LoadPicture("icons\mail\mail01a.ico"))
' Theâm moät image vaøo ImageList2.
Set imgX = ImageList2.ListImages. _
Add(, , LoadPicture("bitmaps\assorted\w.bmp"))

' söû duïng ñieàu khieån ImageList vôùi ñieàu khieån ListView
' baïn gaùn hai THUOC TINH Iconsvaø SmallIcons cho phuø hôïp.
ListView1.Icons = ImageList1
ListView1.SmallIcons = ImageList2
' Nhaõn cuûa ñieàu khieån OptionButton vôùi tuyø choïn View.
Option1(0).Caption = "Icon"
Option1(1).Caption = "SmallIcon"
Option1(2).Caption = "List"
Option1(3).Caption = "Report"
ListView1.View = lvwIcon
' Gaùn vaøo Icon vaø taïo bieán ñoái töôïng Data Access Objects (DAO).
Dim myDb As Database, myRs As Recordset
' vôùi cô sôû döõ lieäu BIBLIO.MDB.
Set myDb = _
DBEngine.Workspaces(0).OpenDatabase( _
"BIBLIO.MDB")
' Söû duïng baûng döõ lieäu Publishers.
Set myRs = myDb.OpenRecordset("Publishers", _
dbOpenDynaset)

' Taïo bieán ñeå theâm vaøo ñoái töôïng ListItem.
Dim itmX As ListItem

' Trong khi chöa truy caäp ñeán maåu tin cuoái cuøng thì theâm.
' vaøo ñoái töôïng ListItem, söû duïng tröôøng Name cho THUOC TINH
‘ Text cuûa ñoái töôïng ListItem
' söû duïng tröôøng Address öùng vôùi SubItem(1) cuûa ñoái töôïng
‘ ListItem, söû duïng tröôøng Phone cho SubItem(2) cuûa ñoái töôïng
‘ ListItem
While Not myRs.EOF

Set itmX = ListView1.ListItems.Add(, , _
CStr(myRs!Name))
itmX.Icon = 1
' Gaùn icon töø ñieàu khieån ImageList1.
itmX.SmallIcon = 1
' Gaùn icon töø ñieàu khieån ImageList2.

' Neáu tröôøng Address khaùc Null, gaùn SubItem 1 coù giaù trò laø
‘ tröôøng naøy.
If Not IsNull(myRs!Address) Then
itmX.SubItems(1) = CStr(myRs!Address)
End If

' Neáu tröôøng Phone khaùc Null, gaùn SubItem 2 coù giaù trò laø
‘ tröôøng naøy.
If Not IsNull(myRs!Telephone) Then
itmX.SubItems(2) = myRs!Telephone
End If

myRs.MoveNext
' Di chuyeån ñeán maåu tin keá tieáp.
Wend
End Sub

THUOC TINH IMAGE

Private Sub Form_Load()
' Gaøn THUOC TINH AutoRedraw baèng True.
Picture1.AutoRedraw = True
End Sub

Private Sub Picture1_Click()
' Khai baùo bieán
Dim PW, PH
' Gaùn THUOC TINH FillStyle baèng Solid.
Picture1.FillStyle = vbFSSolid
' Choïn maøu ngaãu nhieân
Picture1.FillColor = QBColor(Int(Rnd * 15))
PW = Picture1.ScaleWidth
' Gaùn chieàu roäng
PH = Picture1.ScaleHeight
' Gaùn chieàu cao
' Veõ voøng troøn taïi vò trí ngaãu nhieân
Picture1.Circle (Int(Rnd * PW), Int(Rnd * PH)), 250
End Sub

Private Sub Picture2_Click()
' Sao cheùp Image vaøo ñieàu khieån Picture2.
Picture2.Picture = Picture1.Image
End Sub

THUOC TINH IMAGE (COOLBAR)

Private Sub Form_Load()
' Gaùn captions ñeå nhaän daïng cho moãi Band
cbrMain.Bands(1).Caption = "One"
cbrMain.Bands(2).Caption = "Two"
cbrMain.Bands(3).Caption = "Three"
' Gaùn THUOC TINH ImageList cuûa CoolBar vôùi ImageList
Set cbrMain.ImageList = ilImages
' Theâm moät image vaøo Band
cbrMain.Bands(1).Image = 1
End Sub

Private Sub Form_Click()
' Thay ñoåi image cho band ñaàu tieân
If cbrMain.Bands(1).Image = 1 Then
cbrMain.Bands(1).Image = 2
Else
cbrMain.Bands(1).Image = 1
End If
End Sub

THUOC TINH INCREMENT

Private Sub UpDown1_Change()
MsgBox UpDown1.Value
End Sub

Private Sub Form_Load()
UpDown1.Increment = 2
UpDown1.Min = 1
UpDown1.Max = 10
End Sub

THUOC TINH INDENTATION

Private Sub Form_Load()
' Khai baùo nhaõn cuûa ñieàu khieån OptionButton cho pheùp choïn
‘ Indentation.
Option1(0).Caption = "250"
Option1(1).Caption = "500"
Option1(2).Caption = "1000"

' Choïn tuyø choïn htöù nhaát vaø gaùn indentation khôûi taïo laø 250
Option1(0).Value = True
TreeView1.Indentation = 250

Dim nodX As Node
Dim i As Integer

Set nodX = TreeView1.Nodes.Add(, , , _
CStr(1))
' Theâm Node thöù nhaát

For i = 1 To 6
' Theâm 6 node.
Set nodX = TreeView1.Nodes.Add(i, _
tvwChild, , CStr(i + 1))
Next i

nodX.EnsureVisible
' Taát caû caùc Node ñeàu ñöôïc hieån thò.
Form1.Caption = "Indentation = " & _
TreeView1.Indentation
End Sub

Private Sub Option1_Click(Index As Integer)
' Thay ñoåi Indentation tuyø thuoäc vaøo giaù trò choïn töø OptionButton
TreeView1.Indentation = _
Val(Option1(Index).Caption)
Form1.Caption = "Indentation = " & _
TreeView1.Indentation
End Sub

THUOC TINH INDEX (ACTIVEX CONTROL)

Private Sub Form_Load()
Dim i As Integer
For i=0 to 1
txtName(i).Text=i
Next
End Sub

THUOC TINH INITDIR

Private Sub Command1_Click()
' Gaùn CancelError baèng True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Gaùn flags
CommonDialog1.IniDir = "C:\"
CommonDialog1.Flags = cdlOFNHideReadOnly
' gaùn THUOC TINH loïc taäp tin
CommonDialog1.Filter = _
"All Files (*.*)|*.*|Text Files" & _
"(*.txt)|*.txt|Batch Files (*.bat)|*.bat"
' Chæ ñònh loaïi taäp tin maëc ñònh
CommonDialog1.FilterIndex = 2
' Hieån thò töïa ñeà
CommonDialog1.DialogTitle = "Download file"
' Hieån thò hoäp hoäi thoaïi Open
CommonDialog1.ShowOpen
' Lieät keâ danh saùch taäp tin choïn loïc
MsgBox CommonDialog1.FileName
Exit Sub

ErrHandler:
Exit Sub
End Sub

THUOC TINH INPUT

Private Sub Command1_Click()
Dim InString As String
' Ñoïc taát caû caùc döõ lieäu ñang coù.
MSComm1.InputLen = 0

' Kieåm tra döõ lieäu.
If MSComm1.InBufferCount Then
' Ñoïc döõ lieäu.
InString = MSComm1.Input
End If
End Sub

THUOC TINH INPUTLEN

Private Sub Command1_Click()
Dim InString As String
' Ñoïc taát caû caùc döõ lieäu ñang coù.
MSComm1.InputLen = 10

' Kieåm tra döõ lieäu.
If MSComm1.InBufferCount Then
' Ñoïc döõ lieäu.
InString = MSComm1.Input
End If
End Sub

THUOC TINH INPUTMODE

Private Sub Command1_Click()
Dim InString As String
' Ñoïc taát caû caùc döõ lieäu ñang coù.
MSComm1.InputMode = 0
MSComm1.InputLen = 10

' Kieåm tra döõ lieäu.
If MSComm1.InBufferCount Then
' Ñoïc döõ lieäu.
InString = MSComm1.Input
End If
End Sub

THUOC TINH INTERVAL

Private Sub Form_Load()
Timer1.Interval = 900
' Gaùn THUOC TINH interval.
HScroll1.Min = 100
' Gaùn giaù trò nhoû nhaát cho ñieàu khieån HScroll.
HScroll1.Max = 900
' Gaùn giaù trò lôùn nhaát cho ñieàu khieån HScroll.
End Sub
Private Sub HScroll1_Change()
' Gaùn interval theo THUOC TINH Value cuûa Hscroll.
Timer1.Interval = 1000 - HScroll1.Value
End Sub
Private Sub Timer1_Timer()
' Ñoåi maøu neàn giöõa red vaø blue.
If Picture1.BackColor = RGB(255, 0, 0) Then
Picture1.BackColor = RGB(0, 0, 255)
Else
Picture1.BackColor = RGB(255, 0, 0)
End If
End Sub

THUOC TINH ITALIC

Private Sub Form_Click()
Font.Bold = Not Font.Bold
Font.Strikethrough = Not Font.Strikethrough
Font.Italic = Not Font.Italic
Font.Underline = Not Font.Underline
Font.Size = 16
If Font.Bold Then
Print "Font weight is " & _
Font.Weight & " (bold)."
Else
Print "Font weight is " & _
Font.Weight & " (not bold)."
End If
End Sub

THUOC TINH KEY

Private Sub ExportDailyReport()
DataReport1.Title = "Daily Report"
' Title xuaát hieän treân Report
Dim strTemplate As String
' Taïo moät template.
strTemplate = _
"<HTML>" & vbCrLf & _
"<HEAD>" & vbCrLf & _
"<TITLE>" & "MyCompany: " & rptTagTitle & _
"</TITLE>" & vbCrLf & _
"<BODY>" & vbCrLf & _
rptTagBody & vbCrLf & _
"<BODY>" & vbCrLf & _
"</HTML>"

' Theâm môùi ñoái töôïng ExportFormat baèng caùch söû duïng template.
DataReport1.ExportFormats.Add _
Key:="DailyReport", _
FormatType:=rptFmtHTML, _
FileFormatString:="Daily Report (*.htm)", _
FileFilter:="*.HTM", _
Template:=strTemplate

' Xuaát report baèng caùch söû duïng ñoái töôïng ExportFormat
DataReport1.ExportReport _
FormatIndexOrKey:="DailyReport", _
FileName:="C:\Temp\DailyRpt", _
Overwrite:=True, _
ShowDialog:=False, _
Range:=rptRangeFromTo, _
Pagefrom:=1, _
Pageto:=10
End Sub

THUOC TINH LABELEDIT

Private Sub Form_Load()
Dim nodX As Node
Dim i As Integer
TreeView1.LabelEdit = tvwManual
' Gaùn THUOC TINH
Set nodX = TreeView1.Nodes.Add( _
, , , " Node 1")
' Theâm Node ñaàu tieân

For i = 1 To 5
' Theâm 5 Node.
Set nodX = TreeView1.Nodes.Add(i, _
tvwChild, , "Node " & CStr(i + 1))
Next i

nodX.EnsureVisible
' Trình baøy taát caû caùc Node
End Sub

Private Sub Command1_Click()
' Baét ñaàu söû duïng phöông thöùc StartLabelEdit treân Node choïn
' khi kích hoaït ñeán baèng caùch BeforeLabelEdit
TreeView1.StartLabelEdit
End Sub

Private Sub TreeView_BeforeLabelEdit(Cancel As Integer)
' Neáu phaàn töû choïn laø root, thì huyû boû cheá ñoä kích hoaït
If TreeView1.SelectedItem Is TreeView1.SelectedItem.Root Then
Cancel = True
End If
End Sub

Private Sub TreeView_AfterLabelEdit _
(Cancel As Integer, NewString As String)
If Len(NewString) = 0 Then
Cancel = True
End If
End Sub

THUOC TINH LABELLEVELCOUNT

Private Sub Command1_Click()
Dim XAxis As Object
Dim NumberOfLevels As Integer
' Ñoïc soá nhaõn trình baøy treân truïc X
Set XAxis = MSChart1.Plot.Axis(VtChAxisIdX, 1)
NumberOfLevels = XAxis.LabelLevelCount
MsgBox "Number of Label Levels = " _
& Str(NumberOfLevels)
End Sub

THUOC TINH LASTDLLERROR

Private Declare Function SQLCancel Lib "ODBC32.dll" _
(ByVal hstmt As Long) As Integer

Private Sub UserForm_Click()
Dim RetVal
' Goïi vôùi tham soá hôïp leä.
RetVal = SQLCancel(myhandle&)
' Kieåm tra loãi töø SQL
If RetVal = -2 Then
'Hieån thò loãi
MsgBox "Error code is :" & err.LastDllError
End If
End Sub

THUOC TINH LBOUND

Private Sub Form_Paint()
Static FlagFormPainted As Integer
If FlagFormPainted <> True Then
' Khi form ñöôïc toâ maøu laàn ñaàu tieân,
For i = 1 To 3
Load Option1(i)
' Theâm 3 ñieàu khieån OpttionButton theo daïng maûng.
Option1(i).Top = Option1(i - 1).Top + 350
Option1(i).Visible = True
Next i
For i = 0 To 3
' Khai baùo Caption cho OptionButton.
Option1(i).Caption = "Option #" & CStr(i)
Next i
Option1(0).Value = True
' Choïn nuùt ñaàu tieân.
FlagFormPainted = True
End If
End Sub
Private Sub Form_Click()
Print "Control array's Count property is " & _
Option1().Count
Print "Control array's LBound property is " & _
Option1().LBound
Print "Control array's UBound property is " & _
Option1().UBound
End Sub

THUOC TINH LEFT, TOP

Private Sub Command1_Click()
Width = Screen.Width * 0.75
' Gaùn chieàu roäng cuûa Form.
Height = Screen.Height * 0.75
' Gaùn chieàu cao cuûa Form.
Left = (Screen.Width - Width) / 2
' Canh leà theo hiceàu ngang cuûa Form.
Top = (Screen.Height - Height) / 2
' Canh leà theo hiceàu doïc cuûa Form.
End Sub

THUOC TINH LEFTCOL

Private Sub Command1_Click()
Debug.Print "Leftmost column is currently "
Debug.Print DataGrid1.LeftCol
DataGrid1.LeftCol = 2
Debug.Print "Leftmost column is now "
Debug.Print DataGrid1.LeftCol
End Sub

THUOC TINH LEFTMARGIN, RIGHTMARGIN

Private Sub ChangeMargins(Optional fraction As Long)
If fraction = 0 Then fraction = 8
With DataReport1
.TopMargin = 1000
.BottomMargin = 1000
.LeftMargin = .Width / fraction
.RightMargin = .Width / fraction
End With
End Sub

THUOC TINH LENGTH

Private Sub Command1_Click()
' Khoaûng caùch trong MSChart.
With Form1.MSChart1.Plot.Axis(VtChAxisIdY, _
1).Tick
.Length = 500
.Style = VtChAxisTickStyleOutside
End With
End Sub

THUOC TINH LIST

Private Sub Form_Load()
Combo1.AddItem "Denver Sandwich"
' Theâm töøng phaàn töû vaøo danh saùch
Combo1.AddItem "Reuben Sandwich"
Combo1.AddItem "Turkey Sandwich"
Combo1.Text = Combo1.List(0)
' Trình baøy phaàn töû ñaàu tieân.
End Sub

THUOC TINH LISTCOUNT

Private Sub Form_Load()
Dim I
' Khai baùo bieán
AutoRedraw = True
' Gaùn THUOC TINH AutoRedraw.
For I = 0 To Printer.FontCount - 1
' Theâm FontName aøo danh saùch.
Combo1.AddItem Printer.Fonts(I)
Next I
Combo1.ListIndex = 0
' Gaùn chuoãi cho phaàn töû ñaàu tieân.
' In thoâng tin ListCount treân form.
Print "Number of printer fonts: "; Combo1.ListCount
End Sub
Private Sub Command1_Click()
Static UpperCase
Dim I
' Khai baùo bieán
For I = 0 To Combo1.ListCount - 1
' Voøng laëp trong danh saùch
If UpperCase Then
Combo1.List(I) = UCase(Combo1.List(I))
Else
Combo1.List(I) = LCase(Combo1.List(I))
End If
Next I
UpperCase = Not UpperCase
' Thay ñoåi kieåu chöõ
End Sub

THUOC TINH LISTFIELD

Private Sub Form_Load()
' Söû duïng chuoãi keát noái cô sôû döõ lieäu nhö khai baùo trong ñoái
‘ töôïng ADODC
' Neáu keát noái cô sôû döõ lieäu phaùt sinh loãi, baïn coù theå kieåm tra cô sôû
' döõ lieäu Northwind.mdb.
Dim ConnectionString As String
ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\Northwind.mdb;Uid=;Pwd="

' Chuù yù raèng hai ñieàu khieån ADODC, Recordsource phaûi chöùa
‘ ñöïng field: SupplierID.
With Adodc1
.RecordSource = _
"SELECT ProductName, ProductID,” & _
“ SupplierID FROM Products"
.ConnectionString = ConnectionString
.Refresh
.Caption = "Products"
.Visible = False
End With

With Adodc2
.RecordSource = "SELECT CompanyName, “ & _ “SupplierID FROM Suppliers"
.ConnectionString = ConnectionString
.Refresh
.Caption = "Suppliers"
.Visible = False
End With

Set DataGrid1.DataSource = Adodc1

With DataCombo1
Set .DataSource = Adodc1
.DataField = "SupplierID"
' Thay ñoåi field
.BoundColumn = "SupplierID"
' Field trong ADODC2 thay ñoåi DataField.
Set .RowSource = Adodc2
.ListField = "CompanyName"
' Field trình baøy treân DataCombo.
End With

Adodc1.Recordset.MoveFirst
End Sub

THUOC TINH LISTIMAGES

Private Sub Form_Load()
Dim imgX As ListImage
' Theâm nhöõng images vaø ListImages.
Set imgX = ImageList1. _
ListImages.Add(, "rocket", _
LoadPicture("rocket.ico"))
Set imgX = ImageList1. _
ListImages.Add(, "jet", _
LoadPicture("plane.ico"))
Set imgX = ImageList1. _
ListImages.Add(, "car", _
LoadPicture("cars.ico"))

ListView1.Icons = ImageList1
' Gaùn THUOC TINH Icons.

' Theâm ñoái töôïng Item vaøo ñieàu khieån ListView
Dim itmX As ListItem
Set itmX = ListView1.ListItems.Add()
' Tham chieáu ñeán chæ muïc.
itmX.Icon = 1
itmX.Text = "Rocket"
' Gaùn THUOC TINH Text
Set itmX = ListView1.ListItems.Add()
' Tham chieáu ñeán khoaù ("jet").
itmX.Icon = "jet"
itmX.Text = "Jet"
' Gaùn chuoãi cho THUOC TINH Text
Set itmX = ListView1.ListItems.Add()
itmX.Icon = "car"
itmX.Text = "Car"
End Sub

THUOC TINH LISTINDEX

Dim Player(0 To 2)
' Khai baùo maûng 2 chieàu.
Dim Salary(0 To 2)
Private Sub Form_Load()
Dim I
' Khai baùo bieán.
AutoSize = True
Player(0) = "Miggey McMoo"
' Nhaäp döõ lieäu vaøo maûng
Player(1) = "Alf Hinshaw"
Player(2) = "Woofer Dean"
Salary(0) = "$234,500"
Salary(1) = "$158,900"
Salary(2) = "$1,030,500"
For I = 0 To 2
' Theâm teân vaøo danh saùch.
Combo1.AddItem Player(I)
Next I
Combo1.ListIndex = 0
' Trình baøy phaàn töû ñaàu tieân trong danh saùch.
End Sub

THUOC TINH LISTITEMS

Private Sub Option1_Click(Index As Integer)
' Gaùn THUOC TINH Arrange vaøo THUOC TINH Index cuûa ñieàu
‘ khieån Option1.
ListView1.Arrange = Index
End Sub

Private Sub Form_Load()
' Ñònh nghóa nhaõn cho ñieàu khieån OptionButton
Option1(0).Caption = "No Arrange"
Option1(1).Caption = "Align Auto Left"
Option1(2).Caption = "Align Auto Top"
' Khai baùo bieán ñeå taïo ñoái töôïng ListView vaø ImageList.
Dim i As Integer
Dim itmX As ListItem
Dim imgX As ListImage
' Khai baùo bieán ñoái töôïng cho ñoái töôïng ListImages.

' Theâm ñoái töôïng ListImage vaøo ñieàu khieån ImageList.
Set imgX = ImageList1.ListImages. _
Add(, , LoadPicture("icons\mail01a.ico"))

ListView1.Icons = ImageList1
' Choïn bieåu töôïng öùng vôùi ñieàu khieån ImageList.

' Theâm 10 ñoái töôïng ListItem, moãi ñoái töôïng öùng vôùi 1 Icon.
For i = 1 To 10
Set itmX = ListView1.ListItems.Add()
itmX.Icon = 1
itmX.Text = "ListItem " & i
Next i
End Sub

THUOC TINH LOCALHOSTNAME

Private Sub cmdDis_Click()
tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()

tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
tcpServer.GetData strData
txtOutput.Text = strData
End Sub

THUOC TINH LOCALIP

Private Sub cmdDis_Click()
tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
tcpServer.Listen
MsgBox tcpServer.LocalID
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()

tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
tcpServer.GetData strData
txtOutput.Text = strData
End Sub

THUOC TINH LOCALPORT

Private Sub cmdDis_Click()
tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
tcpServer.Listen
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()

tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
tcpServer.GetData strData
txtOutput.Text = strData
End Sub

THUOC TINH LOCKED

Private Sub Form_Load()
Me.txtNo.Locked=True
End Sub

THUOC TINH MAX

Private Sub UpDown1_Change()
MsgBox UpDown1.Value
End Sub

Private Sub Form_Load()
UpDown1.Increment = 2
UpDown1.Min = 1
UpDown1.Max = 10
End Sub

THUOC TINH MAX, MIN

Private Sub Command1_Click()
Dim Counter As Integer
Dim Workarea(250) As String
ProgressBar1.Min = LBound(Workarea)
ProgressBar1.Max = UBound(Workarea)
ProgressBar1.Visible = True

Aùn THUOC TINH Min cho Progress.
ProgressBar1.Value = ProgressBar1.Min

‘ Duyeät qua caùc phaàn töû maûng.
For Counter = _
LBound(Workarea) To UBound(Workarea)
Gaùn giaù trò khôûi taïo cho moãi phaàn töûtrong maûng.
Workarea(Counter) = "Initial value" & Counter
ProgressBar1.Value = Counter
Next Counter
ProgressBar1.Visible = False
ProgressBar1.Value = ProgressBar1.Min
End Sub

Private Sub Form_Load()
ProgressBar1.Align = vbAlignBottom
ProgressBar1.Visible = False
Command1.Caption = "Initialize array"
End Sub

THUOC TINH MAXDATE, MINDATE

Private Sub Command1_Click()
With MonthView1
.Value = "January 1, 2000"
.MinDate = "January 1, 2000"
.MaxDate = "December 31, 2000"
End With
End Sub

THUOC TINH MAXIMUM

Private Sub Command1_Click()
' Gaùn loaïi 2d bar cho THUOC TINH Type.
MSChart1.chartType = VtChChartType2dBar
' Trình baøy coät y.
With MSChart1.Plot.Axis(VtChAxisIdY).ValueScale
.Maximum = 1000
.Auto = False
.MajorDivision = 2
.MinorDivision = 5
End With
' Trình baøy löùô treân Chart baèng maøu xanh
With MSChart1.Plot.Axis(VtChAxisIdY).AxisGrid
.MajorPen.VtColor.Set 255, 0, 0
.MajorPen.Width = 4
.MinorPen.VtColor.Set 0, 0, 255
.MinorPen.Width = 2
End With
End Sub

THUOC TINH MAXLENGTH

Private Sub Form_Load()
Me.txtName.maxLength = 30
‘ Trong cô sôû döõ lieäu, taïo coät Name cuûa baûng döõ lieäu naøo ñoù
‘ baïn khai baùo chieàu daøi laø 30, treân giao dieän nhaäp lieäu baïn
‘ cuõng neân giôùi haïn chieàu daøi cho pheùp baèng vôùi chieàu daøi
‘ khai baùo trong cô sôû döõ lieäu.
End Sub

THUOC TINH MERGECELLS

Private Sub Command1_Click()
With MSHFlexGrid1
.MergeCells = 2
.MergeRow(0) = True
.MergeRow(1) = True
.MergeRow(2) = True
.MergeRow(3) = False

End With
End Sub

Private Sub Form_Load()
' Töïa ñeà
With MSHFlexGrid1
.Cols = 4
.Rows = 7
.FixedCols = 0
.FixedRows = 0
.Row = 0
.Col = 0
.Text = "Region"
.Col = 1
.Text = "Product"
.Col = 2
.Text = "Employee"
.Col = 3
.Text = "Sales"
End With
' Döõ lieäu
Dim i
For i = 0 To 2
With MSHFlexGrid1
.Row = i
.Col = 0
.Text = "A"
.Col = 1
.Text = "B" & i
.Col = 2
.Text = "C" & i
.Col = 3
.Text = 1000 * i
End With
Next
For i = 3 To 5
With MSHFlexGrid1
.Row = i
.Col = 0
.Text = "AA"
.Col = 1
.Text = "BB" & i
.Col = 2
.Text = "CC" & i
.Col = 3
.Text = 3000 * i
End With
Next
End Sub

THUOC TINH MERGECOL, MERGEROW

Private Sub Command1_Click()
With MSHFlexGrid1
.MergeCells = 2
.MergeCol(0) = True
.MergeCol(1) = True
.MergeRow(2) = True
.MergeRow(3) = False

End With
End Sub

Private Sub Form_Load()
' Töïa ñeà
With MSHFlexGrid1
.Cols = 4
.Rows = 7
.FixedCols = 0
.FixedRows = 0
.Row = 0
.Col = 0
.Text = "Region"
.Col = 1
.Text = "Product"
.Col = 2
.Text = "Employee"
.Col = 3
.Text = "Sales"
End With
' Döõ lieäu
Dim i
For i = 0 To 2
With MSHFlexGrid1
.Row = i
.Col = 0
.Text = "A"
.Col = 1
.Text = "B" & i
.Col = 2
.Text = "C" & i
.Col = 3
.Text = 1000 * i
End With
Next
For i = 3 To 5
With MSHFlexGrid1
.Row = i
.Col = 0
.Text = "AA"
.Col = 1
.Text = "BB" & i
.Col = 2
.Text = "CC" & i
.Col = 3
.Text = 3000 * i
End With
Next
End Sub

THUOC TINH MIN

Private Sub UpDown1_Change()
MsgBox UpDown1.Value
End Sub

Private Sub Form_Load()
UpDown1.Increment = 2
UpDown1.Min = 10
UpDown1.Max = 100
End Sub

THUOC TINH MINHEIGHT, MINWIDTH

Private Sub Form_Load()
' Gaùn chieàu roäng nhoû nhaát cho moãi Band
cbrMain.Bands(1).MinWidth = 500
cbrMain.Bands(2).MinWidth = 1000
cbrMain.Bands(3).MinWidth = 5000
End Sub

THUOC TINH MINIMUM

Private Sub Command1_Click()
' Gaùn loaïi 2d bar cho THUOC TINH Type.
MSChart1.chartType = VtChChartType2dBar
' Trình baøy coät y.
With MSChart1.Plot.Axis(VtChAxisIdY).ValueScale
.Minimum = 1
.Auto = False
.MajorDivision = 2
.MinorDivision = 5
End With
' Trình baøy löùô treân Chart baèng maøu xanh
With MSChart1.Plot.Axis(VtChAxisIdY).AxisGrid
.MajorPen.VtColor.Set 255, 0, 0
.MajorPen.Width = 4
.MinorPen.VtColor.Set 0, 0, 255
.MinorPen.Width = 2
End With
End Sub

THUOC TINH MINUTE

Private Sub Form_Load()
Me. DateTimePicker.Minute = 30
End Sub

THUOC TINH MONTH

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Select Case MonthView1.Month
Case 1 To 3
Label1.Caption = "First Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case 4 To 6
Label1.Caption = "Second Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case 7 To 9
Label1.Caption = "Third Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case Else
Label1.Caption = "Fourth Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
End Select
End Sub

THUOC TINH MONTHBACKCOLOR

Private Sub Command1_Click()
With MonthView1
' Gaùn maøu neàn laø maøu xanh
.MonthBackColor = &HFF0000
.TitleBackColor = &HFFFF&
' gaùn maøu hoàngcho töïa ñeà cuûa ngaøy choïn.
.TitleForeColor = &HFF00FF
' Gaùn voøng ngoaøi cuûa caùc ngaøy trong thaùng vôùi maøu Gray
.TrailingForeColor = &HC0C0C0
' Gaùn ngaøy vaø thaùng vôùi maøu ñen
.ForeColor = &H0&
' Gaùn maøu ñoû cho goùc traùi vaø phaûi
.BackColor = &HC0&
End With
End Sub

THUOC TINH MONTHCOLUMNS, MONTHROWS

Private Sub Command1_Click()
With MonthView1
' Gaùn calendar hieån thò vaø cuoän moät quyù taïi 1 thôøi ñieåm
' 3 thaùng trong 3 coät vaø 1 haøng.
.MonthColumns = 3
.MonthRows = 1
.ScrollRate = 3
End With
End Sub

THUOC TINH MOUSEICON

Private Sub Form_Load()
' Theâm caùc phaàn töû vaøo ñieàu khieån ListBox.
List1.AddItem "Selection 1"
List1.AddItem "Selection 2"
List1.AddItem "Selection 3"
List1.AddItem "Selection 4"
List1.AddItem "Selection 5"
End Sub

Private Sub List1_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
' Gaùn bieåu töôïng cho nhieàu phaàn töû.
If List1.SelCount > 1 Then
List1.MouseIcon = LoadPicture("MOUSE04.ICO")
List1.MousePointer = 99
Else
' Gaùn bieåu töôïng cho töøng phaàn töû.
List1.MouseIcon = LoadPicture("MOUSE02.ICO")
List1.MousePointer = 99
End If
End Sub

THUOC TINH MOUSEPOINTER

Private Sub Form_Click()
Dim I
' Khai baùo bieán vaø thay ñoåi kieåu trình baøy cuûa con troû.
Screen.MousePointer = vbHourglass
' Gaùn maøu ngaãu nhieân vaø veõ voøng troøn treân Form.
For I = 0 To ScaleWidth Step 50
ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Circle (I, ScaleHeight * Rnd), 400
Next
' Traû veà kieåu bình thöôøng.
Screen.MousePointer = vbDefault
End Sub

THUOC TINH MULTILINE

Private Sub Form_Load()
MsgBox Me.txtName.MultiLine
End Sub

THUOC TINH MULTIROW

Private Sub Form_Load()
Me. TabStrip1.MultiRow = True
End Sub

THUOC TINH MULTISELECT

Private Sub Form_Load()
Dim I
' Ñieàn caùc Font maøu xanh vaøo ListBox.
For I = 0 To Screen.FontCount - 1
List1.AddItem Screen.Fonts(I)
Next I
End Sub

Private Sub Command1_Click()
Dim I
' Xoaù taát caû caùc phaàn töû trong danh saùch.
List2.Clear
' Neáu phaàn töû ñöôïc choïn theâm vaøo ñieàu khieån List2.
For I = 0 To List1.ListCount - 1
If List1.Selected(I) Then
List2.AddItem List1.List(I)
End If
Next I
End Sub

THUOC TINH MULTISELECT (MONTHVIEW)

Private Sub Command1_Click()
With MonthView1
.MultiSelect = True
.MaxSelCount = 14
.SelStart = MonthView1.Value
.SelEnd = DateAdd("w", 13, MonthView1.Value)
End With
End Sub

THUOC TINH NEWROW

Private Sub Form_Load()
' Gaùn THUOC TINH NewRow
If cbrMain.Bands(3).NewRow = False Then
cbrMain.Bands(3).NewRow = True
Else
cbrMain.Bands(3).NewRow = False
End If
' Theâm môùi moät Band
cbrMain.Bands().Add
End Sub

THUOC TINH NEXT

Private Sub Form_Load()
Dim nodX As Node
Set nodX = tvW1.Nodes.Add(, , "dad", "Mike")
Set nodX = tvW1.Nodes.Add(, , "mom", "Carol")
' Alice laø LastSibling.
Set nodX = tvW1.Nodes.Add(, , , "Alice")

Set nodX = tvW1.Nodes.Add("mom", _
tvwChild, , "Marsha")
Set nodX = tvW1.Nodes.Add("mom", _
tvwChild, , "Jan")
' Cindy laø LastSibling.
Set nodX = tvW1.Nodes.Add("mom", _
tvwChild, , "Cindy")
nodX.EnsureVisible
' Trình baøy taát caùc node

Set nodX = tvW1.Nodes.Add("dad", _
tvwChild, , "Greg")
Set nodX = tvW1.Nodes.Add("dad", _
tvwChild, , "Peter")
' Bobby laø LastSibling.
Set nodX = tvW1.Nodes.Add("dad", _
tvwChild, , "Bobby")
nodX.EnsureVisible
' Trình baøy taát caùc node
End Sub

Private Sub tvW1_NodeClick(ByVal Node As Node)
Dim strText As String
Dim n As Integer
' Gaùn n vaøo chæ muïc FirstSibling
n = Node.FirstSibling.Index
strText = Node.FirstSibling.Text & vbLf
' Trong luùc n khoâng laø chæ muïc cuûa sibling cuoái cuøng thì
' nhaûy ñeán sibling keá tieáp vaø gaùn THUOC TINH text vôùi bieán.
While n <> Node.LastSibling.Index
strText = strText & tvW1.Nodes(n).Next.Text & vbLf
' Gaùn n cho chæ muïc cuûa node.
n = tvW1.Nodes(n).Next.Index
Wend
MsgBox strText
' Trình baøy keát quaû
End Sub

THUOC TINH NODES

Private Sub Form_Load()
Dim nodX As Node
Set nodX = tvW1.Nodes.Add(, , "R", "Root")
Set nodX = tvW1.Nodes.Add("R", _
tvwChild, "C1", "Child 1")
Set nodX = tvW1.Nodes.Add("R", _
tvwChild, "C2", "Child 2")
Set nodX = tvW1.Nodes.Add("R", _
tvwChild, "C3", "Child 3")
Set nodX = tvW1.Nodes.Add("R", _
tvwChild, "C4", "Child 4")
nodX.EnsureVisible
tvW1.Style = tvwTreelinesText
tvW1.BorderStyle = vbFixedSingle
End Sub

Private Sub Form_Click()
Dim i As Integer
Dim strNodes As String
For i = 1 To tvW1.Nodes.Count
strNodes = strNodes & tvW1.Nodes(i).Index & _
" " & "Key: " & tvW1.Nodes(i).Key & " " & _
"Text: " & tvW1.Nodes(i).Text & vbLf
Next i
MsgBox strNodes
End Sub

THUOC TINH NUMBER

Sub test()
On Error GoTo out

Dim x, y
x = 1 / y
' Taïo pheùp chia cho soá 0
Exit Sub
out:
MsgBox err.Number
MsgBox err.Description
' Kieåm tra neáu chi cho 0 thì loãi phaùt sinh
If err.Number = 11 Then
y = y + 1
End If
Resume
End Sub

THUOC TINH NUMBERFORMAT

Private Sub Command1_Click()
Dg1.Columns(1).NumberFormat = "long date"
End Sub

THUOC TINH ORIENTATION (UPDOWN)

Private Sub Form_Load()
MsgBox Me.UpDonw1.Orientation
End Sub

THUOC TINH ORIENTATION (PRINTER)

Dim X As Printer
For Each X In Printers
If X.Orientation = vbPRORPortrait Then
Set Printer = X
Exit For
End If
Next

THUOC TINH ORIENTATION (COOLBAR)

Private Sub Form_Load()
' Canh leà Top cuûa Form
cbrMain.Align = vbAlignTop
End Sub

Private Sub Form_Click()
' Gaùn THUOC TINH orientation
If cbrMain.Orientation = cc3OrientationHorizontal Then
' Thay ñoåi chieàu
cbrMain.Orientation = cc3OrientationVertical
' Align to the side of the form
cbrMain.Align = vbAlignLeft
Else
' Tahy ñoåi chieàu
cbrMain.Orientation = cc3OrientationHorizontal
' canh leà Top cuûa form
cbrMain.Align = vbAlignTop
End If
End Sub

THUOC TINH ORIENTATION (MSCHART)

Private Sub Command1_Click()
' Gaùn chuoãi cho töïa ñeà vôùi vò trí vaø höôùng cuûa chuoãi.
With Form1.MSChart1.Title
.Location.Visible = True
.Location.LocationType = VtChLocationTypeLeft
.Text = "Title TextLayout"
End With
With Form1.MSChart1.Title.TextLayout
.Orientation = VtOrientationUp
.HorzAlignment = VtHorizontalAlignmentCenter
.VertAlignment = VtVerticalAlignmentCenter
End With
End Sub

THUOC TINH OSVERSION

Private Sub Command1_Click()
Dim MsgEnd As String
Select Case SysInfo1.OSPlatform
Case 0
MsgEnd = "Unidentified"
Case 1
MsgEnd = "Windows 95, ver. " & _
CStr(SysInfo1.OSVersion)
Case 2
MsgEnd = "Windows NT, ver. " & _
CStr(SysInfo1.OSVersion)
End Select
MsgBox "System: " & MsgEnd
End Sub

THUOC TINH OUTPUT

Private Sub Form_KeyPress(KeyAscii As Integer)
Dim Buffer As Variant

'Gaùn vaø môû Port
MSComm1.CommPort = 1
MSComm1.PortOpen = True

Buffer = Chr$(KeyAscii)
MSComm1.Output = Buffer
End Sub

THUOC TINH PAGE

Private Sub Form_Click()
Dim Header, I, Y
Print "Now printing..."
Header = "Printing Demo - Page "
For I = 1 To 3
Printer.Print Header;
Printer.Print Printer.Page
Y = Printer.CurrentY + 10

Printer.Line (0, Y)-(Printer.ScaleWidth, Y)
For K = 1 To 50
Printer.Print String(K, " ");
Printer.Print "Visual Basic ";
Printer.Print Printer.Page
Next
Printer.NewPage
Next I
Printer.EndDoc
End
End Sub

THUOC TINH PANELS

Private Sub Form_Load()
Dim pnlX As Panel
' Gaùn THUOC TINH tag cho moäi ñieàu khieån vaø Form.
Form1.Tag = "Project 1 Form"
Command1.Tag = "A command button"
Picture1.Tag = "Picture Box Caption"
StatusBar1.Tag = "Application StatusBar1"
' Gaùn THUOC TINH AutoSize cuûa Panel ñaàu tieân vôùi noäi dung.
StatusBar1.Panels(1).AutoSize = sbrContents
' Theâm 2 Panel vaø gaùn noäi dung cho chuùng.
Set pnlX = StatusBar1.Panels.Add
pnlX.AutoSize = sbrContents
Set pnlX = StatusBar1.Panels.Add
pnlX.AutoSize = sbrContents
End Sub

Private Sub Form_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
' Hieån thò giaù trò THUOC TINH Tag cuûa ñieàu khieån trong Panel 1,
' vaø toaï ñoä x,y treân Panel 2 vaø 3. Bôûi vì THUOC TINH AutoSize
' baèng Contents coøn Panel htöù nhaát seõ keùo daøi.
StatusBar1.Panels(1).Text = Form1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

' Khai baùo trong bieán coá MouseMove cuûa nuùt Command1
Private Sub Command1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
StatusBar1.Panels(1).Text = Command1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

' Khai baùo trong bieán coá MouseMove cuûa ñieàu khieån PictureBox
Private Sub Picture1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
StatusBar1.Panels(1).Text = Picture1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

' Khai baùo trong bieán coá MouseMove cuûa ñieàu khieån StatusBar
Private Sub StatusBar1_MouseMove(Button As Integer, _
Shift As Integer, X As Single, y As Single)
StatusBar1.Panels(1).Text = StatusBar1.Tag
StatusBar1.Panels(2).Text = "X = " & X
StatusBar1.Panels(3).Text = "Y = " & y
End Sub

THUOC TINH PARENT

Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
If TreeView1.DropHighlight Is Nothing Then
indrag = False
Else
Set nodX.Parent = TreeView1.DropHighlight
Cls
Print TreeView1.DropHighlight.Text & _
" is parent of " & nodX.Text
Set TreeView1.DropHighlight = Nothing
indrag = False
End If
End Sub

THUOC TINH PARENTFOLDER

Private Sub Command1_Click()
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = UCase(f.Name) & " in " & _
UCase(f.ParentFolder) & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & _
f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
MsgBox s, 0, "File Access Info"
End Sub

THUOC TINH PASSWORD

Private Sub Command1_Click()
With Adodc1
.UserName = txtUserName.Text
.Password = txtPassword.Text
.CursorLocation = adUseClient
.ConnectionString="Provider=SQLOLEDB.1;"& _
"Persist Security" & _
"Info=True;Initial Catalog=DBName;" & _
"Data Source=ServerName"
.RecordSource = "SELECT * FROM Products"
.Refresh
End With
End Sub

THUOC TINH PASSWORDCHAR

Private Sub Form_Click()
If Text1.PasswordChar = "" Then
Text1.PasswordChar = "*"
Else
Text1.PasswordChar = ""
End If
End Sub

THUOC TINH PATH

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
' Gaùn ñöôøng daãn cho thö muïc
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
' Gaùn ñöôøng daãn cho taäp tin.
End Sub

THUOC TINH PATH (FILESYSTEMOBJECT)

Sub ShowFileAccessInfo(filespec)
Dim fs, d, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = UCase(f.Path) & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & _
f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
MsgBox s, 0, "File Access Info"
End Sub

THUOC TINH PATHSEPERATOR

Private Sub Form_Load()
TreeView1.BorderStyle = vbFixedSingle
' Nhaõn cuûa ñieàu khieån OptionButton vôùi choïn löïa kyù töï.
Option1(0).Caption = "/"
Option1(1).Caption = "-"
Option1(2).Caption = ":"

' Choïn tuyø choïn cuoái cuøng laø giaù trò maëc ñònh
Option2(1).Value = True
TreeView1.PathSeparator = Option1(1).Caption

Dim nodX As Node
Dim i As Integer
Set nodX = TreeView1.Nodes.Add(, , , CStr(1))
' Theâm Node ñaàu tieân.

For i = 1 To 5
' Theâm caùc Node khaùc
Set nodX = TreeView1.Nodes.Add(i, _
tvwChild, , CStr(i + 1))
Next i

nodX.EnsureVisible
' Taát caû caùc Node ñeàu hieån thò
End Sub

Private Sub Option1_Click(Index As Integer)
' They ñoåi kyù töï phaân caùch.
TreeView1.PathSeparator = Option1(Index).Caption
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As Node)
' Trình baøy ñöôøng daãntreân THUOC TINH Caption cuûa Form.
Me.Caption = Node.FullPath
End Sub

THUOC TINH PATTERN

Private Sub Form_Load()
Command1.Default = True
' Gaùn THUOC TINH maëc ñònh cho nuùt Command1.
End Sub

Private Sub Command1_Click()
' Khai baùo teân taäp tin.
File1.FileName = Text1.Text
Dir1.Path = File1.Path
' Gaùn THUOC TINH Path.
End Sub

Private Sub File1_PatternChange()
Text1.Text = File1.Pattern
' Khai baùo Pattern.
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

THUOC TINH PICTURE

Private Sub Form_Load()
' Naïp caùc icon
Picture1.Picture = _
LoadPicture("ICONS\TRASH02A.ICO")
Picture2.Picture = _
LoadPicture("ICONS\TRASH02B.ICO")
End Sub

Private Sub Form_Click()
' They ñoåi icon.
Picture3.Picture = Picture1.Picture
Picture1.Picture = Picture2.Picture
Picture2.Picture = Picture3.Picture
' Xoaù hình thöù 3
Picture3.Picture = LoadPicture()
End Sub

THUOC TINH PORT

Private Sub Form_Load()
Dim P As Object
For Each P In Printers
If P.Port = "LPT2:" Or P.DeviceName _
Like "*LaserJet*" Then
Set Printer = P
Exit For
End If
Next P
End Sub

THUOC TINH PROTOCOL

Private Sub btnGetHTMLDoc_Click()
With Inet1
.URL = "http://www.huukhang.com/"
.Document = "popupsubcribe.htm "
.Protocol = icFTP
.Execute , "GET"
End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
Dim strHTML As String
Dim vtData As String
Select Case state
' Tröôøng hôïp khaùc thì khoâng trình baøy
Case icResponseCompleted
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
strHTML = strHTML & vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
txtHTML.Text = strHTML
End Select
End Sub

THUOC TINH PROXY

Private Sub btnGetHTMLDoc_Click()
With Inet1
.AccessType = icNamedProxy
.Proxy = "MYSERVER1"
.URL = "http://www.huukhang.com/"
.Document = "popupsubcribe.htm "
.Protocol = icFTP
.Execute , "GET"
End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
Dim strHTML As String
Dim vtData As String
Select Case state
' Tröôøng hôïp khaùc thì khoâng trình baøy
Case icResponseCompleted
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
strHTML = strHTML & vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
txtHTML.Text = strHTML
End Select
End Sub

THUOC TINH QUERYTIMEOUT

Option Explicit
Dim en As rdoEnvironment
Dim cn As New rdoConnection
Dim rs As rdoResultset
Dim SQL As String
Dim col As rdoColumn
Dim er As rdoError
Public WithEvents Qd As rdoQuery

Private Sub cn_QueryTimeout( _
ByVal Query As RDO.rdoQuery, Cancel As Boolean)
Dim ans As Integer
ans = MsgBox("Query Timed out... Press Retry to continue waiting", vbRetryCancel + vbCritical, _
"Query Took Too Long")
If ans = vbRetry Then
Cancel = False
Else
Cancel = True
End If
End Sub

Private Sub RunQuery_Click()
On Error GoTo RunQueryEH
Qd(0) = Param1
Qd.QueryTimeout = 5
Set rs = Qd.OpenResultset(rdOpenKeyset, _
rdConcurReadOnly)
If rs Is Nothing Then Else ShowRows
Exit Sub
RunQueryEH:
Debug.Print err, Error$
For Each er In rdoErrors
Debug.Print er.Description, er.Number
Next
rdoErrors.Clear
Resume Next

End Sub


Private Sub Form_Load()
Set en = rdoEngine.rdoEnvironments(0)
With cn
.Connect = _
"uid=;pwd=;database=workdb;dsn=WorkDB;"
.CursorDriver = rdUseClientBatch
.EstablishConnection _
Prompt:=rdDriverNoPrompt
End With

Set Qd = cn.CreateQuery("LongQuery", "")
With Qd
.SQL = _
"{call VeryLongStoredProcedure (?,?)}"
.rdoParameters(1).Direction = rdParamOutput
.rdoParameters(0).Type = rdTypeVARCHAR
End With
End Sub

THUOC TINH READONLY

Private Sub Command1_Click()
' Khai baùo teân taäp tin.
File1.ReadOnly = True
File1.FileName = Text1.Text
Dir1.Path = File1.Path
' Gaùn THUOC TINH Path.
End Sub

Private Sub File1_PatternChange()
Text1.Text = File1.Pattern
' Khai baùo Pattern.
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

THUOC TINH RECORDCOUNT

Private Sub Command1_Click()
On Error GoTo err
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
‘ Khai baùo chuoãi keát noái cô sôû döõ lieäu SQL Server
myStr = "driver={SQL Server};server=dinh;" & _
" Database=Northwind;UID=sa;PWD="

myCon.Open myStr
myRst.CursorType = adOpenDynamic
myRst.LockType = adLockOptimistic
‘ Khai baùo phaùt bieåu SQL
myStr = "Select * from Customers "
myStr = myStr & " Where CustomerID='" & _
txtNo & "'"
myRst.Open myStr, myCon
‘ Neáu coù maåu tin toàn taïi
If myRst.RecordCount > 0 Then
myRst.Edit
myRst("CompanyName") = txtName
myRst("ContactTitle") = txtDesc
myRst.Update
End If
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
err:
Beep
MsgBox Error
End Sub

THUOC TINH RECORDSET (DAO)

Private Sub Form_Load()
' Khai baùo bieán ñoái töôïng Database vaø Recordset
Dim Db As Database, Rs As Recordset
' Gaùn bieán cô sôû döõ lieäu.
Set Db = Workspaces(0).OpenDatabase( _
"C:\Northwind.MDB")
Set Rs = Db.OpenRecordset("AUTHORS")
' Maëc ñònh baûng döõ lieäu
Set Data1.Recordset = Rs
' gaùn THUOC TINH Recordset.
Data1.Recordset.Index = "PrimaryKey"
Debug.Print Rs.Type
End Sub

THUOC TINH RECORDSET (ADO DATA)

Private rsProducts As ADODB.Recordset

Private Sub Form_Load()
Dim strPath As String
' Ñöôøng daãn ñeán taäp tin Northwind.mdb.
strPath = "C:\Northwind.MDB"
With Adodc1
.ConnectionString= _
"Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Persist Security Info=False;" & _
" Data Source=" & strPath & _
"; Mode=Read|Write"
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.CommandType = adCmdText
.RecordSource = "SELECT * FROM Products"
.Refresh
End With

With Text1
.DataField = "ProductName"
Set .DataSource = Adodc1
End With

' Gaùn Recordset cuûa ñieàu khieån ADODC vaøo ñoái töôïng Recordset
Set rsProducts = Adodc1.Recordset

‘ Thay ñoåi tuyø choïn cuûa CommandButton
Command1.Caption = "MoveNext"
Command2.Caption = "MovePrevious"
End Sub

Private Sub Command1_Click()
' Söû duïng ñoái töôïng rsProducts (recordset)
' Vaø duyeät treân taát caû caùc maåu tin
If Not rsProducts.EOF Then
rsProducts.MoveNext
Else
rsProducts.MoveFirst
End If
End Sub

Private Sub Command2_Click()
If Not rsProducts.BOF Then
rsProducts.MovePrevious
Else
rsProducts.MoveLast
End If
End Sub

THUOC TINH RECORDSETTYPE

Private Sub Form_Load()
' Chæ ñònh loaïi ñoái töôïng Recordset
Data1.RecordsetType = vbRSTypeDynaset
Data1.DatabaseName = "BIBLIO.MDB"
Data1.RecordSource = "Authors"
Data1.Refresh

Select Case Data1.RecordsetType
Case vbRSTypeTable
Debug.Print "Table-type created."
Case vbRSTypeDynaset
Debug.Print "Dynaset-type created."
Case vbRSTypeSnapShot
Debug.Print "Snapshot-type created."
End Select
End Sub

THUOC TINH RECORDSOURCE


Private Sub Form_Load()
' Chæ ñònh loaïi ñoái töôïng Recordset
Data1.RecordsetType = vbRSTypeDynaset
Data1.DatabaseName = "BIBLIO.MDB"
Data1.RecordSource = "Authors"
Data1.Refresh

Select Case Data1.RecordsetType
Case vbRSTypeTable
Debug.Print "Table-type created."
Case vbRSTypeDynaset
Debug.Print "Dynaset-type created."
Case vbRSTypeSnapShot
Debug.Print "Snapshot-type created."
End Select
End Sub

THUOC TINH REDRAW

Private Sub Form_Load()
Dim i As Integer
MSHFlexGrid.Redraw = False
' CAÄp nhaät noäi dung trong MSHFlexGrid
For i = MSHFlexGrid1.FixedRows To MSHFlexGrid1.Rows - 1
MSHFlexGrid1.TextMatrix(i, 1) = GetName(i, 1)
MSHFlexGrid1.TextMatrix(i, 2) = GetName(i, 2)
Next
' Trình baøy keát quaû.
MSHFlexGrid1.Redraw = True
End Sub

THUOC TINH REPAINT

Private Sub Command1_Click()
With MSChart1
' Trình baøy bieàu ñoà daïng 3d vôùi 8 coät vaø 8 haøng döõ lieäu.
.chartType = VtChChartType3dBar
.ColumnCount = 8
.AutoIncrement = False
.RowCount = 8
.Repaint = False
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, index1, _
index2, index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, _
index1, index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH REQUESTTIMEOUT

Private Sub btnGetHTMLDoc_Click()
With Inet1
.RequestTimeout=30
.URL = "http://www.huukhang.com/"
.Document = "popupsubcribe.htm "
.Protocol = icFTP
.Execute , "GET"
End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
Dim strHTML As String
Dim vtData As String
Select Case state
' Tröôøng hôïp khaùc thì khoâng trình baøy
Case icResponseCompleted
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
strHTML = strHTML & vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
txtHTML.Text = strHTML
End Select
End Sub

THUOC TINH REQUEST

Private Sub MainPage_btnSendMe()
Webclass.Request.Form(“txtName”)
End Sub

THUOC TINH RESPONSE

Private Sub MainPage_btnSendMe()
Webclass.Response.Redirect( _
“http://www.huukhang.com”)
End Sub

THUOC TINH RESULTSET

Option Explicit
Dim qy As rdoQuery
Dim rs As rdoResultset
Dim cn As rdoConnection

Private Sub Form_Load()
Dim SQL As String
Set cn = MSRDC1.Connection

SQL = "{ call ChooseAuthor (?) }"
Set qy = cn.CreateQuery("GetAuthor", SQL)
End Sub


Private Sub Search_Click()
qy(0) = NameWanted.Text
Set MSRDC1.Resultset = qy.OpenResultset( _
rdOpenStatic, rdConcurReadOnly)
End Sub

Trong ñoù, thuû tuïc noäi taïi coù teân ChooseAuthor trong cô sôû döõ lieäu coù caáu truùc nhö sau:

CREATE PROCEDURE ChooseAuthor
(
@authorwanted char(20)
) as
select t.title from titles t,
titleauthor ta, authors a
Where t.title_id = ta.title_id
and ta.au_id = a.au_id
and a.au_lname = @authorWanted

THUOC TINH RIGHTMARGIN

Private Sub Form_Load()
Me.RichTextBox1.RightMargin = 3
End Sub

THUOC TINH ROOT

Private Sub Form_Load()
Dim nodX As Node
' Create a tree.
Set nodX = TreeView1.Nodes.Add(, , "r", "Root")
Set nodX = TreeView1.Nodes.Add(, , "p", "Parent")
Set nodX = TreeView1.Nodes.Add("p", _
tvwChild, , "Child 1")
nodX.EnsureVisible
' Trình baøy taát caû caùc nodes.
Set nodX = TreeView1.Nodes.Add("r", _
tvwChild, "C2", "Child 2")
Set nodX = TreeView1.Nodes.Add("C2", _
tvwChild, "C3", "Child 3")
Set nodX = TreeView1.Nodes.Add("C3", _
tvwChild, , "Child 4")
Set nodX = TreeView1.Nodes.Add("C3", _
tvwChild, , "Child 5")
nodX.EnsureVisible
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As Node)
Dim n As Integer
Dim strParents As String
' Khai baùo bieán.
n = Node.Index
' Gaùn n ñeán chæ muïc index cuûa node choïn.
strParents = Node.Text & vbLf
While n <> Node.Root.Index
strParents = strParents & _
TreeView1.Nodes(n).Parent.Text & vbLf
' Gaùn n ñeán chæ muïc index cuûa node cha keá tieáp.
n = TreeView1.Nodes(n).Parent.Index
Wend
MsgBox strParents
End Sub

THUOC TINH ROTATION

Private Sub Command1_Click()
' Gaùn kieåu 3d bar.
MSChart1.chartType = VtChChartType3dBar
WithMSChart1.Plot.View3d
.Elevation = 90
' Nhìn töø döôùi leân treân cuûa Chart.
.Rotation = 90
End With
End Sub

THUOC TINH ROW

Private Sub Command1_Click()
With MSChart1
' Hieån thò Chart daïng 3d vôùi 8 coät vaø 8 haøng döõ lieäu

.chartType = VtChChartType3dBar
.ColumnCount = 8
.RowCount = 8
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, index1, _
index2, index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, index1, _
index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH ROWCOUNT

Private Sub Command1_Click()
With MSChart1
' Hieån thò Chart daïng 3d vôùi 8 coät vaø 8 haøng döõ lieäu

.chartType = VtChChartType3dBar
.ColumnCount = 8
.RowCount = 8
For Column = 1 To 8
For Row = 1 To 8
.Column = Column
.Row = Row
.Data = Row * 10
Next Row
Next Column
.ShowLegend = True
.SelectPart VtChPartTypePlot, index1, _
index2, index3, index4
.EditCopy
.SelectPart VtChPartTypeLegend, index1, _
index2, index3, index4
.EditPaste
End With
End Sub

THUOC TINH ROWCOUNT (COOLBAR)

Private Sub Form_Load()
' Canh leà
cbrMain.Align = vbAlignTop
End Sub

Private Sub Form_Click()
' Theâm moät band, gaùn THUOC TINH NewRow laø True
cbrMain.Bands.Add NewRow:=True
' trình baøy taát caû caùc rows vaø bands
Debug.Print "Rows: " & cbrMain.RowCount
Debug.Print "Bands: " & cbrMain.Bands.Count
End Sub

THUOC TINH ROWHEIGHT (DATAGRID)

Private Sub CreateRecordset()
' Taïo moät recordset bao goàm 7 coät vaø 10 maåu tin vaø gaùn THUOC TINH ' DataSource vôùi ñoái töôïng recrodset.

Dim rs As New Recordset
Dim i As Integer
Dim j As Integer

rs.Fields.Append "id", adBigInt, 255
For i = 1 To 6
rs.Fields.Append "col" & i, adVarChar, 255
Next i

rs.Open
For i = 1 To 10
rs.AddNew
rs.Fields("id").Value = i
For j = 1 To 6
rs.Fields(j).Value = "row " & i & " Value " & j
Next j
Next i

Set DataGrid1.DataSource = rs
End Sub
Private Sub Form_Click()
DataGrid1.RowHeight = 500
End Sub

Private Sub Form_Load()
CreateRecordset
End Sub

THUOC TINH ROWHEIGHT

Private Sub Form_Load()
Timer1.Interval = 500
MSFlexGrid1.RowHeight(0) = 300
MSFlexGrid1.Text = "Focus Here"
MSFlexGrid1.Cols = 3
MSFlexGrid1.Rows = 5

End Sub

Private Sub Timer1_Timer()
MSFlexGrid1.CellFontBold = 1
MSFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH ROWHEIGHTMIN

Private Sub Form_Load()
Timer1.Interval = 500
MSFlexGrid1.RowHeightMin = 100
MSFlexGrid1.Text = "Focus Here"
MSFlexGrid1.Cols = 3
MSFlexGrid1.Rows = 5

End Sub

Private Sub Timer1_Timer()
MSFlexGrid1.CellFontBold = 1
MSFlexGrid1.CellBackColor = QBColor(Rnd * 15)
MSFlexGrid1.CellForeColor = QBColor(Rnd * 10)
End Sub

THUOC TINH RECORDSOURCE

Private Sub Form_Load()
' Söû duïng chu chuoãi keát noái vôùi ñieàu khieån ADO Data
Dim ConnectionString As String
ConnectionString = _
"Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=C:\Program Files\Microsoft Visual Studio\VB98\Nwind.mdb;" & _
"Uid=;Pwd="

‘ Laøm vieäc vôùi ñieàu khieån ADODC1
With Adodc1
.RecordSource = _
"SELECT ProductName, ProductID, " & _
" SupplierID FROM Products"
.ConnectionString = ConnectionString
.Refresh
.Caption = "Products"
.Visible = False
End With

‘ Laøm vieäc vôùi ñieàu khieån ADODC1
With Adodc2
.RecordSource = "SELECT CompanyName, " & _
" SupplierID FROM Suppliers"
.ConnectionString = ConnectionString
.Refresh
.Caption = "Suppliers"
.Visible = False
End With

‘ Gaùn THUOC TINH DataSource cuûa DataGrid baèng ADODC1
Set DataGrid1.DataSource = Adodc1

With DataList1
Set .DataSource = Adodc1
.DataField = "SupplierID"
' Khai baùo coät döõ lieäu.
.BoundColumn = "SupplierID"
' Coät döõ lieäu trong ADODC2 thay ñoåi DataField.
Set .RowSource = Adodc2
.ListField = "CompanyName"
' Döõ lieäu trình baøy treân ñieàu khieån DataCombo.
End With

' Ñoàng boä hoaù giöõa DataGrid vaø DataCombo baèng caùch
' chuyeån ñeán maåu tin ñaàu tieân cuûa of ADODC1
Adodc1.Recordset.MoveFirst
End Sub

THUOC TINH SCROLL

Private Sub cmdMake_Click()
tvwDB.Sorted = True
tvwDB.Scroll=True
Set mNode = tvwDB.Nodes.Add()
mNode.Text = "Publisher"
Set mNode = tvwDB.Nodes.Add()
mNode.Text = "Private"
Set mNode = tvwDB.Nodes.Add(1, tvwChild)
mNode.Text = "DEF"
Set mNode = tvwDB.Nodes.Add(1, tvwChild)
mNode.Text = "GHI"
Set mNode = tvwDB.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-1"
mNode.Bold = True
Set mNode = tvwDB.Nodes.Add(2, tvwChild)
mNode.Text = "ABC-2"
Set mNode = tvwDB.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-1"
Set mNode = tvwDB.Nodes.Add(3, tvwChild)
mNode.Text = "DEF-2"
Set mNode = tvwDB.Nodes.Add(1, tvwChild)
mNode.Text = "ABCD"
End Sub

THUOC TINH SCROLLBARS

Private Sub Form_Load()
Me.txtDesc.MultiLine = True
Me.txtDesc.ScrollBars = 2
End Sub

THUOC TINH SECOND

Private Sub Form_Load()
Me. DateTimePicker1.Second = 3
End Sub

THUOC TINH SELALIGNMENT

Private Sub Option1_Click(Index As Integer)
If RichTextBox1.SelLength > 0 Then
RichTextBox1.SelAlignment = Index
End If
End S

THUOC TINH SELITALIC, SELSTRIKETHRU, SELUNDERLINE

Private Sub Option1_Click(Index As Integer)
If RichTextBox1.SelLength > 0 Then
RichTextBox1.SelAlignment = Index
End If
If IsNull(RichTextBox1.SelBold) = True Then

ElseIf RichTextBox1.SelBold = False Then

End If
End S

THUOC TINH SELCOLOR

Private Sub Command1_Click()
CommonDialog1.ShowColor
RichTextBox1.SelColor = CommonDialog1.Color
End Sub

THUOC TINH SELCOUNT

Private Sub cmdSelect_Load()
MsgBox (ListBox.SelCount)
End Sub

THUOC TINH SELECTED

Private Sub Form_Load()
Me.ListBox1.Selected(5) = True
End Sub

THUOC TINH SELECTEDITEM

Private Sub Form_Load()
MsgBox (DataList1.SelectedItem)
End Sub

THUOC TINH SELECTRANGE

Private Sub Form_Load()
‘ Gaùn giaù trò lôùn nhaát cho ñieàu khieån slider
Slider1.Max = 20
End Sub

Private Sub Slider1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Shift = 1 Then
' Neáu nhaán phím Shift
Slider1.SelectRange = True
' Baát THUOC TINH SelectRange.
Slider1.SelStart = Slider1.Value
' Gaùn giaù trò SelStart
Slider1.SelLength = 0
' Gaùn chieàu daøi.
End If
End Sub

Private Sub Slider1_MouseUp(Button As Integer, _
Shift As Integer, x As Single, y As Single)

If Shift = 1 Then
' Neáu ngöôøi söû duïng choïn tröôùc ñoù thì loãi phaùt sinh.
On Error Resume Next
' Ngöôïc laïi gaùn SelLength baèng caùch söû duïng SelStart vaø
‘ giaù trò hieän haønh.
Slider1.SelLength = _
Slider1.Value - Slider1.SelStart
Else
Slider1.SelectRange = False
' Neáu ngöôøi söû duïng nhaû phím SHIFT.
End If
End Sub

THUOC TINH SELSTART, SELEND

Private Sub Form_Load()
With MonthView1
.MultiSelect = True
.Value = CDate("11/8/98")
.SelStart = CDate("11/8/98")
.SelEnd = CDate("11/14/98")
End With
End Sub

THUOC TINH SELSTARTCOL, SELENDCOL

Private Sub Form_Load()
With DataGrid1
.SelStartCol = 1
.SelEndRow =5
End With
End Sub

THUOC TINH SELFONTNAME

Private Sub Command1_Click()
CommonDialog1.Flags = cdlCFBoth
CommonDialog1.ShowFont
With RichTextBox1
.SelFontName = CommonDialog1.FontName
.SelFontSize = CommonDialog1.FontSize
.SelBold = CommonDialog1.FontBold
.SelItalic = CommonDialog1.FontItalic
.SelStrikeThru = _
CommonDialog1.FontStrikethru
.SelUnderline = CommonDialog1.FontUnderline
End With
End Sub

THUOC TINH SELFONTSIZE

Private Sub Command1_Click()
CommonDialog1.Flags = cdlCFBoth
CommonDialog1.ShowFont
With RichTextBox1
.SelFontName = CommonDialog1.FontName
.SelFontSize = CommonDialog1.FontSize
.SelBold = CommonDialog1.FontBold
.SelItalic = CommonDialog1.FontItalic
.SelStrikeThru = _
CommonDialog1.FontStrikethru
.SelUnderline = CommonDialog1.FontUnderline
End With
End Sub

THUOC TINH SESSION

Private Sub MainPage_btnSendMe()
Webclass.Session("userid")=”12”
Webclass.Session("email")=”abc@abc.com”
End Sub

THUOC TINH SHOW

Private Sub Command1_Click()
Dim serX As Series
MSChart1.chartType = VtChChartType2dLine
For Each serX In MSChart1.Plot.SeriesCollection
serX.SeriesMarker.Show = True
serX.ShowLine = False
Next
End Sub

THUOC TINH SHOWLEGEND

Private Sub Command1_Click()
Dim serX As Series
' Thay ñoåi Chart loaïi 3D line
MSChart1.chartType = VtChChartType3dLine
MSChart1.ColumnCount = 4
MSChart1.ShowLegend=True
For Each serX In MSChart1.Plot.SeriesCollection
serX.ShowGuideLine(VtChAxisIdY) = True
serX.GuideLinePen.Style = VtPenStyleDitted
serX.Pen.Style = 4
Next
End Sub

THUOC TINH SHOWLINE

Private Sub Command1_Click()
Dim serX As Series
' Thay ñoåi Chart loaïi 3D line
MSChart1.chartType = VtChChartType3dLine
MSChart1.ColumnCount = 4
MSChart1.ShowLegend=True
For Each serX In MSChart1.Plot.SeriesCollection
serX.ShowGuideLine(VtChAxisIdY) = True
serX.ShowLine = True
serX.GuideLinePen.Style = VtPenStyleDitted
serX.Pen.Style = 4
Next
End Sub

THUOC TINH SHOWTODAY

Private Sub Form_Load()
Me.MonthView1.ShowToDay = True
End Sub

THUOC TINH SIMPLETEXT

Private Sub Form_Load()
Dim I As Integer
For I = 1 To 2
StatusBar1.Panels.Add
' Theâm hai ñoái töôïng 2 Panel.
Next I

With StatusBar1.Panels
.Item(1).Style = sbrNum
' Ngaên Number lock
.Item(2).Style = sbrCaps
' Ngaên Caps lock
.Item(3).Style = sbrScrl
' Ngaên Scroll lock
End With
End Sub

Private Sub StatusBar1_Click()
With StatusBar1
If .Style = 0 Then
' Chuoãi seõ xuaát hieän khi THUOC TINH Syle cuûa StatusBar
‘ laø Simple
.SimpleText = "Date and Time: " & Now
.Style = sbrSimple
' Kieåu Simple
Else
.Style = sbrNormal
' Kieåu Normal
End If
End With
End Sub

THUOC TINH SIZE

Private Sub Form_Click()
Font.Bold = Not Font.Bold
Font.Strikethrough = Not Font.Strikethrough
Font.Italic = Not Font.Italic
Font.Underline = Not Font.Underline
Font.Size = 16
If Font.Bold Then
Print "Font weight is " & _
Font.Weight & " (bold)."
Else
Print "Font weight is " & _
Font.Weight & " (not bold)."
End If
End Sub

THUOC TINH SORT

Private Sub Combo1_Click()
' Choïn coät ñeå saép xeáp döõ lieäu.
Select Case Combo1.ListIndex
Case 0 To 2
MSHFlexGrid1.Col = 1
Case 3 To 4
MSHFlexGrid1.Col = 2
Case 4 To 8
MSHFlexGrid1.Col = 1
End Select
' Saép xeáp theo giaù trò choïn trong Combo1
MSHFlexGrid1.Sort = Combo1.ListIndex
End Sub
Private Sub Form_Load()
Dim i As Integer
' Ñieàn döõ lieäu ngaãu nhieân vaøo ñieàu khieån MSHFlexGrid.
MSHFlexGrid1.Cols = 3
' Theâm 3 coät

For i = 1 To 11
' Theâm 10 phaàn töû
MSHFlexGrid1.AddItem ""
MSHFlexGrid1.Col = 2
MSHFlexGrid1.TextMatrix(i, 1) = SomeName(i)
MSHFlexGrid1.TextMatrix(i, 2) = Rnd()
Next i
' Dieàn loaïi saép xeáp döõ lieäu vaøo ñieàu khieån Combo
With Combo1
.AddItem "flexSortNone" ' 0
.AddItem "flexSortGenericAscending" '1
.AddItem "flexSortGenericDescending" '2
.AddItem "flexSortNumericAscending" '3
.AddItem "flexSortNumericDescending" '4
.AddItem "flexSortStringNoCaseAsending" '5
.AddItem "flexSortNoCaseDescending" '6
.AddItem "flexSortStringAscending" '7
.AddItem "flexSortStringDescending" '8
.ListIndex = 0
End With
End Sub
Private Function SomeName(i As Integer) As String
Select Case i
Case 1
SomeName = "Ann"
Case 2
SomeName = "Glenn"
Case 3
SomeName = "Sid"
Case 4
SomeName = "Anton"
Case 5
SomeName = "Hoagie"
Case 6
SomeName = "Traut 'Trane"
Case 7
SomeName = "MereD Wah"
Case 8
SomeName = "Kemp"
Case 9
SomeName = "Sandy"
Case 10
SomeName = "Lien"
Case 11
SomeName = "Randy"
End Select
End Function

THUOC TINH SORTED
Private Sub Option1_Click(Index As Integer)
' Gaùn THUOC TINH Arrange vaøo THUOC TINH Index cuûa ñieàu
‘ khieån Option1.
ListView1.Arrange = Index
End Sub


Private Sub Form_Load()
' Ñònh nghóa nhaõn cho ñieàu khieån OptionButton
Option1(0).Caption = "No Arrange"
Option1(1).Caption = "Align Auto Left"
Option1(2).Caption = "Align Auto Top"
' Khai baùo bieán ñeå taïo ñoái töôïng ListView vaø ImageList.
Dim i As Integer
Dim itmX As ListItem
Dim imgX As ListImage
' Khai baùo bieán ñoái töôïng cho ñoái töôïng ListImages.

' Theâm ñoái töôïng ListImage vaøo ñieàu khieån ImageList.
Set imgX = ImageList1.ListImages. _
Add(, , LoadPicture("icons\mail01a.ico"))

ListView1.Icons = ImageList1
ListView1.Sorted = True
' Choïn bieåu töôïng öùng vôùi ñieàu khieån ImageList.

' Theâm 10 ñoái töôïng ListItem, moãi ñoái töôïng öùng vôùi 1 Icon.
For i = 1 To 10
Set itmX = ListView1.ListItems.Add()
itmX.Icon = 1
itmX.Text = "ListItem " & i
Next i
End Sub

THUOC TINH SORTED (TREEVIEW)

Private Sub Form_Load()
' Create a tree with several unsorted Node objects.
Dim nodX As Node
Set nodX = tvw1.Nodes.Add(, , , "Adam")
Set nodX = tvw1.Nodes.Add(1, _
tvwChild, "z", "Zachariah")
Set nodX = tvw1.Nodes.Add(1, _
tvwChild, , "Noah")
Set nodX = tvw1.Nodes.Add(1, _
tvwChild, , "Abraham")
Set nodX = tvw1.Nodes.Add("z", _
tvwChild, , "Stan")
Set nodX = tvw1.Nodes.Add("z", _
tvwChild, , "Paul")
Set nodX = tvw1.Nodes.Add("z", _
tvwChild, "f", "Frances")
Set nodX = tvw1.Nodes.Add("f", _
tvwChild, , "Julie")
Set nodX = tvw1.Nodes.Add("f", _
tvwChild, "c", "Carol")
Set nodX = tvw1.Nodes.Add("f", _
tvwChild, , "Barry")
Set nodX = tvw1.Nodes.Add("c", _
tvwChild, , "Yale")
Set nodX = tvw1.Nodes.Add("c", _
tvwChild, , "Harvard")
nodX.EnsureVisible
End Sub

Private Sub tvw1_NodeClick(ByVal Node As Node)
Dim answer As Integer
' Kieåm tra neáu coù Node con
If Node.Children > 1 Then
' Coù nhieàu hôn moät Node con.
answer = MsgBox("Sort this node?", vbYesNo)
' Nhaéc nhôû ngöôøi söû duïng
If answer = vbYes Then
' Neáu ngöôøi söû duïng muoán saép xeáp.
Node.Sorted = True
End If
End If
End Sub

THUOC TINH SORTORDER

Private Sub Option1_Click(Index As Integer)
' Gaùn THUOC TINH Arrange vaøo THUOC TINH Index cuûa ñieàu
‘ khieån Option1.
ListView1.Arrange = Index
ListView1.SortOrder = lvwAscending
End Sub

Private Sub Form_Load()
' Ñònh nghóa nhaõn cho ñieàu khieån OptionButton
Option1(0).Caption = "No Arrange"
Option1(1).Caption = "Align Auto Left"
Option1(2).Caption = "Align Auto Top"
' Khai baùo bieán ñeå taïo ñoái töôïng ListView vaø ImageList.
Dim i As Integer
Dim itmX As ListItem
Dim imgX As ListImage
' Khai baùo bieán ñoái töôïng cho ñoái töôïng ListImages.

' Theâm ñoái töôïng ListImage vaøo ñieàu khieån ImageList.
Set imgX = ImageList1.ListImages. _
Add(, , LoadPicture("icons\mail01a.ico"))

ListView1.Icons = ImageList1
ListView1.Sorted = True
' Choïn bieåu töôïng öùng vôùi ñieàu khieån ImageList.

' Theâm 10 ñoái töôïng ListItem, moãi ñoái töôïng öùng vôùi 1 Icon.
For i = 1 To 10
Set itmX = ListView1.ListItems.Add()
itmX.Icon = 1
itmX.Text = "ListItem " & i
Next i
End Sub

THUOC TINH SOURCE

Private Sub Form_Load()
Dim MyClass, MyObjectID
Dim MyHelpFile, MyHelpContext

MyObjectID = App.Title & "." & MyClass.Name
err.Raise Number:=vbObjectError + 894, _
Source:=MyObjectID, _
Description:= _
"Was not able to complete your task", _
HelpFile:=MyHelpFile, HelpContext:=MyHelpContext
End Sub

THUOC TINH SATRTOFWEEK

Private Sub Command1_Click()
With MonthView1
.StartOfWeek = mvwMonday
End With
End Sub

THUOC TINH STATE

Private Sub cmdDis_Click()
tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()

tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
tcpServer.GetData strData
txtOutput.Text = strData
End Sub

THUOC TINH STYLE (TOOLBAR)

Private Sub Form_Resize()
With Toolbar1.Buttons("Combo1")
Combo1.Move .Left, .Top, .Width
End With
Toolbar1.Style = tbrStandard
End Sub

THUOC TINH STYLE (STATUSBAR)

Private Sub Form_Load()
Dim I As Integer
For I = 1 To 2
StatusBar1.Panels.Add
Next I
With StatusBar1.Panels
.Item(1).Style = sbrDate
' Date
.Item(2).Style = sbrCaps
' Caps lock
.Item(3).Style = sbrScrl
' Scroll lock
End With

End Sub

Private Sub StatusBar1_Click()
With StatusBar1
If .Style = sbrNormal Then
.SimpleText = Time
' Trình baøy thôøi gian
.Style = sbrSimple
' Kieåu ñôn giaûn
Else
.Style = sbrNormal
' Kieåu bình thöôøng
End If
End With
End Sub

THUOC TINH STYLE (TREEVIEW)

Private Sub Form_Load()
Dim nodX As Node
Set nodX = tvw1.Nodes.Add(, , , "Root")
Set nodX = tvw1.Nodes.Add(1, tvwChild, , "Dir1")
Set nodX = tvw1.Nodes.Add(2, tvwChild, , "Dir2")
Set nodX = tvw1.Nodes.Add(3, tvwChild, , "Dir3")
Set nodX = tvw1.Nodes.Add(4, tvwChild, , "Dir4")
nodX.EnsureVisible
' Trình baøy taát caû caùc Node.
tvw1.Style = tvwTreelinesPlusMinusText
' Loaïi 4.
End Sub

THUOC TINH SUBFOLDERS

Private Sub Command1_Click()
Dim fs, f, f1, s, sf
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\")
Set sf = f.SubFolders
For Each f1 In sf
s = s & f1.Name
s = s & vbCrLf
Next
MsgBox s
End Sub

THUOC TINH SUBITEMINDEX

Private Sub Command1_Click()
' Khai baùo loaïi trình baøy döõ lieäu.
lstv1.View = lvwReport

' Theâm 3 coät döõ lieäu
lstv1.ColumnHeaders.Add , "Name", "Name"
lstv1.ColumnHeaders.Add , "Address", "Address"
lstv1.ColumnHeaders.Add , "Phone", "Phone"

' Theâm 2 ñoái töôïng ListItem vaøo ñieàu khieån.
Dim itmX As ListItem
' Gaùn teân cho coät thöù 1.
Set itmX = lstv1.ListItems.Add(1, _
"Mary", "Mary")
' Söû duïng SubItemIndex keát hôïp vôùi SubItem trong
' ColumnHeader. Duøng töø khoaù ("Address") chæ ñònh ñuùng
' ColumnHeader.
itmX.SubItems(lstv1.ColumnHeaders( _
"Address").SubItemIndex) _
= "212 Grunge Street"
' Söû duïng khoaù ColumnHeader key phuø hôïp vôùi chuoãi SubItems
' cho ColumnHeader.
itmX.SubItems(lstv1.ColumnHeaders( _
"Phone").SubItemIndex) = "555-1212"

Set itmX = lstv1.ListItems.Add(2, _
"Bill", "Bill")
itmX.SubItems(lstv1.ColumnHeaders( _
"Address").SubItemIndex)="101 Pacific Way"
itmX.SubItems(lstv1.ColumnHeaders( _
"Phone").SubItemIndex) = "555-7879"
End Sub

THUOC TINH SUBITEM

Private Sub Command1_Click()
' Khai baùo loaïi trình baøy döõ lieäu.
lstv1.View = lvwReport

' Theâm 3 coät döõ lieäu
lstv1.ColumnHeaders.Add , "Name", "Name"
lstv1.ColumnHeaders.Add , "Address", "Address"
lstv1.ColumnHeaders.Add , "Phone", "Phone"

' Theâm 2 ñoái töôïng ListItem vaøo ñieàu khieån.
Dim itmX As ListItem
' Gaùn teân cho coät thöù 1.
Set itmX = lstv1.ListItems.Add(1, _
"Mary", "Mary")
' Söû duïng SubItemIndex keát hôïp vôùi SubItem trong
' ColumnHeader. Duøng töø khoaù ("Address") chæ ñònh ñuùng
' ColumnHeader.
itmX.SubItems(lstv1.ColumnHeaders( _
"Address").SubItemIndex) _
= "212 Grunge Street"
' Söû duïng khoaù ColumnHeader key phuø hôïp vôùi chuoãi SubItems
' cho ColumnHeader.
itmX.SubItems(lstv1.ColumnHeaders( _
"Phone").SubItemIndex) = "555-1212"

Set itmX = lstv1.ListItems.Add(2, _
"Bill", "Bill")
itmX.SubItems(lstv1.ColumnHeaders( _
"Address").SubItemIndex)="101 Pacific Way"
itmX.SubItems(lstv1.ColumnHeaders( _
"Phone").SubItemIndex) = "555-7879"
End Sub

THUOC TINH TAB

Private Sub Command1_Click()
SSTab1.Tab = 1
End Sub

THUOC TINH TABINDEX

Private Sub Form_Click()
Dim I, X
' Khai baùo bieán.
' Ñaûo ngöôïc Tab.
If CommandX(0).TabIndex = 0 Then X = 4 Else X = 1
For I = 0 To 3
CommandX(I).Caption = X
' Gaùn THUOC TINH Caption.
CommandX(I).TabIndex = X - 1
' Gaùn thöù töï Tab.
If CommandX(0).TabIndex = 3 Then
X = X - 1
' Giaûm giaù trò cho X.
Else
X = X + 1
' Taêng giaù trò cho X.
End If
Next I
End Sub

THUOC TINH TAG

Private Sub Form_Load()
Picture1.Tag = "ICONS\ARROWS\POINT03.ICO"
Picture2.Tag = "ICONS\ARROWS\POINT04.ICO"
End Sub

Private Sub Picture3_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If State = vbEnter Then
' Choïn moãi ñieàu khieån döïa vaøo THUOC TINH Name.
Select Case Source.Name
Case "Picture1"
' Naïp Icon vaøo PictureBox1.
Source.DragIcon = LoadPicture(Picture1.Tag)
Case "Picture2"
' Naïp Icon vaøo PictureBox2.
Source.DragIcon = LoadPicture(Picture2.Tag)
End Select
ElseIf State = vbLeave Then
Source.DragIcon = LoadPicture()
End If
End Sub

THUOC TINH TEXT

Private Sub Form_Load()
Me.Text1.Text = “www.huukhang.com”
End Sub

THUOC TINH TEXTALIGNMENT

Private Sub Form_Load()
Toolbar1.TextAlignment = tbrTextAlignRight
End Sub

THUOC TINH TITLE

Private Sub Form_Load()
Me.MSChart1.Title = “Sales Analysis”
End Sub

THUOC TINH TITLETEXT

Private Sub Form_Load()
Me.MSChart1.TitleText = “Sales Analysis”
End Sub

THUOC TINH TOOLTIP

Private Sub Form_Load()
Me.txtName.ToolTip = “Name of Item”
Me.txtDesc.ToolTip = “Description of Item”
End Sub

THUOC TINH TOP

Private Sub Form_Load()
Me.txtNo.Top = 100
Me.txtName.Top = 120
End Sub

THUOC TINH TYPE (FILE VAØ FOLDER)

Sub ShowFileSize(filespec)
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(filespec)
s = UCase(f.Name) & " is a " & f.Type
MsgBox s, 0, "File Size Info"
End Sub

THUOC TINH TYPE (MSCHART)

Private Sub Command1_Click()
' Thay ñoåi tyû leä cuûa hai truïc x vaø y öùng vôùi Perscentage
‘ cuûa kieåu 2D Line.
Dim axisID As VtChAxisId
MSChart1.chartType = VtChChartType2dLine
For axisID = VtChAxisIdX To VtChAxisIdY
With MSChart1.Plot.Axis(axisID).AxisScale
.Type = VtChScaleTypePercent
.PercentBasis = _
VtChPercentAxisBasisSumChart
End With
Next
End Sub

Private Sub Command2_Click()
Dim axisID As VtChAxisId
' Thay ñoåi tyû leä cuûa hai truïc x vaø y öùng vôùi Logarithmic
‘ cuûa kieåu 2D Line.
MSChart1.chartType = VtChChartType2dLine
For axisID = VtChAxisIdX To VtChAxisIdY
With MSChart1.Plot.Axis(axisID).AxisScale
.Type = VtChScaleTypeLogarithmic
.LogBase = 12
End With
Next
End Sub

THUOC TINH UBOUND

Private Sub Form_Paint()
Static FlagFormPainted As Integer
If FlagFormPainted <> True Then
' Khi Form naïp leân laàn ñaàu tieân
For i = 1 To 3
Load Option1(i)
' Theâm 3nuùt daïng OptionButton thaønh moät maûng ñieàu khieån.
Option1(i).Top = Option1(i - 1).Top + 350
Option1(i).Visible = True
Next i
For i = 0 To 3
' Gaùn THUOC TINH caption treân moãi nuùt.
Option1(i).Caption = "Option #" & CStr(i)
Next i
Option1(0).Value = True
' Choïn nuùt option ñaàu tieân
FlagFormPainted = True
End If
End Sub
Private Sub Form_Click()
Print "Control array's Count property is " & _
Option1().Count
Print "Control array's LBound property is " & _
Option1().LBound
Print "Control array's UBound property is " & _
Option1().UBound
End Sub

THUOC TINH UNDERLINE

Private Sub Form_Click()
Font.Bold = Not Font.Bold
' In ñaäm
Font.Strikethrough = Not Font.Strikethrough
' In gaïch giöõa (strikethrough).
Font.Italic = Not Font.Italic
' In nghieân.
Font.Underline = Not Font.Underline
' In gaïch döôùi.
Font.Size = 16
' Gaùn THUOC TINH kích thöôùc.
If Font.Bold Then
Print "Font weight is " & _
Font.Weight & " (bold)."
Else
Print "Font weight is " & _
Font.Weight & " (not bold)."
End If
End Sub

THUOC TINH UPDOWN

Private Sub Form_Load()
Me. DateTimePicker1.UpDown = False
End Sub

THUOC TINH URL

Private Sub btnGetHTMLDoc_Click()
With Inet1
.URL = "http://www.huukhang.com/"
.Document = " popupsubcribe.htm "
.Execute , "GET"
End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
Dim strHTML As String
Dim vtData As String
Select Case state
' Tröôøng hôïp khaùc thì khoâng trình baøy
Case icResponseCompleted
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
strHTML = strHTML & vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
txtHTML.Text = strHTML
End Select
End Sub

THUOC TINH USERNAME

Private Sub btnGetDir_Click()
With Inet1
.URL = "ftp://ftp.learn.huukhang.com/"
.UserName = "John Smith"
.Password = "mAuI&9$6"
.Execute , "DIR"
' Traû veà thö muïc
End With
End Sub

THUOC TINH USERNAME (ADO)

Private Sub Command1_Click()
With Adodc1
.UserName = txtUserName.Text
.Password = txtPassword.Text
.CursorLocation = adUseClient
.ConnectionString = _
"Provider=SQLOLEDB.1;Persist Security" & _
"Info=True;Initial Catalog=Northwind;" & _
"Data Source=localhost"
.RecordSource = "SELECT * FROM Products"
.Refresh
End With
End Sub

THUOC TINH VALUE

Private Sub Form_Load()
HScroll1.Min = 0
' KHôûi taïo giaù trò cho scroll bar.
HScroll1.Max = 1000
HScroll1.LargeChange = 100
HScroll1.SmallChange = 1
End Sub

Private Sub HScroll1_Change()
Text1.Text = Format(HScroll1.Value)
End Sub

THUOC TINH VALUE

Private Sub MonthView1_DateClick( _
ByVal DateClicked As Date)
MonthView1.Value = "June 5, 1995"
End Sub

THUOC TINH VIEW

Private Sub Command1_Click()
' Khai baùo loaïi trình baøy döõ lieäu.
lstv1.View = lvwReport

' Theâm 3 coät döõ lieäu
lstv1.ColumnHeaders.Add , "Name", "Name"
lstv1.ColumnHeaders.Add , "Address", "Address"
lstv1.ColumnHeaders.Add , "Phone", "Phone"

' Theâm 2 ñoái töôïng ListItem vaøo ñieàu khieån.
Dim itmX As ListItem
' Gaùn teân cho coät thöù 1.
Set itmX = lstv1.ListItems.Add(1, _
"Mary", "Mary")
' Söû duïng SubItemIndex keát hôïp vôùi SubItem trong
' ColumnHeader. Duøng töø khoaù ("Address") chæ ñònh ñuùng
' ColumnHeader.
itmX.SubItems(lstv1.ColumnHeaders( _
"Address").SubItemIndex) _
= "212 Grunge Street"
' Söû duïng khoaù ColumnHeader key phuø hôïp vôùi chuoãi SubItems
' cho ColumnHeader.
itmX.SubItems(lstv1.ColumnHeaders( _
"Phone").SubItemIndex) = "555-1212"

Set itmX = lstv1.ListItems.Add(2, _
"Bill", "Bill")
itmX.SubItems(lstv1.ColumnHeaders( _
"Address").SubItemIndex)="101 Pacific Way"
itmX.SubItems(lstv1.ColumnHeaders( _
"Phone").SubItemIndex) = "555-7879"
End Sub

THUOC TINH VISIBLE

Private Sub cmdDate_Click()
If MonthView1.Visible=True Then
Me.MonthView1.Visible=False
Else
MonthView1.Visible=True
End If
End Sub

THUOC TINH VISIBLECOLS

Private Sub PageRight_Click()
If DataGrid1.LeftCol + _
DataGrid1.VisibleCols < _
DataGrid1.Columns.Count Then
DataGrid1.LeftCol = DataGrid1.LeftCol + _
DataGrid1.VisibleCols
End If
End Sub

Private Sub PageLeft_Click()
If DataGrid1.LeftCol - _
DataGrid1.VisibleCols >= 0 Then
DataGrid1.LeftCol = DataGrid1.LeftCol - _
DataGrid1.VisibleCols
End If
End Sub

THUOC TINH VISIBLECOUNT

Private Sub Command1_Click()
Dim I As Integer, fld As Field, msg As Variant
For I = 0 To DataList1.VisibleCount - 1
Data1.Recordset.Bookmark = _
DataList1.VisibleItems(I)
msg = ""
For Each fld In Data1.Recordset.Fields
msg = msg & fld.Value & "-"
Next
MsgBox msg
Next I
End Sub

THUOC TINH VISIBLEDAYS

Private Sub Form_DblClick()
Dim i As Integer
For i = 1 To 42
Debug.Print MonthView1.VisibleDays(i)
Next i
End Sub

THUOC TINH VISIBLEITEMS

Private Sub Command1_Click()
Dim I As Integer, fld As Field, msg As Variant
For I = 0 To DataList1.VisibleCount - 1
Data1.Recordset.Bookmark = _
DataList1.VisibleItems(I)
msg = ""
For Each fld In Data1.Recordset.Fields
msg = msg & fld.Value & "-"
Next
MsgBox msg
Next I
End Sub

THUOC TINH VISIBLEROWS

Private Sub SelectVisible_Click()
Dim I
For I = 0 To DataGrid1.VisibleRows - 1
DataGrid1.SelBookmarks.Add _
DataGrid1.RowBookmark(I)
Next I
End Sub

THUOC TINH WEEK

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Select Case MonthView1.Month
Case 1 To 3
Label1.Caption = "First Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case 4 To 6
Label1.Caption = "Second Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case 7 To 9
Label1.Caption = "Third Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case Else
Label1.Caption = "Fourth Quarter of " & _
MonthView1.Year & " Week " & MonthView1.Week
End Select
End Sub

THUOC TINH WEIGHT

Private Sub Form_Click()
Font.Bold = Not Font.Bold
Font.Strikethrough = Not Font.Strikethrough
Font.Italic = Not Font.Italic
Font.Underline = Not Font.Underline
Font.Size = 16
If Font.Bold Then
Print "Font weight is " & _
Font.Weight & " (bold)."
Else
Print "Font weight is " & _
Font.Weight & " (not bold)."
End If
End Sub

THUOC TINH WIDTH

Private Sub Command1_Click()
txtName.Width = 100
End Sub

THUOC TINH WINDOWLIST

Private Sub Form_Load()
FileMenu(0).Caption = "&New"
' Gaùn access key treân THUOC TINH Caption
Load FileMenu(1)
' Taïo môùi menu item.
FileMenu(1).Caption = "-"
' Taïo ñöôøng phaân caùch
Load FileMenu(2)
' Taïo môùi Item trong Menu.
FileMenu(2).Caption = "E&xit"
' Gaùn THUOC TINH caption vaø access key.
End Sub

Private Sub FileMenu_Click(Index As Integer)
Select Case Index
Case 0
' Choï môùi moät leänh.
Dim NewForm As New Form1
' Taïo moät Form vaø naïp NewForm.
NewForm.Caption = "Untitled" & Forms.Count
Case 2
' Choïn leänh Exit.
End
' Keát thuùc chöông trình.
End Select
End Sub

THUOC TINH WINDOWSTATE

Private Sub Form_Load()
Form2.Show
End Sub

Private Sub Form_Resize()
If Form1.WindowState = vbMinimized Then
Form2.Visible = False
Else
Form2.Visible = True
End If
End Sub

THUOC TINH WORDWRAP

Private Sub Form_Load()
Dim Author1, Author2, Quote1, Quote2
' Khai baùo bieán
Label1.AutoSize = True
' Gaùn THUOC TINH AutoSize.
Label2.AutoSize = True
Label1.WordWrap = True
' Gaùn THUOC TINH WordWrap.
Quote1 = "I couldn't wait for success," & _
"so I went on without it."
Author1 = " - Jonathan Winters"
Quote2 = "Logic is a system whereby one" & _
" may go wrong with confidence."
Author2 = " - Charles Kettering"
Label1.Caption = Quote1 & Chr(10) & Author1
Label2.Caption = Quote2 & Chr(10) & Author2
End Sub

Private Sub Form_Click()
Label1.Width = 1440
' Gaùn THUOC TINH width töø 1 inch.
Label2.Width = 1440
Label1.WordWrap = Not Label1.WordWrap
' Gaùn THUOC TINH WordWrap.
Label2.WordWrap = Not Label2.WordWrap
End Sub

THUOC TINH WRAP

Private Sub Form_Load()
UpDown1.BuddyControl = Text1
With UpDown1
.Min = 10
.Max = 70
.Increment = 10
.Wrap = True
.SyncBuddy = True
End With

Text1.Text = UpDown1.Value
End Sub

THUOC TINH YEAR

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Select Case MonthView1.Month
Case 1 To 3
Label1.Caption = "First Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case 4 To 6
Label1.Caption = "Second Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case 7 To 9
Label1.Caption = "Third Quarter of " & _
MonthView1.Year & " Week " & _
MonthView1.Week
Case Else
Label1.Caption = "Fourth Quarter of " & _
MonthView1.Year & " Week " & MonthView1.Week
End Select
End Sub
Love mickey,
Đăng nhập để trả lời
0
PHƯƠNG THỨC


PHUONG THUC ACCEPT

Private Sub WinsockTCP_ConnectionRequest _
(requestID As Long)
If Winsock1.State <> sckClosed Then
Winsock1.Close
Winsock.Accept requestID
End Sub

PHUONG THUC ADD (COLLECTION)

Private Sub Command1_Click()
Dim MyClasses As New Collection
Dim Num As Integer
Dim Msg
Dim TheName
Do
Dim Inst As New Class1
Num = Num + 1
Msg = "Please enter a name:" & Chr(13) _
& "Press Cancel to see names in collection."
TheName = _
InputBox(Msg, "Name the Collection Items")
Inst.instancename = TheName
If Inst.instancename <> "" Then
MyClasses.Add Item:=Inst, Key:=CStr(Num)
End If
Set Inst = Nothing
Loop Until TheName = ""
For Each X In MyClasses
MsgBox X.instancename, , "Instance Name"
Next
End Sub

PHUONG THUC ADD (LISTITEMS)

Private Sub Form_Load()
Dim clmX As ColumnHeader
Dim itmX As ListItem
Dim i As Integer

For i = 1 To 3
Set clmX = ListView1.ColumnHeaders.Add()
clmX.Text = "Col" & i
Next i

For i = 1 To 10
Set itmX = ListView1.ListItems.Add()
itmX.SmallIcon = 1
itmX.Text = "ListItem " & i
itmX.SubItems(1) = "Subitem 1"
itmX.SubItems(2) = "Subitem 2"
Next i
End Sub

PHUONG THUC ADD (NODES)

Private Sub Form_Load()
TreeView1.LineStyle = tvwRootLines
Dim nodX As Node
Set nodX = TreeView1.Nodes.Add(, , "r", "Root")

Set nodX = TreeView1.Nodes.Add("r", _
tvwChild, "child1", "Child")
End Sub

PHUONG THUC ADDITEM

Private Sub Form_Click()
Dim Entry, I, Msg
Msg = "Choose OK to add 100 items to your list box."
MsgBox Msg
For I = 1 To 100
Entry = "Entry " & I
List1.AddItem Entry
Next I
Msg = "Choose OK to remove every other entry."
MsgBox Msg
For I = 1 To 50
List1.RemoveItem I
Next I
Msg = "Choose OK to remove all items from the list box."
MsgBox Msg
List1.Clear
End Sub

PHUONG THUC ARRANGE

Const FORMCOUNT = 5
Dim F(1 To FORMCOUNT) As New Form1
Private Sub MDIForm_Load()
Dim I
Load Form1
For I = 1 To FORMCOUNT
F(I).Caption = "Form" & I + 1
Next I
End Sub

Private Sub Picture1_Click()
Static ClickCount
Dim I, PrevWidth, Start
ClickCount = ClickCount + 1
Select Case ClickCount
Case 1
MDIForm1.Arrange 1
Case 2
MDIForm1.Arrange 2
Case 3
PrevWidth = MDIForm1.Width
MDIForm1.Width = PrevWidth / 2
Form1.WindowState = 1
For I = 1 To FORMCOUNT
F(I).WindowState = 1
Next I
Start = Timer
Do
Loop Until Timer = Start + 5
MDIForm1.Width = PrevWidth
MDIForm1.Arrange 3
End Select
End Sub

PHUONG THUC CANCEL

Private Sub btnGetDir_Click()
With Inet1
.URL = "ftp://ftp.learn.huukhang.com/"
.UserName = "John Smith"
.Password = "mAuI&9$6"
If .UserName <> "khang" Then
.Cancel
Else
.Execute , "DIR"
End If
End With
End Sub

PHUONG THUC CELLTEXT

Sub DataGrid1_Scroll(Cancel As Integer)
Dim TopRow, BottomRow
TopRow = DataGrid1.Columns(1). _
CellText(DataGrid1.FirstRow)
BottomRow = DataGrid1.Columns(1). _
CellText(DataGrid1.RowBookmark _
(DataGrid1.VisibleRows - 1))
Label1.Caption = "Records " & TopRow & " to " & _
BottomRow & " are currently displayed."
End Sub

PHUONG THUC CELLVALUE

Sub Command1_Click()
Dim I
ReDim CalcArray(0 To DataGrid1.SelBookmarks.Count - 1)
For I = 0 To DataGrid1.SelBookmarks.Count - 1
CalcArray(I) = _
DataGrid1.Columns(1). _
CellValue(DataGrid1.SelBookmarks(I))
Next I
End Sub

PHUONG THUC CIRCLE

Private Sub Command1_Click()
Dim CX, CY, Radius, Limit
ScaleMode = 3
CX = ScaleWidth / 2
CY = ScaleHeight / 2
If CX > CY Then Limit = CY Else Limit = CX
For Radius = 0 To Limit
Circle (CX, CY), Radius, RGB(Rnd * 255, _
Rnd * 255, Rnd * 255)
Next Radius
End Sub

PHUONG THUC CLEAR

Private Sub Command1_Click()
On Error GoTo errm
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
myStr = "Provider=Microsoft.Jet." & _
"OLEDB.4.0;Data Source=C:\Program " & _
" Files\Microsoft Office" & _
"\Office\Samples\Northwind.mdb"
myStr = "driver={SQL Server};server=dinh;" & _
" Database=Northwind;UID=sa;PWD="

myCon.Open myStr
myRst.CursorType = adOpenDynamic
myRst.LockType = adLockOptimistic
myRst.Open myStr, myCon
If myRst.RecordCount > 0 Then
myRst.Edit
myRst("CompanyName") = txtName
myRst("ContactTitle") = txtDesc
myRst.Update
End If
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
errm:
Beep
MsgBox Error
err.Clear
End Sub

PHUONG THUC CLOSE

Private Sub Command1_Click()
On Error GoTo errm
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
myStr = "Provider=Microsoft.Jet." & _
"OLEDB.4.0;Data Source=C:\Program " & _
" Files\Microsoft Office" & _
"\Office\Samples\Northwind.mdb"
myStr = "driver={SQL Server};server=dinh;" & _
" Database=Northwind;UID=sa;PWD="

myCon.Open myStr
myRst.CursorType = adOpenDynamic
myRst.LockType = adLockOptimistic
myRst.Open myStr, myCon
If myRst.RecordCount > 0 Then
myRst.Edit
myRst("CompanyName") = txtName
myRst("ContactTitle") = txtDesc
myRst.Update
End If
myRst.Close
myCon.Close
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
errm:
Beep
MsgBox Error
End Sub

PHUONG THUC CLOSE

Private Sub cmdDis_Click()
tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()

tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
tcpServer.GetData strData
txtOutput.Text = strData
End Sub

PHUONG THUC CLS

Private Sub Command1_Click()
Dim Msg
AutoRedraw = -1
ForeColor = QBColor(15)
BackColor = QBColor(1)
FillStyle = 7
Line (0, 0)-(ScaleWidth, ScaleHeight), , B
Msg = "This is information printed on the form background."
CurrentX = ScaleWidth / 2 - TextWidth(Msg) / 2

CurrentY = 2 * TextHeight(Msg)
Print Msg
Msg = "OK to clear the info and background "
Msg = Msg & "pattern just displayed on the form."
MsgBox Msg
Cls
End Sub

PHUONG THUC COLLAPSEALL

Private Sub ExpandOrCollapse(flx As MSHFlexGrid)
Static IsExpanded As Boolean
If IsExpanded Then
flx.CollapseAll
IsExpanded = False
Else
flx.ExpandAll
IsExpanded = True
End If
End Sub

Private Sub Form_Load()
ExpandOrCollapse MSHFlexGrid1
End Sub

Private Sub cmdExpandOrCollapse()
ExpandOrCollapse MSHFlexGrid1
End Sub

PHUONG THUC COPYFILE

Sub Command1_Click()
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
fs.CopyFile Text1, "D:\" & Text1

End Sub

PHUONG THUC COPYFOLDER

Sub Command1_Click()
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
fs.CopyFolder Text1, "D:\" & Text1

End Sub

PHUONG THUC CREATFOLDER

Sub Command1_Click()
Dim fs, f, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
fs.CreateFolder("D:\" & Text1)

End Sub

PHUONG THUC CREATETEXTFILE

Private Sub Command1_Click()
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set a = _
fs.CreateTextFile("c:\testfile.txt", True)
a.WriteLine ("This is a test.")
a.Close
End Sub

PHUONG THUC DELETE

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\ekhang")
Set fc = f.Files
For Each f1 In fc
f1.Delete
Next
End Sub

PHUONG THUC DELETEFILE

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
If fs.fileExists("D:\test.txt") = True Then
fs.deletefile ("D:\test.txt")
End If
End Sub

PHUONG THUC DELETEFOLDER

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
If fs.folderExists("D:\testing") = True Then
fs.deletefolder ("D:\testing")
End If
End Sub
PHUONG THUC DRIVEEXISTS

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
If fs.driveExists("F:\") = True Then
fs.deletefolder ("F:\testing")
End If
End Sub

PHUONG THUC EXECUTE

Private Sub btnGetHTMLDoc_Click()
With Inet1
.URL = "http://www.huukhang.com/"
.Document = " popupsubcribe.htm "
.Execute , "GET"
End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
Dim strHTML As String
Dim vtData As String
Select Case state
Case icResponseCompleted
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
strHTML = strHTML & vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
txtHTML.Text = strHTML
End Select
End Sub

PHUONG THUC EXISTS

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.Dictionary")
If fs.Exists("F:\") = True Then
fs.deletefolder ("F:\testing")
End If
End Sub

PHUONG THUC EXPANDALL

Private Sub ExpandOrCollapse(flx As MSHFlexGrid)
Static IsExpanded As Boolean
If IsExpanded Then
flx.CollapseAll
IsExpanded = False
Else
flx.ExpandAll
IsExpanded = True
End If
End Sub

Private Sub Form_Load()
ExpandOrCollapse MSHFlexGrid1
End Sub

Private Sub cmdExpandOrCollapse()
ExpandOrCollapse MSHFlexGrid1
End Sub

PHUONG THUC EXPORTREPORT

Private Sub ExportDailyReport()
DataReport1.Title = "Daily Report"
Dim strTemplate As String
strTemplate = _
"" & vbCrLf & _
"" & vbCrLf & _
"" & vbCrLf & _
"" & vbCrLf & _
rptTagBody & vbCrLf & _
"" & vbCrLf & _
""

DataReport1.ExportFormats.Add _
Key:="DailyReport", _
FormatType:=rptFmtHTML, _
FileFormatString:="Daily Report (*.htm)", _
FileFilter:="*.HTM", _
Template:=strTemplate

DataReport1.ExportReport _
FormatIndexOrKey:="DailyReport", _
FileName:="C:\Temp\DailyRpt", _
Overwrite:=True, _
ShowDialog:=False, _
Range:=rptRangeFromTo, _
Pagefrom:=1, _
Pageto:=10
End Sub

PHUONG THUC FILEEXISTS

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
If fs.fileExists("D:\test.txt") = True Then
fs.deletefile ("D:\test.txt")
End If
End Sub

PHUONG THUC FILES

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
If fs.folderExists("D:\testing") = True Then
fs.deletefolder ("D:\testing")
End If
End Sub

PHUONG THUC GETABSOLUTEPATHNAME

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Debug.Print _
fs.GetAbsolutePathName("inetpub")
‘D:\Program Files\Microsoft Visual Studio\VB98\inetpub
End Sub

PHUONG THUC GETBASENAME

Private Sub Command1_Click()
Dim fs, f, f1, fc, s
Set fs = _
CreateObject("Scripting.FileSystemObject")
Debug.Print _
fs.GetBaseName("wwwroot\test.php")
‘ keát quaû traû veà laø: test
End Sub

PHUONG THUC GETCHUNK

Private Sub btnGetHTMLDoc_Click()
With Inet1
.URL = "http://www.huukhang.com/"
.Document = " popupsubcribe.htm "
.Execute , "GET"
End With
End Sub

Private Sub Inet1_StateChanged(ByVal state As Integer)
Dim strHTML As String
Dim vtData As String
Select Case state
Case icResponseCompleted
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
strHTML = strHTML & vtData
vtData = Inet1.GetChunk(1024, icString)
Loop
txtHTML.Text = strHTML
End Select
End Sub

PHUONG THUC GETDATA

Private Sub cmdDis_Click()
tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()

tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
tcpServer.GetData strData
txtOutput.Text = strData
End Sub

PHUONG THUC GETDRIVE

Private Sub Command1_Click()
Dim fso, d, s
Set fso = _
CreateObject("Scripting.FileSystemObject")
Set d = _
fso.GetDrive(fso.GetDriveName("C:\inetpub"))
s = "Drive " & UCase(drvPath) & " - "
s = s & d.VolumeName & "
"
s = s & "Free Space: " & _
FormatNumber(d.FreeSpace / 1024, 0)
s = s & " Kbytes"
Debug.Print s
End Sub

PHUONG THUC GETDRIVENAME

Private Sub Command1_Click()
Dim fso, d, s
Set fso = _
CreateObject("Scripting.FileSystemObject")
Set d = _
fso.GetDrive(fso.GetDriveName("C:\inetpub"))
s = "Drive " & UCase(drvPath) & " - "
s = s & d.VolumeName & "
"
s = s & "Free Space: " & _
FormatNumber(d.FreeSpace / 1024, 0)
s = s & " Kbytes"
Debug.Print s
End Sub

PHUONG THUC GETEXTENSIONNAME

Private Sub Command1_Click()
Dim fso, d, s
Set fso = _
CreateObject("Scripting.FileSystemObject")
s = fso.Getextensionname("C:\text.txt")
Debug.Print s
End Sub

PHUONG THUC GETFILE

Private Sub Command1_Click()
Dim fso, f, s
Set fso = _
CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("C:\test.txt")
s = f.Path & "
"
s = s & "Created: " & f.DateCreated & "
"
s = s & "Last Accessed: " & _
f.DateLastAccessed & "
"
s = s & "Last Modified: " & f.DateLastModified
Debug.Print s
End Sub

PHUONG THUC GETFILENAME

Private Sub Command1_Click()
Dim fso, f, s
Set fso = _
CreateObject("Scripting.FileSystemObject")
s = fso.GetFilename("C:\test.txt")
Debug.Print s
End Sub

PHUONG THUC GETFOLDER

Private Sub Command1_Click()
Dim fso, f, s
Set fso = _
CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("C:\inetpub\wwwroot")
s = f.Path & "
"
s = s & "Created: " & f.DateCreated & "
"
s = s & "Last Accessed: " & _
f.DateLastAccessed & "
"
s = s & "Last Modified: " & f.DateLastModified
Debug.Print s
End Sub

PHUONG THUC GETPARENTFOLDERNAME

Private Sub Command1_Click()
Dim fso, f, s
Set fso = _
CreateObject("Scripting.FileSystemObject")
s = _
fso.GetParentFolderName( _
"C:\inetpub\default.htm")
Debug.Print s
s = fso.GetParentFolderName("C:\inetpub\")
Debug.Print s
End Sub

PHUONG THUC HIDE

Private Sub btnClose_Click()
Form1.Hide
End Sub

PHUONG THUC ITEMS

Private Sub Command1_Click()
Dim a, d, i
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
a = d.Items
For i = 0 To d.Count - 1
Debug.Print a(i)
Next
End Sub

PHUONG THUC KEYS

Private Sub Command1_Click()
Dim a, d, i
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
a = d.keys
For i = 0 To d.Count - 1
Debug.Print a(i)
Next
End Sub

PHUONG THUC MOVE

Private Sub Form_Click()
Dim Inch, Msg
Msg = "Choose OK to resize and move this form by "
Msg = Msg & "changing the value of properties."
MsgBox Msg
Inch = 1440
Width = 4 * Inch
Height = 2 * Inch
Left = 0
Top = 0
Msg = "Now choose OK to resize & move this form "
Msg = Msg & "using the Move method."
MsgBox Msg
Move Screen.Width - 2 * Inch, _
Screen.Height - Inch, 2 * Inch, Inch
End Sub

PHUONG THUC MOVEFILE

Private Sub Command1_Click()
Dim fso
Set fso = _
CreateObject("Scripting.FileSystemObject")
fso.MoveFile "C:\test.txt", _
"c:\windows\desktop\"
End Sub

PHUONG THUC MOVEFOLDER

Private Sub Command1_Click()
Dim fso
Set fso = _
CreateObject("Scripting.FileSystemObject")
fso.MoveFolder "C:\test\ ", _
"c:\windows\desktop\"
End Sub

PHUONG THUC OPEN

Private Sub Animation1_Click()
With CommonDialog1
.Filter = "avi (*.avi)|*.avi"
.ShowOpen
End With
With Animation1
.AutoPlay = True
.Open CommonDialog1.FileName
End With
End Sub

PHUONG THUC OPENTEXTFILE

Const ForReading = 1, ForWriting = 2
Const ForAppending = 3
Private Sub Command1_Click()
Dim fs, f
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\testfile.txt", _
ForAppending, TristateFalse)
f.Write "Hello world!"
f.Close
End Sub

PHUONG THUC OPENURL

Private Sub Command1_Click()
Dim b() As Byte
Dim strURL As String
strURL = "FTP://ftp.GreatSite.com/China.exe"
b() = Inet1.OpenURL(strURL, icByteArray)

Open "C:\Temp\China.exe" For Binary Access _
Write As #1
Put #1, , b()
Close #1
End Sub

PHUONG THUC POPUPMENU

Private Sub Form_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu mnFile
End If
End Sub

PHUONG THUC PRINTREPORT

Private Sub DisplayPrintDialog()
DataReport1.PrintReport True
End Sub

Private Sub PrintWithoutDialog()
DataReport1.PrintReport False, _
rptRangeAllPages
End Sub

PHUONG THUC READALL

Private Sub Command1_Click()
Dim fs, f
Dim s As String
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\testfile.txt", 1, TristateFalse)
s = f.Readall
Debug.Print s
f.Close
End Sub

PHUONG THUC READLINE

Private Sub Command1_Click()
Dim fs, f
Dim s As String
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\testfile.txt", 1, TristateFalse)
s = f.ReadLine
Debug.Print s
f.Close
End Sub

PHUONG THUC REFRESH

Private Sub Form_Load()
Me.Refresh
End Sub

PHUONG THUC REMOVEALL

Private Sub Command1_Click()
Dim a, d, i
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
a = d.keys
For i = 0 To d.Count - 1
Debug.Print a(i)
Next
d.RemoveAll
End Sub

PHUONG THUC REMOVEITEM

Private Sub Form_Click()
Dim Entry, I, Msg
Msg = "Choose OK to add 100 items to your list box."
MsgBox Msg
For I = 1 To 100
Entry = "Entry " & I
List1.AddItem Entry
Next I
Msg = "Choose OK to remove every other entry."
MsgBox Msg
For I = 1 To 50
List1.RemoveItem I
Next I
Msg = "Choose OK to remove all items from the list box."
MsgBox Msg
List1.Clear
End Sub

PHUONG THUC SAVEFILE

Private Sub Command1_Click()
CommonDialog1.ShowSave
RichTextBox1.SaveFile _
CommonDialog1.FileName, rtfRTF
End Sub

PHUONG THUC SCROLL

Sub ScrollDownRight_Click()
DataGrid1.Scroll DataGrid1.VisibleCols, _
DataGrid1.VisibleRows
End Sub

Sub ScrollUpLeft_Click()
DataGrid1.Scroll -DataGrid1.VisibleCols, _
-DataGrid1.VisibleRows
End Sub

PHUONG THUC SENDDATA

Private Sub cmdDis_Click()
tcpServer.Close
End Sub

Private Sub Form_Load()
tcpServer.LocalPort = 1001
tcpServer.Listen
MsgBox tcpServer.LocalHostName
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
If tcpServer.State <> sckClosed Then _
tcpServer.Close
tcpServer.Accept requestID
End Sub

Private Sub txtSendData_Change()

tcpServer.SendData txtSendData.Text
End Sub

Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
tcpServer.GetData strData
txtOutput.Text = strData
End Sub

PHUONG THUC SETFOCUS

Private Sub Form_Load()
Me.ttNo.SetFocus
End Sub

PHUONG THUC SHOW

Private Sub Form_Load()
frmLogin.Show 1
End Sub

PHUONG THUC SHOWCOLOR

Private Sub cmdShow_Click()
Me. CommonDialog1.ShowColor
End Sub

PHUONG THUC SHOWFONT

Private Sub cmdShow_Click()
Me. CommonDialog1.ShowFont
End Sub

PHUONG THUC SHOWHELP

Private Sub cmdShow_Click()
Me. CommonDialog1.ShowHelp
End Sub

PHUONG THUC SHOWOPEN

Private Sub cmdShow_Click()
Me. CommonDialog1.ShowOpen
End Sub

PHUONG THUC SHOWPRINTER

Private Sub cmdShow_Click()
Me. CommonDialog1.ShowPrinter
End Sub

PHUONG THUC SHOWSAVE

Private Sub cmdShow_Click()
Me. CommonDialog1.ShowSave
End Sub

PHUONG THUC SKIPLINE

Private Sub Command1_Click()
Dim fs, f
Dim s As String
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\testfile.txt", 1, TristateFalse)
s = f.ReadLine
if InStr(s,”:”) >0 then
f.skipline
end if
Debug.Print s
f.Close
End Sub

PHUONG THUC STOP

Private Sub Animation1_Click()
With CommonDialog1
.Filter = "avi (*.avi)|*.avi"
.ShowOpen
End With
With Animation1
.AutoPlay = True
.Open CommonDialog1.FileName
.Stop
End With
End Sub

PHUONG THUC UPDATE

Private Sub Command1_Click()
On Error GoTo errm
Dim myCon As New ADODB.Connection
Dim myRst As New ADODB.Recordset
Dim myStr As String
myStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
" Data Source=C:\Program Files\Microsoft Office" & _
"\Office\Samples\Northwind.mdb"
myStr = "driver={SQL Server};server=dinh;" & _
" Database=Northwind;UID=sa;PWD="

myCon.Open myStr
myRst.CursorType = adOpenDynamic
myRst.LockType = adLockOptimistic
myRst.Open myStr, myCon
If myRst.RecordCount > 0 Then
myRst.Edit
myRst("CompanyName") = txtName
myRst("ContactTitle") = txtDesc
myRst.Update
End If
Set myRst = Nothing
Set myCon = Nothing
Exit Sub
errm:
Beep
MsgBox Error
Err.Clear
End Sub

PHUONG THUC WRITE

Private Sub Command1_Click()
Dim fs, f
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\testfile.txt", _
1, TristateFalse)
f.Write "Hello world!"
f.Close
End Sub

PHUONG THUC WRITELINE

Private Sub Command1_Click()
Dim fs, f
Set fs = _
CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\testfile.txt", _
1, TristateFalse)
f.WriteLine "Hello world!"
f.Close
End Sub
Love mickey,
Đăng nhập để trả lời
0
Rất hay ! MK có thể nói công dụng của từng cái được không ? có vài cái thì biết, còn nhiều cái thì mù tịt.
Đăng nhập để trả lời
0

Trích đoạn: Cát trắng

Rất hay ! MK có thể nói công dụng của từng cái được không ? có vài cái thì biết, còn nhiều cái thì mù tịt.


mic chỉ mới chập chửng tìm hiểu VB nên có mua sách về học và share với mọi người, nếu nói công dụng của từng cái thì đến gần 700 trang giấy chứ chẳng chơi, nếu CT muốn tìm hiểu cái nào thì cứ nói, chúng ta sẽ cùng tìm hiểu nhé [;)]
Love mickey,
Đăng nhập để trả lời
0
Thank you ! nhiều nha.
Mình thực sự đã gặp nhiều rắc rối với "nó" . nhung giờ đây mình tin răng điều đó sẽ không còn tiếp tục đươc nữa.....
Mình có một thắc mắc nhỏ này mong bạn sẽ chỉ cho tôi :" Mình đã tạo CSDL ở bên Access rồi nhung lại không biết cách để liên kết vơi VB.."
Thank !
Đăng nhập để trả lời
0
CSDL là cái gì vậy timnhac? [:)]
Đăng nhập để trả lời
0

Trích đoạn: KeDangGhet

CSDL là cái gì vậy timnhac? [:)]


CSDL = cơ sở dữ liệu [:D]
Love mickey,
Đăng nhập để trả lời
0
Trùi, tưởng đâu là CSDL = chuyện sấp down load chớ ! [:D]

Vậy timnhac muốn "liên kết" CSDL với VB ra sao? Muốn từ 1 VB project chạy qua đọc Access database hay là muốn dùng VBA bên Access luôn? [:)]
Đăng nhập để trả lời
0