User Tag List

+ Trả lời chủ đề
Hiện kết quả từ 1 tới 7 của 7

Chủ đề: Một Số Vb Tips

  1. #1
    HHT
    Guest
    Bài viết sau đây giới thiệu với các bạn một số típ của VB
    Nguồn:VBSquare ||VB-World
    1.Tạo một form hình Elip
    Bạn đã chán với giao diện của form thông thường vậy thì tại sao không thay đổi nó nhỉ
    Bạn chọn View-->Code và thêm vào đoạn code sau đay và mọi việc đã hoàn tất
    Mã:
    Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
    
    Private Sub Form_Load()
        Dim lngNewWind As Long
        Dim lngNewRegn As Long
        Dim lngWidth As Long
        Dim lngHeight As Long
        '// Calculate the current width
        lngWidth = Me.Width / Screen.TwipsPerPixelX
        '// Calculate the current height
        lngHeight = Me.Height / Screen.TwipsPerPixelY
        '// Create the new region
        lngNewWnd = CreateEllipticRgn(0, 0, lngWidth, lngHeight)
        '// Apply the new region
        lngNewRgn = SetWindowRgn(Me.hWnd, lngNewWnd, True)
    End Sub
    2.Tạo một form nhấp nháy
    Bạn tạo một project mới thêm vào đó một cmdbutton và một điều khiển Timer
    Sau đó chèn vào đoạn code sau
    Mã:
    Private Declare Function FlashWindow _
            Lib "user32" (ByVal hwnd As Long, _
            ByVal bInvert As Long) As Long
    
    Private Sub tmrFlash_Timer()
        Dim lngRet As Long
        '// Flash the window
        lngRet = FlashWindow(Me.hwnd, 1)
    End Sub
    
    Private Sub cmdFlash_Click()
        '// Flash every 0.5 seconds
        tmrFlash.Interval = 500
        tmrFlash.Enabled = True
    End Sub
    
    Private Sub Form_Load()
        '// Don't start flashing yet
        tmrFlash.Enabled = False
    End Sub
    Bạn nhấn F5 và thấy thành quả của mình

    3.Tạo một form chuyển động
    Bạn tạo một project mới thêm vào một cmdbutton và một modules
    Chèn code sau vào module
    Mã:
    Public Sub FormDance(M As Form)
    M.Left = 5
    Pause (1)
    M.Left = 400
    Pause (1)
    M.Left = 700
    Pause (1)
    M.Left = 1000
    Pause (1)
    M.Left = 2000
    Pause (1)
    M.Left = 3000
    Pause (1)
    M.Left = 4000
    Pause (1)
    M.Left = 5000
    Pause (1)
    M.Left = 4000
    Pause (1)
    M.Left = 3000
    Pause (1)
    M.Left = 2000
    Pause (1)
    M.Left = 1000
    Pause (1)
    M.Left = 700
    Pause (1)
    M.Left = 400
    Pause (1)
    M.Left = 5
    Pause (1)
    M.Left = 400
    Pause (1)
    M.Left = 700
    Pause (1)
    M.Left = 1000
    Pause (1)
    M.Left = 2000
    
    End Sub
    Public Sub Pause(interval As Integer)
    
    'pause/waits for "interval" seconds
    Current = Timer
    Do While Timer - Current < Val(interval)
    DoEvents
    Loop
    End Sub
    Chèn code dưới đây vào cmdbutton
    Mã:
    Private Sub Command1_Click()
    Call FormDance(Me)
    End Sub
    Vậy là xong

    4.Lấy thông tin về một ổ đĩa
    Khởi tạo một project mới và thêm vào một module, một cmdbutton
    Bạn thêm vào module đoạn code sau"
    Mã:
    Declare Function GetVolumeInformation Lib _
    "kernel32" Alias "GetVolumeInformationA" _
    (ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, _
    ByVal nVolumeNameSize As Long, _
    lpVolume******Number As Long, _
    lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long
    
    Declare Function GetDriveType Lib "kernel32" _
    Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
    Thêm vào code sau cho cmdbutton
    Mã:
    Private Sub Command1_Click()
    Dim VolName As String, FSys As String, erg As Long
    Dim VolNumber As Long, MCM As Long, FSF As Long
    Dim Drive As String, DriveType As Long
    
    VolName = Space(127)
    FSys = Space(127)
    
    Drive = "d:\" 'Tên ổ đĩa muốn xem thông tin
    DriveType& = GetDriveType(Drive$)
    
    erg& = GetVolumeInformation(Drive$, VolName$, 127&, _
    VolNumber&, MCM&, FSF&, FSys$, 127&)
    
    Print "VolumeName:" & vbTab & VolName$
    Print "VolumeNumber:" & vbTab & VolNumber&
    Print "MCM:" & vbTab & vbTab & MCM&
    Print "FSF:" & vbTab & vbTab & FSF&
    Print "FileSystem:" & vbTab & FSys$
    Print "DriveType:" & vbTab & DriveType&;
    End Sub
    Bạn có thể sưa chữa để chương trình hay hơn như cho nhập vào tên ổ đĩa muốn xem và.....

    5.Tạo ứng dụng đóng,mở CDROM
    Khởi tạo một project mớitheem voaf đó 2 cmdbutton,một nút là Open, một nút là Close, thêm một modules
    Thêm code sau cho module
    Mã:
    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
    Thêm code sau cho các cmdbutton:
    Mã:
    Private Sub Command1_Click()
    retvalue = mciSendString("set CDAudio door open", _
    returnstring, 127, 0)
    End Sub
    
    Private Sub Command2_Click()
    retvalue = mciSendString("set CDAudio door closed", _
    returnstring, 127, 0)
    End Sub
    Thế là xong,chúc các bạn thành công với các típ trên.Sức mạnh API thật kinh khủng

    To be continued.........

  2. #2
    devil
    Guest

    Mặc định

    Cám ơn Linux đã cho bọn mình những kinh nghiệm rất quí báu.
    Tiện đây mình muốn hỏi làm thế nào để không cần viết lệnh mà có thể làm cho biểu mẫu tự điều chỉnh kích thước khi chúng ta thay đổi kích thước cửa sổ. Nếu dùng lệnh thì viết luôn hộ mình nhé. xin cảm ơn! :ph34r:

  3. #3
    White Rose
    Guest

    Mặc định

    - Xác định tỉ lệ về kích thước của control so với form (xác định trong form_load() )
    - dựa vào tỉ lệ này mà tính ra kích thước mới của control so với kích thước form hiện tại. code dùng thay đổi đặt trong form_resize()

    hi hi, tui bỏ VB6 rồi nên cũng chẳng có gì mà vít code cả.

  4. #4
    tuannm143
    Guest

    Mặc định

    Hình như trong PCW có một bài nói về vấn đề này đấy. Tui không nhớ rõ số nào đâu, chịu khó tìm mà đọc.

  5. #5
    svBK's Newbie
    Tham gia ngày
    Oct 2005
    Bài gửi
    6

    Mặc định

    Mã nguồn để in 1 listview. Trên Form chọn 1 Control List view. Tạo menu in. giao diện như hình
    Option Explicit

    ' Return as much text as will fit in this width.
    Private Function FittedText(ByVal txt As String, ByVal wid As Single) As String
    Do While Printer.TextWidth(txt) > wid
    txt = Left$(txt, Len(txt) - 1)
    Loop
    FittedText = txt
    End Function

    Private Sub Form_Load()
    Dim column_header As ColumnHeader
    Dim list_item As ListItem

    ' Create the column headers.
    Set column_header = ListView1. _
    ColumnHeaders.Add(, , "Abbrev", _
    TextWidth("Abbrev"))
    Set column_header = ListView1. _
    ColumnHeaders.Add(, , "Title", _
    TextWidth("Ready-to-Run Visual Basic Algorithms"))
    Set column_header = ListView1. _
    ColumnHeaders.Add(, , "ISBN", _
    TextWidth("0-000-00000-0"))

    ' Start with report view.
    mnuViewChoice_Click lvwReport

    ' Associate the ImageLists with the
    ' ListView's Icons and SmallIcons properties.
    ListView1.Icons = imgLarge
    ListView1.SmallIcons = imgSmall

    Set list_item = ListView1.ListItems.Add(, , "VBA")
    list_item.Icon = 1
    list_item.SmallIcon = 1
    list_item.SubItems(1) = "Ready-to-Run Visual Basic Algorithms"
    list_item.SubItems(2) = "0-471-24268-3"

    Set list_item = ListView1.ListItems.Add(, , "VBGP")
    list_item.Icon = 1
    list_item.SmallIcon = 1
    list_item.SubItems(1) = "Visual Basic Graphics Programming"
    list_item.SubItems(2) = "0-471-15533-0"

    Set list_item = ListView1.ListItems.Add(, , "CCL")
    list_item.Icon = 1
    list_item.SmallIcon = 1
    list_item.SubItems(1) = "Custom Controls Library"
    list_item.SubItems(2) = "0-471-24267-5"

    Set list_item = ListView1.ListItems.Add(, , "AVBT")
    list_item.Icon = 1
    list_item.SmallIcon = 1
    list_item.SubItems(1) = "Advanced Visual Basic Techniques"
    list_item.SubItems(2) = "0-471-18881-6"
    End Sub

    Private Sub Form_Resize()
    ListView1.Move 0, 0, ScaleWidth, ScaleHeight
    End Sub


    Private Sub mnuFileExit_Click()
    Unload Me
    End Sub

    Private Sub PrintListView(lvw As ListView)
    Const MARGIN = 60
    Const COL_MARGIN = 240

    Dim ymin As Single
    Dim ymax As Single
    Dim xmin As Single
    Dim xmax As Single
    Dim num_cols As Integer
    Dim column_header As ColumnHeader
    Dim list_item As ListItem
    Dim i As Integer
    Dim num_subitems As Integer
    Dim col_wid() As Single
    Dim X As Single
    Dim Y As Single
    Dim line_hgt As Single

    xmin = Printer.CurrentX
    ymin = Printer.CurrentY

    ' ******************
    ' Get column widths.
    num_cols = lvw.ColumnHeaders.Count
    ReDim col_wid(1 To num_cols)

    ' Check the column headers.
    For i = 1 To num_cols
    col_wid(i) = Printer.TextWidth(lvw.ColumnHeaders(i).Text)
    Next i

    ' Check the items.
    num_subitems = num_cols - 1
    For Each list_item In lvw.ListItems
    ' Check the item.
    If col_wid(1) < Printer.TextWidth(list_item.Text) Then _
    col_wid(1) = Printer.TextWidth(list_item.Text)

    ' Check the subitems.
    For i = 1 To num_subitems
    If col_wid(i + 1) < Printer.TextWidth(list_item.SubItems(i)) Then _
    col_wid(i + 1) = Printer.TextWidth(list_item.SubItems(i))
    Next i
    Next list_item

    ' Add a column margin.
    For i = 1 To num_cols
    col_wid(i) = col_wid(i) + COL_MARGIN
    Next i

    ' *************************
    ' Print the column headers.
    Printer.CurrentY = ymin + MARGIN
    Printer.CurrentX = xmin + MARGIN
    X = xmin + MARGIN
    For i = 1 To num_cols
    Printer.CurrentX = X
    Printer.Print FittedText( _
    lvw.ColumnHeaders(i).Text, col_wid(i));
    X = X + col_wid(i)
    Next i
    xmax = X + MARGIN

    Printer.Print
    line_hgt = Printer.TextHeight("X")
    Y = Printer.CurrentY + line_hgt / 2
    Printer.Line (xmin, Y)-(xmax, Y)
    Y = Y + line_hgt / 2

    ' Print the rows.
    num_subitems = num_cols - 1
    For Each list_item In lvw.ListItems
    X = xmin + MARGIN

    ' Print the item.
    Printer.CurrentX = X
    Printer.CurrentY = Y
    Printer.Print FittedText( _
    list_item.Text, col_wid(1));
    X = X + col_wid(1)

    ' Print the subitems.
    For i = 1 To num_subitems
    Printer.CurrentX = X
    Printer.Print FittedText( _
    list_item.SubItems(i), col_wid(i + 1));
    X = X + col_wid(i + 1)
    Next i

    Y = Y + line_hgt * 1.5
    Next list_item
    ymax = Y

    ' Draw lines around it all.
    Printer.Line (xmin, ymin)-(xmax, ymax), , B

    X = xmin + MARGIN / 2
    For i = 1 To num_cols - 1
    X = X + col_wid(i)
    Printer.Line (X, ymin)-(X, ymax)
    Next i
    End Sub
    Private Sub mnuFilePrint_Click()
    Printer.CurrentX = 1440
    Printer.CurrentY = 1440

    PrintListView ListView1

    Printer.EndDoc
    End Sub


    Private Sub mnuViewChoice_Click(Index As Integer)
    Dim i As Integer

    ' Display the selected view style.
    ListView1.View = Index

    ' Check this menu item.
    For i = 0 To 3
    If i = Index Then
    mnuViewChoice(i).Checked = True
    Else
    mnuViewChoice(i).Checked = False
    End If
    Next i
    End Sub

  6. #6
    HUT's Student Avatar của WTDOng
    Tham gia ngày
    Nov 2004
    Bài gửi
    294

    Mặc định

    về mã nguồn của VB, có thể tham khảo ở
    http://www.planetsourcecode.com/
    đây là trang mà mình thích nhất, rất nhiều mã nguồn để tham khảo, free, nhiều bài đơn giản và cơ bản, nhưng ứng dụng được nhiều
    Cố gắng hết mình, thành công sẽ tới:41:

  7. #7
    HUT's Student Avatar của Tom
    Tham gia ngày
    Oct 2005
    Bài gửi
    266

    Mặc định

    Quote Nguyên văn bởi devil
    Cám ơn Linux đã cho bọn mình những kinh nghiệm rất quí báu.
    Tiện đây mình muốn hỏi làm thế nào để không cần viết lệnh mà có thể làm cho biểu mẫu tự điều chỉnh kích thước khi chúng ta thay đổi kích thước cửa sổ. Nếu dùng lệnh thì viết luôn hộ mình nhé. xin cảm ơn! :ph34r:
    Đây là một vấn đề mà mình cũng chưa giải quyết được, cả VC ++ cũng bị như vậy thành ra nhiều khi phải disable nút thay đổi kích thước, có pác nào biết thì post lên cho anh em học hỏi.
    Thanks
    I'm just the shadow of the man I used to be.

+ Trả lời chủ đề

Thông tin chủ đề

Users Browsing this Thread

Hiện có 1 người đọc bài này. (0 thành viên và 1 khách)

Chủ đề tương tự

  1. Thêm một tips dành cho anh em SV nghèo !
    Gửi bởi Mr.vulh_bk trong mục Giảng đường khoa ĐTVT
    Trả lời: 2
    Bài cuối: 11-07-2005, 12:47 AM
  2. tips and tricks for LCD
    Gửi bởi teleman trong mục Robocon
    Trả lời: 13
    Bài cuối: 20-12-2004, 02:42 PM
  3. Insider’s tips to score above 600 on the TOEFL
    Gửi bởi bjet4 trong mục English for Science and Technology
    Trả lời: 1
    Bài cuối: 01-03-2003, 12:42 PM

Từ khóa (Tag) của chủ đề này

Quyền viết bài

  • Bạn không thể gửi chủ đề mới
  • Bạn không thể gửi trả lời
  • Bạn không thể gửi file đính kèm
  • Bạn không thể sửa bài viết của mình


About svBK.VN

    Bách Khoa Forum - Diễn đàn thảo luận chung của sinh viên ĐH Bách Khoa Hà Nội. Nơi giao lưu giữa sinh viên - cựu sinh viên - giảng viên của trường.

Follow us on

Twitter Facebook youtube