• Thứ Năm, 06/05/2004 11:13 (GMT+7)

    Góp ý bài "Hiệu ứng form trong VB6"

    Trên báo TGVT A tháng 2/04 trang 93, bạn Vũ Thắng có nêu cách làm các hiệu ứng động cho form với VB6 rất tuyệt. Tuy nhiên nếu trong frmDemo chỉ có duy nhất một listbox và trong listbox không có list nào (listcount=0) thì không có hiệu ứng gì xảy ra cả, hoặc nếu listcount>0 thì đường viền của listbox sẽ có màu đen đậm. Tôi rất thích cách xuất hiện của form từ từ rõ dần và khi unload sẽ từ từ mờ dần nên tôi sẽ giới thiệu với các bạn một cách làm hiệu ứng tránh được các tình trạng với listbox nêu trên bằng 3 hàm API: SetWindowLong,GetWindowLong và SetLayeredWindowAttributes. (Mọi vấn đề liên quan đến các hàm API của Window bạn có thể lên website www.allapi.net và downdload AllApiNetWork, chương trình giải thích khá đầy đủ về các hàm API, các đối số, ghi chú, ví dụ bằng VB6 và VB7).

    Tạo một Standard Project mới trong VB6. Vào ViewCode và khai báo các hàm, hằng cần dùng (bạn có thể mở tiện ích đi kèm VB6 là APILoad cho nhanh và chính xác):

    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _

       (ByVal hWnd As Long, ByVal nIndex As Long) As Long

    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _

       (ByVal hWnd As Long, ByVal nIndex As Long, _

       ByVal dwNewLong As Long) As Long

    Private Declare Function SetLayeredWindowAttributes Lib "user32" _

       (ByVal hWnd As Long, ByVal crKey As Long, _

       ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

    Private Const GWL_EXSTYLE = (-20)

    Private Const LWA_ALPHA = &H2

    Private Const WS_EX_LAYERED = &H80000

    Dim m_lAlpha

    Hàm SetLayeredWindowAttributes làm cho form mờ hay rõ tùy vào đối số bAlpha (nhỏ nhất là 0, lớn nhất là 255). Do đó để form từ từ rõ (hoặc mờ) bạn sẽ phải sử dụng 2 Timer.

    Đưa vào form 2 đối tượng Timer1, Timer2 (Enable=False, Interval=70). Viết code cho Timer1 và Timer2. Timer1 làm form rõ dần và Timer2 làm form mờ dần.

    Private Sub Timer1_Timer()

        m_lAlpha = m_lAlpha + 15

       If (m_lAlpha > 255) Then

          m_lAlpha = 255

          Timer1.Enabled = False

       Else

        SetLayeredWindowAttributes Me.hWnd, 0, m_lAlpha, LWA_ALPHA

       End If

    End Sub

     

    Private Sub Timer2_Timer()

        m_lAlpha = m_lAlpha - 15

       If (m_lAlpha < 0) Then

         m_lAlpha = 0

         Unload me

       Else

    SetLayeredWindowAttributes Me.hWnd, 0, m_lAlpha, LWA_ALPHA

    End if

    End Sub

    Do đối tượng Timer của chúng ta hoạt động sau khi Form_Load nên chúng ta phải thiết lập Layer của form là vô hình (không phải Visible=false) mà bằng SetLayerWindowAttributes với bAlpha=0.

    Private Sub Form_Load()

     Dim lStyle As Long

      lStyle = GetWindowLong(Me.hWnd, GWL_EXSTYLE)

      lStyle = lStyle Or WS_EX_LAYERED

      SetWindowLong Me.hWnd, GWL_EXSTYLE, lStyle

      SetLayeredWindowAttributes Me.hWnd, 0, 0, LWA_ALPHA

      Timer1.Enabled = True

    End Sub

    Khi nhấn vào dấu "X" trên titlebar của form thì chương trình của chúng ta sẽ bị "cúp điện ngay" nên không thể thấy hiệu ứng mờ dần do đó ta phải "phá bỏ cầu dao" bằng thủ tục Form_QuerryUnload (xảy ra trước khi Form_Unload).

    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    If UnloadMode <> vbFormCode Then '// nếu unload bằng cách nhấn "X"

     Cancel = True

     Timer2.Enable=True

    End If

    End Sub

    Xong rồi, bạn thử nhấn F5 xem!

    Ngoài ra, tôi muốn giới thiệu với các bạn "một món đồ trang sức" để làm đẹp cho form bằng các hiệu ứng tô màu Dọc (vertical), Ngang (Horizontal), Xéo (Diagonal), Từ góc (From Conner), Từ giữa (From Center) hệt như hiệu ứng "Fill Effects" cho màu nền của MS Word (Format.BackGround.Fill Effects).

    Tạo một Standard Project mới. Add thêm một Module

    ***Trong Module****

     Dim Red,Green,Blue

    '// Tạo các kiểu tô cần dùng:

     Public Enum DrawStyle

      Vertical = 0

      Horizontal = 1

      DiagonalUp = 2

      DiagonalDown = 3

      FromConner = 4

      FromCenter = 5

      HaflHorizontalUp = 6

      HaflHorizontalDown = 7

      HaflVerticalLeft = 8

      HaflVerticalRight = 9

      HaflDiagonalUp1 = 10

      HaflDiagonalUp2 = 11

      HaflDiagonalDown1 = 12

      HaflDiagonalDown2 = 13

      FromConner1 = 14

      FromConner2 = 15

      FromConner3 = 16

      FromConner4 = 17

     End Enum

    '//Nếu vào Fill Effects của Word bạn sẽ thấy 2 cách tô trên là nguyên thủy (tô đầy object), còn 2 //cách tô dưới là ghép của 2 cái trên lại nên chúng ta sẽ có thêm các cách tô từ 6->17 trong Enum.           

    '//Do tô màu theo kiểu lan tỏa nên chúng ta sẽ phải tính độ lan tỏa giữa các màu. Function sau sẽ đổi                  //màu ra số theo hệ RGB. Vd: vbRed =RGB(255,0,0)

    Public Function Analyze(Chroma As ColorConstants)

      Dim rr, gr, br As Long

      rr = 1: gr = 256: br = 65536

      Dim rest As Long

      rest = Chroma \ br

      Blue = rest

      Chroma = Chroma Mod br

      If Blue < 0 Then Blue = 0


      rest = Chroma \ gr

      Green = rest

      Chroma = Chroma Mod gr

      If Green < 0 Then Green = 0


      rest = Chroma \ rr

      Red = rest

      Chroma = Chroma Mod rr

      If Red < 0 Then Red = 0

    End Function

    '// Sub chính của chúng ta, WhatDraw là đối tượng cần vẽ (Form,PictureBox,...),Way là cách tô  //theo Enum, SClr là màu bắt đầu, EClr là màu kết thúc, Grad là độ lan tỏa của 2 màu (có thể không    //cần)

    Public Function DrawGradient(WhatDraw As Object, Way As FillGradStyle, SClr As Long, EClr As Long, Optional Grad = 1)

    On Error Resume Next

    WhatDraw.AutoRedraw = True

    Dim a, b

    a = WhatDraw.ScaleWidth / 2

    b = WhatDraw.ScaleHeight / 2

     Analyze (SClr)

      SRed = Red

      SGreen = Green

      SBlue = Blue

     Analyze (EClr)

      ERed = Red

      EGreen = Green

      EBlue = Blue

     DifR = ERed - SRed

     DifG = EGreen - SGreen

     DifB = EBlue - SBlue

     Select Case Way

       Case 0, 14, 15, 16, 17

        Fora = 2 * a

       Case 1

        Fora = 2 * b

       Case 2, 3

        Fora = Sqr(2) * Sqr((WhatDraw.ScaleWidth * WhatDraw.ScaleWidth) + (WhatDraw.ScaleHeight * WhatDraw.ScaleHeight))

       Case 6, 7

        Fora = Round(b, 0)

       Case 8, 9, 5

        Fora = Round(a, 0)

       Case 10, 11, 12, 13

        Fora = (Sqr(2) * Sqr((WhatDraw.ScaleWidth * WhatDraw.ScaleWidth) + (WhatDraw.ScaleHeight * WhatDraw.ScaleHeight))) / 2

      End Select

       For Yi = 0 To Fora

       SRed = SRed + (Grad * DifR / Fora)

       If SRed < 0 Then SRed = 0

        SGreen = SGreen + (Grad * DifG / Fora)

       If SGreen < 0 Then SGreen = 0

        SBlue = SBlue + (Grad * DifB / Fora)

       If SBlue < 0 Then SBlue = 0

       Select Case Way

        Case 1, 6

         WhatDraw.Line (0, Yi)-(2 * a, Yi), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (0, b + Yi)-(2 * a, b + Yi), RGB(SRed, SGreen, SBlue)

        Case 0, 8

         WhatDraw.Line (Yi, 0)-(Yi, 2 * b), RGB(SRed, SGreen, SBlue)

        Case 2, 10

         WhatDraw.Line (Yi - 1, 0)-(-1, Yi), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (Yi + Fora - 1, 0)-(-1, Yi + Fora), RGB(SRed, SGreen, SBlue)

        Case 3, 12

         WhatDraw.Line (2 * a - Yi, 0)-(2 * a, Yi), RGB(SRed, SGreen, SBlue)

        Case 5

         WhatDraw.Line (a - (a * Yi) / b, b - Yi)-(a + (a * Yi) / b, b - Yi), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (a - (a * Yi) / b, b + Yi)-(a + (a * Yi) / b, b + Yi), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (a - Yi, b - (b * Yi) / a)-(a - Yi, b + (b * Yi) / a), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (a + Yi, b - (b * Yi) / a)-(a + Yi, b + (b * Yi) / a + 1.5), RGB(SRed, SGreen, SBlue)

        Case 7

         WhatDraw.Line (0, b + Yi)-(2 * a, b + Yi), RGB(SRed, SGreen, SBlue)

        Case 9

         WhatDraw.Line (a + Yi, 0)-(a + Yi, 2 * b), RGB(SRed, SGreen, SBlue)

        Case 11

         WhatDraw.Line (Yi + Fora - 1, 0)-(-1, Yi + Fora), RGB(SRed, SGreen, SBlue)

        Case 13

         WhatDraw.Line (2 * a - (Yi + Fora), 0)-(2 * a, (Yi + Fora)), RGB(SRed, SGreen, SBlue)

        Case 14

         WhatDraw.Line (Yi, 0)-(Yi, (b * Yi) / a), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (0, Yi)-((a * Yi) / b, Yi - 1.5), RGB(SRed, SGreen, SBlue)

        Case 15

         WhatDraw.Line (a * 2 - Yi, 0)-(a * 2 - Yi, (b * Yi) / a), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (2 * a, Yi)-(2 * a - (a * Yi) / b - 1.5, Yi), RGB(SRed, SGreen, SBlue)

        Case 16

         WhatDraw.Line (0, b * 2 - Yi)-((a * Yi) / b, b * 2 - (Yi - 1.5)), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (Yi, 2 * b)-(Yi, 2 * b - (b * Yi) / a), RGB(SRed, SGreen, SBlue)

        Case 17

         WhatDraw.Line (2 * a - Yi, 2 * b)-(2 * a - Yi, 2 * b - (b * Yi) / a), RGB(SRed, SGreen, SBlue)

         WhatDraw.Line (2 * a, 2 * b - Yi)-(2 * a - (a * Yi) / b, 2 * b - Yi + 1), RGB(SRed, SGreen, SBlue)

        End Select

      Next

    End Function

    *******Hết Module************

    Bây giờ chỉ việc tô màu cho các đối tượng. Từ [0] ->[4] là các cách tô nguyên thủy (tô đầy Object). Từ [6]->[13] tô theo cặp (6+7,8+9,10+11,12+13). Riêng [5] có 4 cách tô (14,15,16,17). Ví dụ, thực hiện cách tô DiagonalDown cho Picture(i) (i:0->3):

    Loại 1:
     DrawGradient  Picture(0),3,vbGreen,vbRed

    Loại 2:
     DrawGradient  Picture(1),3,vbRed,vbGreen

    Loại 3:
     DrawGradient  Picture(2),12,vbGreen,vbRed
     DrawGradient  Picture(3),13,vbRed,vbGreen

    Loại 4:
     DrawGradient  Picture(2),12, vbRed,vbGreen
     DrawGradient  Picture(3),13, vbGreen,vbRed.

    Nguyễn Quốc Việt
    Bamby084@hotmail.com

    ID: A0404_114