www.pudn.com > zfpb.rar > Flower.bas


Attribute VB_Name = "Module1" 
Option Explicit 
 
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long 
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long 
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 
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long 
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long 
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long 
 
Private Const SRCAND = &H8800C6     ' (DWORD) dest = source AND dest 
Private Const SRCCOPY = &HCC0020    ' (DWORD) dest = source 
Private Const SRCINVERT = &H660046  ' (DWORD) dest = source XOR dest 
Private Const SRCOR = &HEE0086 
 
 
Public Sub Flower() 
  Dim I As Long, X As Long, Y As Long, X1 As Long, Y1 As Long 
  Dim Width As Long, Height As Long, DeskTOPDC As Long, hMemDC1 As Long, hMemDC2 As Long 
  Dim MaskPIC As New StdPicture, PIC1 As New StdPicture 
   
    DeskTOPDC = GetWindowDC(0&) 
    hMemDC1 = CreateCompatibleDC(DeskTOPDC) 
    hMemDC2 = CreateCompatibleDC(DeskTOPDC) 
    Randomize Timer 
    I = (Rnd * 10) Mod 6 
    X = Rnd * (Screen.Width / Screen.TwipsPerPixelX) 
    Y = Rnd * (Screen.Height / Screen.TwipsPerPixelY) 
    X = IIf(X And 1, X - 100, X - 10) 
    Y = IIf(Y And 1, Y - 50, Y - 10) 
    Set PIC1 = LoadResPicture(I * 2 + 101, vbResBitmap) 
    Set MaskPIC = LoadResPicture(I * 2 + 102, vbResBitmap) 
   
    Call SelectObject(hMemDC1, MaskPIC.Handle) 
    Width = Form1.ScaleX(PIC1.Width, vbHimetric, vbPixels) - 2 
    Height = Form1.ScaleY(PIC1.Height, vbHimetric, vbPixels) - 2 
    I = BitBlt(DeskTOPDC, X, Y, Width, Height, hMemDC1, 1, 1, SRCAND) 
     
    Call SelectObject(hMemDC2, PIC1.Handle) 
    I = BitBlt(DeskTOPDC, X, Y, Width, Height, hMemDC2, 1, 1, SRCOR) 
    DeleteDC hMemDC1 
    DeleteDC hMemDC2 
    ReleaseDC 0&, DeskTOPDC 
End Sub 
 
Public Sub GetDeskTOP(ByVal theForm As Form) 
  Dim Width As Long, Height As Long, DeskTOPDC As Long, hMemDC1 As Long, hMemDC2 As Long 
  theForm.WindowState = 2 
  theForm.ScaleMode = vbTwips 
  theForm.AutoRedraw = True 
  DeskTOPDC = GetWindowDC(0&) 
  BitBlt theForm.hdc, 0, 0, Screen.Width, Screen.Height, DeskTOPDC, 0, 0, SRCCOPY 
End Sub