Một số code cho Access & VB

đăng 20:09, 27 thg 3, 2012 bởi Hai Yen   [ đã cập nhật 07:38, 16 thg 9, 2014 ]

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 = 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 hoăc 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 = 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 năng 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 cũng không nên quá lo ngại về nó. Và thêm 1 chú ý là bạn cũng 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 cũng 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 cũng 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 cũng 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 cũng 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 < 60 Then Position = ''0:'' & Format(sec, ''00'') 
    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 < 60 Then Length = ''0:'' & Format(sec, ''00'') 
        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:

<body>

<form runat=''server''>

<table border=''0''>

<tbody>

<tr>

<td>

<asp:Label id=''Label1'' runat=''server''>First Name:</asp:Label>

</td>

<td>

<asp:TextBox id=''txtFirstName'' runat=''server''></asp:TextBox>

<asp:RequiredFieldValidator id=''rfvFirstName'' runat=''server''

ErrorMessage=''First name is required.''

ControlToValidate=''txtFirstName''></asp:RequiredFieldValidator>

</td>

</tr>

<tr>

<td>

<asp:Label id=''Label2'' runat=''server''>Last Name:</asp:Label>

</td>

<td>

<asp:TextBox id=''txtLastName'' runat=''server''></asp:TextBox>

<asp:RequiredFieldValidator id=''rfvLastName'' runat=''server''

ErrorMessage=''Last name is required.''

ControlToValidate=''txtLastName''></asp:RequiredFieldValidator>

</td>

</tr>

<tr>

<td>

</td>

<td>

<asp:Button id=''cmdPost'' onclick=''cmdPost_Click''

runat=''server'' Text=''Submit''></asp:Button>

</td>

</tr>

</tbody>

</table>

</form>

</body>

 

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ó cũng 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 cũ. 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 < 0 Then escapement = escapement + 3600
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 năng 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

<?php

function randomdigit($digits) {

static $startseed = 0;

if (!$startseed) {

$startseed = (double)microtime()*getrandmax();

srand($startseed);

}

$range = 8;

$start = 1;

$i = 1;

while ($i<$digits) {

$range = $range . 9;

$start = $start . 0;

$i++;

}

return (rand()%$range+$start);

}

?>

Dãy chuỗi ngẫu nhiên

<?php

function randomPass($length = 6) {

// all the chars we want to use

$all = explode( '' '',

''a b c d e f g h i j k l m n o p q r s t u v w x y z ''

. ''A B C D E F G H I J K L M N O P Q R S T U V W X Y Z ''

. ''0 1 2 3 4 5 6 7 8 9'');

for($i=0;$i<$length;$i++) {

srand((double)microtime()*1000000);

$randy = rand(0, 61);

$pass .= $all[$randy];

}

return $pass;

}

?>

PHP và Java

Một điều khá thú vị các các chức năng của PHP là khả năng sử dụng các phương thức của các đối tượng Java, mở ra khả năng tích hợp các ứng dụng PHP của bạn với các ứng dụng Java. Mời các bạn tham khảo các thực hiện.

Để sử dụng bạn cần cài đặt Java Virtual Machine (JVM). Nếu bạn sử dụng JDKs từ Sun, Kaffe, IBM, hay Blackdown, bạn sẽ lợi về mặt tốc độ.
Khi bạn cài đặt PHP, bạn cần thêm --with-java để thêm các thư viện dành cho java, hoặc sửa tập tin php.ini

[Java]
java.library.path=/path/to/library
java.class.path=/classpath/
extension_dir=/path/to/extensions
extension=libphp_java.so
bạn cần đưa đường dẫn Java chính xác.
Đoạn script sau sẽ nối và in ra màn hình bằng các thuộc tính của Java
<?
$system = new Java(''java.lang.System'');
echo ''<P>Java version = '' . $system->getProperty(''java.version'') . ''<br>'';
echo ''Java vendor = '' . $system->getProperty(''java.vendor'') . ''</p>'';
?>
Nếu bạn có hiểu biết về Java, bạn sẽ có thể xây dựng các ứng dụng tích hợp với khả năng không giới hạn.

Chuyển mục chọn trên Menu chính sang góc phải

Theo mặc định thì thanh menu chính luôn nằm ở góc bên phải. Và VB cũng không cung cấp cho chúng ta bất cứ thuộc tính gì để đưa nó sang bên phải. Nhưng với API bạn có thể dễ dàng làm được điều này.

   1.Hãy tạo một Form mới, Sau đó Click vào Tools --> Menu Editor để thêm vào chương trình 3 menu chính còn các menu con thì tùy ý. 
    2. Dùng đoạn Code sau : 
    Private Declare Function GetMenu Lib ''user32'' (ByVal hwnd As Long) As Long
    Private Declare Function ModifyMenu Lib ''user32'' Alias ''ModifyMenuA'' (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
    Private Declare Function DrawMenuBar Lib ''user32'' (ByVal hwnd As Long) As Long

    Private Const MF_BYPOSITION = &H400&
    Private Const MF_HELP = &H4000&

    Private Sub Form_Load()
        res = GetMenu(Me.hwnd) ' Lấy Handle của Menu
        ModifyMenu res, 2, MF_BYPOSITION Or MF_HELP, 2, ''&Help''
        DrawMenuBar Me.hwnd ' Vẽ lại Menu Bar
    End Sub

  Không khó lắm nhưng kết quả thật tuyệt vời phải không

Vô hiệu DeskTop

Hôm nay chúng tôi tiếp tục giới thiệu với các bạn một ví dụ về cách sử dụng hàm API trong VB.Bạn có muốn làm cho Desktop bị ''tê liệt'' không? Bạn hoàn toàn có thể vì Desktop cũng là một cửa sổ như bao chương trình khác, điều bạn cần biết là class name của nó ''Progman''.

 

    Bạn thêm vào một Module :

    Option Explicit
    DefLng A-Z
    Declare Function FindWindowEx Lib ''user32'' _
        Alias ''FindWindowExA'' (ByVal hWnd As Long, _
        ByVal hWndChild As Long, ByVal lpszClassName As String, _
        ByVal lpszWindow As String) As Long
    Declare Function ShowWindow Lib ''user32'' _
        (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

    Public Const SW_HIDE = 0
    Public Const SW_SHOW = 5

    Public Const g_cstrShellViewWnd As String = ''Progman''

    Sau đó thêm vào Project hai button và đoạn code sau:

    Option Explicit
    DefLng A-Z

    Private Function FindShellWindow() As Long
        'Hàm dùng để lấy Handle của Desktop
        Dim hWnd As Long
        On Error Resume Next
        hWnd = FindWindowEx(0&, 0&, g_cstrShellViewWnd, vbNullString)
        If hWnd <> 0 Then
            FindShellWindow = hWnd
        End If
    End Function

    Private Sub HideShowWindow(ByVal hWnd As Long, Optional ByVal Hide As Boolean = False)
        Dim lngShowCmd As Long
        On Error Resume Next
        If Hide = True Then
            lngShowCmd = SW_HIDE
        Else    
            lngShowCmd = SW_SHOW
        End If
        Call ShowWindow(hWnd, lngShowCmd)
    End Sub

    Private Sub command2_Click()
        Dim hWnd As Long
        On Error Resume Next
        hWnd = FindShellWindow()
        If hWnd <> 0 Then
            Call HideShowWindow(hWnd)
        End If
    End Sub

    Private Sub command1_Click()
        Dim hWnd As Long
        On Error Resume Next
        hWnd = FindShellWindow()
        If hWnd <> 0 Then
            Call HideShowWindow(hWnd, True)
        End If
    End Sub

    Private Sub Form_Load()
        Command1.Caption = ''Hide Desktop''
        Command2.Caption = ''Show Desktop''
    End Sub

Làm ẩn nút Start của Window

Các sức mạnh tiềm ẩn của VB nằm ở việc thao tác với các hàm WinAPI. Bạn có thể làm bất cứ việc gì nếu hiểu và nắm được cách sử dụng  các hàm API. Ví dụ bạn có thể làm cho nút Start của Windows biến mất một cách dễ dàng

 

    Const SWP_HIDEWINDOW = &H80

    Const SWP_SHOWWINDOW = &H40

    Const GW_CHILD = 5

    Const GW_HWNDNEXT = 2

   Private Declare Function SetWindowPos Lib ''user32'' (ByVal hwnd As LongByVal hWndInsertAfter As LongByVal x As Long,ByVal y As LongByVal cx As LongByVal cy As LongByVal wFlags As LongAs Long

    Private Declare Function FindWindow Lib ''user32'' Alias ''FindWindowA'' (ByVal lpClassName As StringByVal lpWindowName AsStringAs Long

    Private Declare Function GetWindow Lib ''user32'' (ByVal hwnd As LongByVal wCmd As LongAs Long

    Private Declare Function GetClassName Lib ''user32'' Alias ''GetClassNameA'' (ByVal hwnd As LongByVal lpClassName AsStringByVal nMaxCount As LongAs Long

    Dim tWnd As Long, bWnd As Long, sSave As String * 250

    Private Sub Form_Load()

        tWnd = FindWindow(''Shell_traywnd'', vbNullString)

        bWnd = GetWindow(tWnd, GW_CHILD)

        Do

            GetClassName bWnd, sSave, 250

            If LCase(Left$(sSave, 6)) = ''button'' Then Exit Do

            bWnd = GetWindow(bWnd, GW_HWNDNEXT)

        Loop

        'Ẩn start button

        SetWindowPos bWnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW

    End Sub

    Private Sub Form_Unload(Cancel As Integer)

        'hiện lại start button

        SetWindowPos bWnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW

    End Sub

Giới hạn của biến trong VB.NET

Trong VB.6 bạn có thể khai báo giá trị kiểu như Public, Private, Friend, và (the local) Dim. Hiện nay trong VB.NET, có một cách khai báo là có giá trị trong block (block-level scope). Có nghĩa là nếu bạn khai báo một biến trong một câu lệnh dạng block (như For Next, While, Select Case, If Then... ) , các biến chỉ được hiểu trong phạm vi của block đó .
Bạn sẽ thấy ví dụ sau đây sẽ báo lổi khi biên dịch

Private Sub DoSomething()
Dim bln As Boolean = True
    If bln Then
        Dim x As Long = 10
    
End If
x = 100 'sẽ gây ra một lổi (Nếu Option Explicit được khai báo)
End sub

Bạn nên lưu ý khi lập trình VB.NET

Comments