Export và Import ra t­p tin text të Access (VB)

HiÇn nay các b¡n yêu thích l­p trình sí dång Access là nguÓn chéa dï liÇu khá phÕ bi¿n vì ¡n gi£n, dÅ qu£n trË và áp éng °ãc yêu c§u công viÇc. Hôm nay chúng tôi xin giÛi thiÇu mÙt o¡n code à export và import ra t­p tin text të Access (VB)

Export Text (Flat file) të Access Ms-Access

Option Explicit

Public Sub Export_Table_2_TextFile()

On Error GoTo LocalErrorHandler

Dim dbCompany As Database

Dim rsGeneral As Recordset

Dim ExpGeneral As PubExpGeneral

Dim blnTab_Text As Boolean

Dim FullName As String

Dim FileHandle As Byte

Dim strFileToExport As String

Dim chkFileExist As String

'Give Path with File name

FullName = Export và Import ra t­p tin text të Access (VB)

HiÇn nay các b¡n yêu thích l­p trình sí dång Access là nguÓn chéa dï liÇu khá phÕ bi¿n vì ¡n gi£n, dÅ qu£n trË và áp éng °ãc yêu c§u công viÇc. Hôm nay chúng tôi xin giÛi thiÇu mÙt o¡n code à export và import ra t­p tin text të Access (VB)

Export Text (Flat file) të Access Ms-Access

Option Explicit

Public Sub Export_Table_2_TextFile()

On Error GoTo LocalErrorHandler

Dim dbCompany As Database

Dim rsGeneral As Recordset

Dim ExpGeneral As PubExpGeneral

Dim blnTab_Text As Boolean

Dim FullName As String

Dim FileHandle As Byte

Dim strFileToExport As String

Dim chkFileExist As String

'Give Path with File name

FullName = HYPERLINK "file:///E:\\General" E:\General ' Thu muc chua du lieu, ban co the thay doi theo nhu cau cça minh

blnTab_Text = False

Set dbCompany = OpenDatabase(FullName)

'Ví då tên bang la Company

Set rsGeneral = dbCompany.OpenRecordset(Company, dbOpenTable)

With ExpGeneral

.EmpNumber = No.

.EmpName = Name

.EmpAddress = Address

.EmpCity = City

Sí dång TAB hoc d¥u ph©y

If blnTab_Text Then

.Delimiter1 = Chr(9)

.Delimiter2 = Chr(9)

.Delimiter3 = Chr(9)

Else

.Delimiter1 = Chr(44)

.Delimiter2 = Chr(44)

.Delimiter3 = Chr(44)

End If

.CRLF = vbCrLf

End With

FileHandle = FreeFile

'Tên t­p tin

strFileToExport = C:\Exported.txt

chkFileExist = Dir(strFileToExport)

If chkFileExist Then

Kill strFileToExport

End If

Open strFileToExport For Random As FileHandle Len = Len(ExpGeneral)

Put FileHandle, , ExpGeneral

Do Until rsGeneral.EOF

With ExpGeneral

.EmpNumber = rsGeneral(EmpNo)

.EmpName = rsGeneral(EmpName)

.EmpAddress = rsGeneral(EmpAddress)

.EmpCity = rsGeneral(EmpCity)

End With

Put FileHandle, , ExpGeneral

rsGeneral.MoveNext

Loop

rsGeneral.Close

Set rsGeneral = Nothing

Close FileHandle

Exit Sub

LocalErrorHandler:

MsgBox Error Occured : & Err.Description, , Error

End Sub

'Import Text vào Ms-Access

Public Sub Import_TextFile_2_Table()

On Error GoTo LocalErrorHandler

Dim dbCompany As Database

Dim rsGeneral As Recordset

Dim FullName As String

Dim FileHandle As Byte

Dim ImportRecord As String

Dim flnName As String

Dim RowPosition As Double

Dim EmpNumber As String

Dim EmpName As String

Dim EmpAddress As String

Dim EmpCity As String

Dim Delimiter As String

flnName = C:\Exported.txt

Delimiter = ,

FileHandle = FreeFile

Open flnName For Input As FileHandle

Line Input #FileHandle, ImportRecord

FullName = HYPERLINK "file:///C:\\General" C:\General

Set dbCompany = OpenDatabase(FullName)

Set rsGeneral = dbCompany.OpenRecordset(Company, dbOpenDynaset)

Do Until EOF(FileHandle)

Line Input #FileHandle, ImportRecord

RowPosition = RowPosition + 1

EmpNumber = Trim(Mid(ImportRecord, 1, InStr(1, ImportRecord, Delimiter, 1) - 1))

EmpName = Trim(Mid(ImportRecord, 7, 10))

EmpAddress = Trim(Mid(ImportRecord, 18, 30))

EmpCity = Trim(Mid(ImportRecord, 49))

rsGeneral.AddNew

rsGeneral(EmpNo) = EmpNumber

rsGeneral(EmpName) = EmpName

rsGeneral(EmpAddress) = EmpAddress

rsGeneral(EmpCity) = EmpCity

rsGeneral.Update

Loop

Close FileHandle

rsGeneral.Close

Set rsGeneral = Nothing

dbCompany.Close

Set dbCompany = Nothing

Exit Sub

LocalErrorHandler:

MsgBox Error Occured : & Err.Description, , Error

End Sub

Kù thu­t Subclass Listbox trong Visualbasic

Bài vi¿t này s½ giúp b¡n hiÃu kù thu­t subclassing trong VisualBasic. B¡n có thà áp dång cho các Ñi t°ãng khác khi l­p trình trong VB

Windows gíi thông iÇp là mÙt h±ng sÑ tÛi các form và các control cça VB à báo cho chúng bi¿t vË trí chuÙt ß âu, khi nào thì c§n v½ l¡i, phím nào ang °ãc nh¥n và nhiÁu thông iÇp khác. Kù thu­t subclassing là à xí lý ch·n nhïng thông iÇp này tr°Ûc khi chúng ¿n °ãc các form và control. B±ng cách ch·n các thông iÇp này và xí lý ''vài thé'' tr°Ûc khi chúng ¿n ích, chúng ta có thà có các tính nng riêng (nh° tñ v½ l¡i các control theo ý riêng).

Subclassing là mÙt kù thu­t tinh vi, chÉ c§n mÙt l×i nhÏ (ví då nh° : do b¡n gi£i phóng tài nguyên không tÑt d«n ¿n viÇc th¥t thoát tài nguyên cça hÇ thÑng) là có thà d«n ¿n viÇc hÇ thÑng cça b¡n bË thi¿u tài nguyên làm cho hÇ thÑng ho¡t Ùng không còn tÑt nïa (ch­m i), n·ng h¡n là VB bË shut down, th­m chí treo máy. Tuy nhiên nói iÁu này là à b¡n ý théc °ãc v¥n Á ché b¡n cing không nên quá lo ng¡i vÁ nó. Và thêm 1 chú ý là b¡n cing không nên b¥m nút stop cça VB khi ch°¡ng trình ang ch¡y mà b¡n nên óng form 1 cách thông th°Ýng (b¥m nút close) à thñc hiÇn tÑt viÇc gi£i phóng tài nguyên.

Subclassing the Main Window:

Chúng ta b¯t âu thñc hiÇn kù thu­t subclassing b±ng cách b¡n mß 1 project mÛi và thêm 1 module vào project (project/add module/open). Bây giÝ b¡n ã có Form1 và Module1 trong project.

B¡n mß Module1 ra và copy, paste o¡n code sau vào :

Public Const GWL_WNDPROC = (-4)

Public oldWindowProc as Long

Public Declare Function SetWindowLong Lib ''user32'' Alias ''SetWindowLongA'' ( _

ByVal hwnd As Long, _

ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

ây là mÙt hàm API cça Windows cho phép b¡n thay Õi thuÙc tính cça 1 cía sÕ (hay control - të bây giÝ chúng ta coi nh° control cing là mÙt window), trong tr°Ýng hãp cça chúng ta là thay Õi hàm WinProc (hàm Winproc là hàm mà các window dùng à xí lý các thông iÇp do hÇ thÑng (hÇ iÁu hành Windows) gíi ¿n).

hwnd - tham sÑ này có kiÃu là long integer dùng à xác Ënh 1 cía sÕ (form) hay 1 control (b¡n có thà coi nó nh° b£ng sÑ xe dùng ê xác Ënh tính duy nh¥t cça 1 xe v­y).

nIndex - tham sÑ này cing có kiÃu là long integer dùng à xác Ënh ''c§n thay Õi cái gì'' trong hàm SetWindowLong nói trên (b¡n có thà tham kh£o trong bÙ MSDN), trong tr°Ýng hãp cça chúng ta nIndex có giá trË là GWL_WNDPROC (vì chúng ta c§n xí lý hàm WinProc mà).

dwNewLong - hàm này có kiÃu long integer dùng à chÉ ra Ëa chÉ cça thç tåc mÛi mà chúng ta c§n xí lý.

Hàm WinProc mÛi ph£i có các tham sÑ giÑng hÇt các tham sÑ cça hàm WinProc bË thay th¿. B¡n cing ph£i chú ý là b¡n ph£i gíi tr£ các thông iÇp mà b¡n không xí lý cho hàm WinProc m·c Ënh xí lý. B¡n ti¿p tåc copy và dán o¡n mã sau vào Module1 :

Private Declare Function CallWindowProc Lib ''user32'' Alias ''CallWindowProcA'' ( _

ByVal lpPrevWndFunc As Long, _

ByVal hwnd As Long, _

ByVal Msg As Long, _

ByVal wParam As Long, _

ByVal lParam As Long) As Long

Public Function NewWindowProc( _

ByVal hWnd As Long, _

ByVal uMsg As Long, _

ByVal wParam As Long, _

ByVal lParam As Long) As Long

Debug.Print ''&H'' & Hex(uMsg), wParam, lParam

NewWindowProc = CallWindowProc(oldWindowProc, hWnd, uMsg, wParam, lParam)

End Function

CallWindowProc dùng à gÍi hàm WinProc m·c Ënh ra xí lý, hàm NewWindowProc là hàm thay th¿ cho hàm WinProc. Hàm NewWindowProc không làm b¥t cé viÇc gì ngo¡i trë viÇc in ra cía sÕ Debug xem thông iÇp gì °ãc gíi ¿n cho cía sÕ này (cía sÕ bË subclassing). Hàm NewWindowProc sau ó gÍi hàm WinProc m·c Ënh à xí lý thông iÇp 1 cách bình th°Ýng (bi¿n oldWindowProc dùng à l°u Ëa chÉ hàm WinProc m·c Ënh).Tham sÑ mà hÇ thÑng gíi cho hàm NewWindowProc là : hWnd - handle cça cía sÕ s½ nh­n thông iÇp; uMsg - thông iÇp °ãc gíi; và 2 tham sÑ còn l¡i (wParam và lParam) mang thông tin cça thông iÇp, phå thuÙc vào thông iÇp °ãc gíi.

Bây giÝ b¡n có thà ch¡y project °ãc, nh°ng ch°a có chuyÇn gì x£y ra c£, cía sÕ (form) cça b¡n ch°a bË subclass. MÙt l§n nïa xin nh¯c l¡i là b¡n không nên b¥m vào nút stop à dëng ch°¡ng trình và b¡n cing nên l°u project l¡i tr°Ûc khi ch¡y.

à thñc hiÇn subclass cía sÕ (form) cça b¡n, b¡n double vào form và copy, paste o¡n code sau vào :

Private Sub Form_Load()

'Subclass the window

oldWindowProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf NewWindowProc)

End Sub

Private Sub Form_Unload(Cancel As Integer)

'Unsubclass (return the original window process)

SetWindowLong Me.hWnd, GWL_WNDPROC, oldWindowProc

End Sub

Bây giÝ thì ok, form cça b¡n ã bË subclass ! B¡n thí ch¡y project và xem iÁu gì x£y ra ? Cía sÕ Debug cça b¡n s½ tràn ng­p nhïng thông tin vÁ thông iÇp mà hÇ thÑng ã gíi cho form cça b¡n, b¡n thí di chuyÃn chuÙt, thay Õi kích th°Ûc form ... mà xem. (Hàm AddressOf dùng à l¥y Ëa chÉ cça 1 hàm).

How to put a background image into a Listbox:

B°Ûc 1 : Kéo 1 ListBox và 1 Image control vào Form1.

B°Ûc 2 : Thêm 1 sÑ måc (item) vào Listbox (Måc list trong ListBox control).

B°Ûc 3 : Thêm 1 picture vào Image1 (picture này b¡n s½ dùng làm background cho ListBox).

B°Ûc 4 : Mß Module1 ra và dán o¡n code sau vào :

Public gBGBrush As Long

Public Declare Function CreatePatternBrush Lib ''gdi32'' ( _

ByVal hBitmap As Long) As Long

Public Declare Function DeleteObject Lib ''gdi32'' ( _

ByVal hObject As Long) As Long

Private Declare Function SetBkMode Lib ''gdi32'' ( _

ByVal hdc As Long, _

ByVal nBkMode As Long) As Long

Private Const WM_CTLCOLORLISTBOX = &H134

Các hàm dùng cho viÇc v½ nÁn cho ListBox, b¡n có thà xem thêm trong bÙ MSDN.

B°Ûc 5 : Thay o¡n code trong Form_Load và Form_Unload lúc nãy b±ng o¡n code mÛi nh° sau :

Private Sub Form_Load()

Image1.Visible = False

gBGBrush = CreatePatternBrush(Image1.Picture.Handle)

'Subclass the window

oldWindowProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf NewWindowProc)

End Sub

Private Sub Form_Unload(Cancel As Integer)

'Unsubclass (return the original window process)

SetWindowLong Me.hWnd, GWL_WNDPROC, oldWindowProc

DeleteObject gBGBrush

End Sub

B°Ûc 6 : Vi¿t l¡i hàm NewWindowProc trong Module 1 Ã làm viÇc mà chúng ta muÑn (l¡i copy và paste).

Public Function NewWindowProc( _

ByVal hWnd As Long, _

ByVal uMsg As Long, _

ByVal wParam As Long, _

ByVal lParam As Long) As Long

Debug.Print ''&H'' & Hex(uMsg), wParam, lParam

If uMsg = WM_CTLCOLORLISTBOX And gBGBrush 0 Then

'Make the words print transparently

SetBkMode wParam, 1

'allow the original process to set text color, etc. from the lbx properties.

CallWindowProc oldWindowProc, hwnd, uMsg, wParam, lParam

'Return our custom brush instead of the default one

NewWindowProc = gBGBrush

Else

NewWindowProc = CallWindowProc(oldWindowProc, hWnd, uMsg, wParam, lParam)

End If

End Function

B°Ûc 7 :Yeah ! B¡n l°u project l¡i và ch¡y thí xem.

Bây giÝ ListBox cça b¡n ã có background ph£i không ? T¡i sao ta làm °ãc nh° v­y ? Có vài iÃm c§n l°u ý nh° sau :

iÁu 1 : Chúng ta ch·n thông iÇp WM_CTLCOLORLISTBOX à xí lý. Thông iÇp này °ãc gíi cho parent window (cía sÕ cha m¹, cía sÕ c¥p cao h¡n chéa ListBox) cça ListBox tr°Ûc khi hÇ thÑng v½ list box. Lúc này wParam mang giá trË là handle DC (devie context) dùng à v½ list box, lParam mang giá trË là handle cça list box c§n v½. Và mÙt iÁu vô cùng quan trÍng là giá trË tr£ vÁ cça hàm WindowProc lúc này, giá trË này s½ °ãc hÇ thÑng dùng à v½ nÁn cho list box, do ó trong NewWindowProc chúng ta cho NewWindowProc ''chÉ'' ¿n handle cça gBGBrush (NewWindowProc = gBGBrush) và tr°Ûc ó chúng ta ã t¡o ra gBGBrush b±ng cách : gBGBrush = CreatePatternBrush(Image1.Picture.Handle). Và t¥t c£ các công viÇc khác v«n °ãc xí lý bình th°Ýng b±ng cách chúng ta gÍi hàm : CallWindowProc.

iÁu 2 : Chúng ta ph£i gi£i phóng tài nguyên hÇ thÑng b±ng cách, trong Form_Unload : DeleteObject gBGBrush. N¿u chúng ta không làm viÇc này s½ d«n ¿n hiÇn t°ãng memory leack - làm gi£m tài nguyên hÇ thÑng, gây h¡i cho hÇ thÑng.

Bài này chÉ demo viÇc subclass 1 list box, tuy nhiên b¡n có thà áp dång kù thu­t này à subclass mÍi control mà b¡n muÑn, chÉ ¡n gi£n thay Õi, các tham sÑ cho phù hãp nh° : hWnd - handle cça cí sÕ c§n subclass, xí lý trong hàm NewWindowProc cho phù hãp vÛi tëng control, tëng thông iÇp.

Ch¡y t­p tin MPEG trong VB6

Chúng ta s½ xây dñng mÙt Class à iÁu khiÃn các t­p tin Ënh d¡ng theo MPEG. B¡n có thà thao các tác vå c¡ b£n và các thuÙc tính cça t­p tin MPEG b±ng Class này.

Private Declare Function mciGetErrorString Lib ''winmm.dll'' Alias ''mciGetErrorStringA'' (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

Private Declare Function GetShortPathName Lib ''kernel32'' Alias ''GetShortPathNameA'' (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Declare Function mciSendString Lib ''winmm.dll'' Alias ''mciSendStringA'' (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Const m_def_FileName = ''''

Dim m_FileName As String

'MappingInfo=UserControl,UserControl,-1,Enabled

Public Property Get Enabled() As Boolean

Enabled = UserControl.Enabled

End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)

UserControl.Enabled() = New_Enabled

PropertyChanged ''Enabled''

End Property

'MemberInfo=13,0,0,

Public Property Get FileName() As String

FileName = m_FileName

End Property

Public Property Let FileName(ByVal New_FileName As String)

m_FileName = New_FileName

PropertyChanged ''FileName''

End Property

'Khßi Ùng các thuÙc tính cça Ñi t°ãng

Private Sub UserControl_InitProperties()

m_FileName = m_def_FileName

End Sub

'Íc thuÙc tínnh ã l°u giï

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

UserControl.Enabled = PropBag.ReadProperty(''Enabled'', True)

m_FileName = PropBag.ReadProperty(''FileName'', m_def_FileName)

End Sub

Private Sub UserControl_Terminate()

mmStop

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

Call PropBag.WriteProperty(''Enabled'', UserControl.Enabled, True)

Call PropBag.WriteProperty(''FileName'', m_FileName, m_def_FileName)

End Sub

Public Function IsPlaying() As Boolean

Static s As String * 30

mciSendString ''status MPEGPlay mode'', s, Len(s), 0

IsPlaying = (Mid$(s, 1, 7) = ''playing'')

End Function

Public Function mmPlay()

Dim cmdToDo As String * 255

Dim dwReturn As Long

Dim ret As String * 128

Dim tmp As String * 255

Dim lenShort As Long

Dim ShortPathAndFie As String

If Dir(FileName) = '''' Then

mmOpen = ''Error with input file''

Exit Function

End If

lenShort = GetShortPathName(FileName, tmp, 255)

ShortPathAndFie = Left$(tmp, lenShort)

glo_hWnd = hWnd

cmdToDo = ''open '' & ShortPathAndFie & '' type MPEGVideo Alias MPEGPlay Parent '' & UserControl.hWnd & '' Style 1073741824''

dwReturn = mciSendString(cmdToDo, 0&, 0&, 0&)

If dwReturn 0 Then 'not success

mciGetErrorString dwReturn, ret, 128

mmOpen = ret

MsgBox ret, vbCritical

Exit Function

End If

mmPlay = ''Success''

mciSendString ''play MPEGPlay'', 0, 0, 0

End Function

Public Function mmPause()

mciSendString ''pause MPEGPlay'', 0, 0, 0

End Function

Public Function mmStop() As String

mciSendString ''stop MPEGPlay'', 0, 0, 0

mciSendString ''close MPEGPlay'', 0, 0, 0

End Function

Public Function PositionInSec()

Static s As String * 30

mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0

mciSendString ''status MPEGPlay position'', s, Len(s), 0

PositionInSec = Round(Mid$(s, 1, Len(s)) / 1000)

End Function

Public Function Position()

Static s As String * 30

mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0

mciSendString ''status MPEGPlay position'', s, Len(s), 0

sec = Round(Mid$(s, 1, Len(s)) / 1000)

If sec

If sec > 59 Then

mins = Int(sec / 60)

sec = sec - (mins * 60)

Position = Format(mins, ''00'') & '':'' & Format(sec, ''00'')

End If

End Function

Public Function LengthInSec()

Static s As String * 30

mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0

mciSendString ''status MPEGPlay length'', s, Len(s), 0

LengthInSec = Round(Val(Mid$(s, 1, Len(s))) / 1000) 'Round(CInt(Mid$(s, 1, Len(s))) / 1000)

End Function

Public Function Length()

Static s As String * 30

mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0

mciSendString ''status MPEGPlay length'', s, Len(s), 0

sec = Round(Val(Mid$(s, 1, Len(s))) / 1000) 'Round(CInt(Mid$(s, 1, Len(s))) / 1000)

If sec

If sec > 59 Then

mins = Int(sec / 60)

sec = sec - (mins * 60)

Length = Format(mins, ''00'') & '':'' & Format(sec, ''00'')

End If

End Function

Public Function About()

frmCtlAbout.Show vbModal, Me

End Function

Public Function SeekTo(Second)

mciSendString ''set MPEGPlay time format milliseconds'', 0, 0, 0

If IsPlaying = True Then mciSendString ''play MPEGPlay from '' & Second, 0, 0, 0

If IsPlaying = False Then mciSendString ''seek MPEGPlay to '' & Second, 0, 0, 0

End Function

TruyÁn giá trË qua trang khác vÛi ph°¡ng théc Server.Tranfer (ASP.NET)

ASP.NET validation controls r¥t hïu dång à kiÃm tra giá trË ng°Ýi dùng nh­p vào khi posts back trên cùng mÙt trang. Nh°ng làm th¿ nào à sí dång trong các trang khác ?.

Ví då b¡n có mÙt trang, WebPostAwayA1.aspx vÛi 2 textbox control, b¡n sí dång 2 RequiredFieldValidator control. B¡n muÑn chuyÃn dï liÇu sang mÙt trang thé 2, WebPostAway2.aspx, chÉ khi các textbox ã °ãc nh­p giá trË

WebPostAwayA1.aspx:

First Name:

ErrorMessage=''First name is required.''

ControlToValidate=''txtFirstName''>

Last Name:

ErrorMessage=''Last name is required.''

ControlToValidate=''txtLastName''>

runat=''server'' Text=''Submit''>

WebPostAwayA1.aspx s½ chuyÃn ¿n WebPostAway2.aspx n¿u các giá trË °ãc nh­p vào 2 textbox:

void cmdPost_Click(Object src, EventArgs e ) {

if (Page.IsValid) {

Response.Redirect(''WebPostAway2.aspx'');

}

}

V¥n Á là dòng code trên s½ không truyÁn giá trË khi redirect sang trang WebPostAway2. Chúng ta sí dång Server.Transfer

void cmdPost_Click(Object src, EventArgs e ) {

if (Page.IsValid) {

Server.Transfer(''WebPostAway2.aspx'');

}

}

Trong ASP.NET, Server Tranfer m·c Ënh s½ không truyÁn form, query string collections të mÙt post back. M·c dù v­y b¡n có thà Ënh tham sÑ thé 2 cça ph°¡ng théc Tranfer thành True à các giá trË trên có thà °ãc truyÁn sanh mÙt trang mÛi.

void cmdPost_Click(Object src, EventArgs e ) {

if (Page.IsValid) {

Server.Transfer(''WebPostAway2.aspx'', true);

}

}

T¡o Font và Xoay Chï

NhiÁu Control trong VB cung c¥p cho b¡n thuÙc tính Font cho phép b¡n thay Õi tên Font, cá Font, in ­m, in nghiêng..v..v.. Hàm CreateFont cho phép b¡n làm °ãc nhiÁu h¡n th¿ nïa. Có có thà xoay chï theo mÙt góc b¥t kì à t¡o ra nhïng hiÇu éng thú vË.

VÛi 14 tham sÑ, có v» nh° CreateFont là mÙt hàm phéc t¡p nh°ng thñc sñ nó cing khá ¡n gi£n.

Private Declare Function CreateFont Lib ''gdi32'' Alias ''CreateFontA'' (

ByVal font_height As Long,

ByVal font_width As Long,

ByVal escapement As Long,

ByVal orientation As Long,

ByVal weight As Long,

ByVal italic As Long,

ByVal underscore As Long,

ByVal strikeout As Long,

ByVal character_set As Long,

ByVal output_precision As Long,

ByVal clipping_precision As Long,

ByVal quality As Long,

ByVal pitch_and_family As Long,

ByVal face_name As String) As Long B¡n có thà ·t nhiÁu trong sÑ các tham sÑ này b±ng 0 à sí dång các giá trË m·c Ënh cça Windows. B¡n chÉ c§n n¯m mÙt sÑ các tham sÑ là ç, các tham sÑ khác các b¡n có thà tham kh£o thêm trên MSDN:

" font_height: Giá trË này là chiÁu cao cça Font tính theo ¡n vË pixels.

" font_width: BÁ rÙng cça Font theo ¡n vË Pixel. N¿u b±ng 0 thì Windows s½ dùng giá trË m·c Ënh phù hãp vÛi chiÁu cao cça Font.

" escapement: ây là góc quay cça Font so vÛi °Ýng n±m ngang. Tính theo Ù.

" orientation: ây là h°Ûng cça chï, nh°ng Windows xem h°Ûng cça chï là góc quay cça chï nên Ñi sÑ này s½ bË bÏ qua.

" weight: ChÉ Ënh Ù ­m cça Font, là mÙt sÑ giïa 0 -> 900. B¡n chÍn 0 Ã sí dång giá trË m·c Ënh, 400 là bình th°Ýng, và 700 là ­m.

" italic: N¿u giá trË này khác 0, chï s½ nghiêng.

" underscore: N¿u giá trË này khác 0, chï s½ °ãc g¡ch d°Ûi.

" strikeout: N¿u giá trË này khác 0, chï s½ °ãc g¡ch giïa.

" character_set: Giá trË này chÉ Ënh các xác l­p kí tñ ví då nh° Russian, Greek, and Arabic. Thông th°Ýng b¡n nên ·t giá trË này b±ng ANSI_CHARSET (0).

" face_name: Tên cça Font, ví då: ''Times New Roman'' ho·c ''Courier New.''..v..v..

Hàm CreateFont tr£ vÁ handle cça Font vëa mÛi °ãc t¡o. à có thà sí dång Font này b¡n ph£i dùng hàm SelectObject API à chÍn Font mÛi cho mÙt Ñi t°ãng nh° Form ho·c PictureBox..v..v... SelectObject s½ tr£ vÁ handle cça Font ci. Ch°¡ng trình có thà ''v½ chï'' dùng Font ã chÍn. Khi ch¡y xong nên dùng hàm SelectObject à tr£ vÁ giá trË m·c Ënh và dùng hàm DeleteObject à xóa Font và gi£i phóng bÙ nhÛ.

Bây giÝ hãy xem mÙt ví då.

Private Declare Function SelectObject Lib ''gdi32'' (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function CreateFont Lib ''gdi32'' Alias ''CreateFontA'' (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long

Private Declare Function DeleteObject Lib ''gdi32'' (ByVal hObject As Long) As Long

Private Const PROOF_QUALITY = 2

Private Sub Form_Load()

Me.AutoRedraw = True

Angle = 45 'Góc quay cça chï

escapement = CLng(Angle * 10) Mod 3600

If escapement

If escapement = 0 Then escapement = 3600

rfont = CreateFont(20, 20, escapement, escapement, 700, 0, 0, 0, 0, 0, 0, PROOF_QUALITY, 0, ''Verdana'' + Chr(0))

current = SelectObject(Me.hdc, rfont) 'ChÍn font vëa t¡o

Me.CurrentX = 700

Me.CurrentY = 1100

Me.Print ''Text''

SelectObject Me.hdc, curent 'Tr£ vÁ Font m·c Ënh

DeleteObject (rfont) 'Gi£i phóng bÙ nhÛ

End Sub Dãy sÑ và dãy chu×i ng«u nhiên (PHP)

ây là các chéc nng hay g·p khi b¡n thñc hiÇn các website, c§n các dãy sÑ hay chu×i b¥t kó Ã cung c¥p

cho ng°Ýi sí dång à active acount ho·c generate các password...

SÑ ng«u nhiên