• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Fading A Bitmap

Các thủ thuật về âm thanh, đồ họa, truyền thông đa phương tiện...
Hình đại diện của người dùng
clarkkent
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 1641
Ngày tham gia: T.Tư 16/04/2008 11:25 am
Đến từ: Chợ Lách - Bến Tre
Been thanked: 31 time
Liên hệ:

Fading A Bitmap

Gửi bàigửi bởi clarkkent » T.Sáu 05/06/2009 9:37 am

Thủ thuật: Fading A Bitmap
Tác giả: Sưu tầm
Mô tả: Fading A Bitmap


để test bạn thêm vào 1 PictureBox (Chọn 1 hình cho Picture), 1 Command, copy code sau vào rồi F5

Mã: Chọn hết

  1. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  2. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  3. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  4. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  5. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  6. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  7. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  8.  
  9. Private Const SRCAND = &H8800C6
  10. Private Const SRCCOPY = &HCC0020
  11.  
  12. Private Sub Command1_Click()
  13.     Dim lDC As Long
  14.     Dim lBMP As Long
  15.     Dim W As Integer
  16.     Dim H As Integer
  17.     Dim lColor As Long
  18.    
  19.     Screen.MousePointer = vbHourglass
  20.    
  21.     W = ScaleX(Picture1.Picture.Width, vbHimetric, vbPixels)
  22.     H = ScaleY(Picture1.Picture.Height, vbHimetric, vbPixels)
  23.     '
  24.     ' Create Memory Compatible Bitmap to that in Picture1
  25.     '
  26.     lBMP = CreateCompatibleBitmap(Picture1.hdc, W, H)
  27.     '
  28.     ' Create Compatible DC in memory
  29.     '
  30.     lDC = CreateCompatibleDC(Picture1.hdc)
  31.     '
  32.     ' Select the Bitmap into the memory DC
  33.     '
  34.     Call SelectObject(lDC, lBMP)
  35.     BitBlt lDC, 0, 0, W, H, Picture1.hdc, 0, 0, SRCCOPY
  36.     '
  37.     ' Quickly clear the Picture in Picture1
  38.     '
  39.     Picture1 = LoadPicture("")
  40.    
  41.     For lColor = 255 To 0 Step -3
  42.         '
  43.         ' Set the backcolor to a gray scale -> black
  44.         '
  45.         Picture1.BackColor = RGB(lColor, lColor, lColor)
  46.         '
  47.         ' Copy the bitmap into the picturebox 'AND' with the backcolor
  48.         '
  49.         BitBlt Picture1.hdc, 0, 0, W, H, lDC, 0, 0, SRCAND
  50.         '
  51.         ' Pause for a bit
  52.         '
  53.         Sleep 15
  54.     Next
  55.     '
  56.     ' Clear up our DC's and Bitmaps
  57.     '
  58.     Call DeleteDC(lDC)
  59.     Call DeleteObject(lBMP)
  60.     Screen.MousePointer = vbDefault
  61.    
  62. End Sub
  63.  


• Hôm bây: www.tinsoftware.com ^ ^
Cố gắng lên...

Quay về “[VB] Âm thanh và Đồ họa”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách