screensaver.frm

金算盘软件代码

Private Sub InitItem()
Dim intCount As Integer
Dim udtRect  As RECT
Dim lngWindowHwnd As Long
Randomize Timer  ''初始化随机发生器
For intCount = 0 To m_intItemCount
  m_udtMovieItem(intCount).xCurr = (m_udtRect.Right - m_udtRect.Left - 64) * Rnd
  m_udtMovieItem(intCount).yCurr = (m_udtRect.Bottom - m_udtRect.top - 64) * Rnd
  m_udtMovieItem(intCount).xPrev = -1
  m_udtMovieItem(intCount).yPrev = -1
  m_udtMovieItem(intCount).moveSpeed = m_lngSpeed
  m_udtMovieItem(intCount).xStep = (Rnd * m_lngSpeed) * IIf(Rnd < 0.5, 1, -1)
  m_udtMovieItem(intCount).yStep = (Sqr(m_lngSpeed * m_lngSpeed _
   - m_udtMovieItem(intCount).xStep * m_udtMovieItem(intCount).xStep)) * IIf(Rnd < 0.5, 1, -1)
  m_udtMovieItem(intCount).currFrames = Int(Rnd * m_lngFramesCount)
  m_udtMovieItem(intCount).itemHeight = 38
  m_udtMovieItem(intCount).itemWidth = 38
  m_udtMovieItem(intCount).rotatoSpeed = IIf(Rnd < 0.5, 1, -1)
Next intCount
End Sub

Private Function DrawItem(hdc As Long, intCount As Integer) As Boolean
 Dim intItemCount As Integer
 Dim x1, x2, y1, y2 As Long
 Dim lngSaveStep As Long
 Dim blnNoMove     As Boolean
 If m_udtMovieItem(intCount).xPrev > 0 And _
    m_udtMovieItem(intCount).yPrev > 0 Then  ''恢复原来屏幕
    BitBlt hdc, m_udtMovieItem(intCount).xPrev, m_udtMovieItem(intCount).yPrev, _
       m_udtMovieItem(intCount).itemWidth, m_udtMovieItem(intCount).itemHeight, _
       lngDestDC, m_udtMovieItem(intCount).xPrev, m_udtMovieItem(intCount).yPrev, vbSrcCopy
    m_udtMovieItem(intCount).xPrev = m_udtMovieItem(intCount).xCurr
    m_udtMovieItem(intCount).yPrev = m_udtMovieItem(intCount).yCurr
    If m_udtMovieItem(intCount).xCurr <= 10 Then
      m_udtMovieItem(intCount).xStep = Abs(m_udtMovieItem(intCount).xStep)
    Else
        If m_udtMovieItem(intCount).xCurr >= m_udtRect.Right - m_udtRect.Left - 64 Then
          m_udtMovieItem(intCount).xStep = Abs(m_udtMovieItem(intCount).xStep) * (-1)
        End If
    End If
    If m_udtMovieItem(intCount).yCurr <= 10 Then
      m_udtMovieItem(intCount).yStep = Abs(m_udtMovieItem(intCount).yStep)
    Else
      If m_udtMovieItem(intCount).yCurr >= m_udtRect.Bottom - m_udtRect.top - 64 Then
        m_udtMovieItem(intCount).yStep = Abs(m_udtMovieItem(intCount).yStep) * (-1)
      End If
    End If
    ''检查是否碰撞,改变单元运行轨迹,改变速度的方法为
    ''交换两单元的水平和垂直分速度
    x1 = m_udtMovieItem(intCount).xCurr + _
         m_udtMovieItem(intCount).xStep
    x2 = m_udtMovieItem(intCount).xCurr + _
         m_udtMovieItem(intCount).xStep + m_udtMovieItem(intCount).itemWidth
    y1 = m_udtMovieItem(intCount).yCurr + _
         m_udtMovieItem(intCount).yStep
    y2 = m_udtMovieItem(intCount).yCurr + _
         m_udtMovieItem(intCount).yStep + m_udtMovieItem(intCount).itemHeight
    For intItemCount = 0 To m_intItemCount
      If Not intItemCount = intCount Then
        If (x2 > m_udtMovieItem(intItemCount).xCurr _
           And y2 > m_udtMovieItem(intItemCount).yCurr _
           And x2 < m_udtMovieItem(intItemCount).xCurr + m_udtMovieItem(intItemCount).itemWidth _
           And y2 < m_udtMovieItem(intItemCount).yCurr + m_udtMovieItem(intItemCount).itemHeight) Or _
           (m_udtMovieItem(intItemCount).xCurr + m_udtMovieItem(intItemCount).itemWidth + m_udtMovieItem(intItemCount).xStep > x1 And _
           m_udtMovieItem(intItemCount).yCurr + m_udtMovieItem(intItemCount).itemHeight + m_udtMovieItem(intItemCount).yStep > y1 _
           And (m_udtMovieItem(intItemCount).xCurr + m_udtMovieItem(intItemCount).itemWidth + m_udtMovieItem(intItemCount).xStep < x2 And _
           m_udtMovieItem(intItemCount).yCurr + m_udtMovieItem(intItemCount).itemHeight + m_udtMovieItem(intItemCount).yStep < y2)) Then
           ''交换速度
           lngSaveStep = m_udtMovieItem(intCount).xStep
           m_udtMovieItem(intCount).xStep = m_udtMovieItem(intItemCount).xStep
           m_udtMovieItem(intItemCount).xStep = lngSaveStep
           lngSaveStep = m_udtMovieItem(intCount).yStep
           m_udtMovieItem(intCount).yStep = m_udtMovieItem(intItemCount).yStep
           m_udtMovieItem(intItemCount).yStep = lngSaveStep
           blnNoMove = True
        End If
      End If
    Next intItemCount
    m_udtMovieItem(intCount).xCurr = m_udtMovieItem(intCount).xCurr + m_udtMovieItem(intCount).xStep
    m_udtMovieItem(intCount).yCurr = m_udtMovieItem(intCount).yCurr + m_udtMovieItem(intCount).yStep
    m_udtMovieItem(intCount).currFrames = (m_udtMovieItem(intCount).currFrames + _
          m_udtMovieItem(intCount).rotatoSpeed) Mod (m_lngFramesCount + 1)
    If m_udtMovieItem(intCount).currFrames < 0 Then
      m_udtMovieItem(intCount).currFrames = m_lngFramesCount
    End If
    DrawTansBitmap hdc, m_hBitmap, 0, _
      (m_udtMovieItem(intCount).currFrames Mod 46) * m_udtMovieItem(intCount).itemHeight, _
      m_udtMovieItem(intCount).xCurr, _
      m_udtMovieItem(intCount).yCurr, m_udtMovieItem(intCount).itemWidth _
      , m_udtMovieItem(intCount).itemHeight _
      , RGB(0, 0, 0), 0
 Else
    m_udtMovieItem(intCount).xPrev = m_udtMovieItem(intCount).xCurr
    m_udtMovieItem(intCount).yPrev = m_udtMovieItem(intCount).yCurr
    DrawTansBitmap hdc, m_hBitmap, 0, _
      (m_udtMovieItem(intCount).currFrames Mod 46) * m_udtMovieItem(intCount).itemHeight, _
      m_udtMovieItem(intCount).xCurr, _
      m_udtMovieItem(intCount).yCurr, m_udtMovieItem(intCount).itemWidth _
      , m_udtMovieItem(intCount).itemHeight _
      , RGB(0, 0, 0), 0
 End If
End Function

Private Function DrawTansBitmap(ByVal hdc As Long, ByVal hSaveBmp As Object, _
   ByVal XBegin As Long, ByVal YBegin As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
   ByVal BkColor As Long, ByVal blnInvert As Long) As Long
Dim lngBitmapDC As Long
Dim hPrevBitmapBmp As Long
Dim lngSrcDC As Long
Dim lngSaveDC As Long
Dim lngMaskDC As Long
Dim lngInvDC As Long
Dim lngNewPicDC As Long
Dim bmpSource As Object
Dim hResultBmp As Long
Dim hDestBmp  As Long
Dim hMaskBmp As Long
Dim hShowBmp As Long
Dim hInvBmp As Long
Dim hSrcPrevBmp As Long
Dim hSavePrevBmp As Long
Dim hDestPrevBmp As Long
Dim hMaskPrevBmp As Long
Dim hInvPrevBmp As Long
Dim hBitmapBack As Object
Dim lngOrigScaleMode&
Dim lngOrigColor&
Dim lngHBrush As Long
Dim udtRect   As RECT
Dim hBitmapMask As Object
Dim hSrcBmp    As Long
Dim hOldsrcBmp As Long

lngSrcDC = CreateCompatibleDC(hdc)
lngSaveDC = CreateCompatibleDC(hdc)
lngMaskDC = CreateCompatibleDC(hdc)
lngInvDC = CreateCompatibleDC(hdc)
lngNewPicDC = CreateCompatibleDC(hdc)
lngBitmapDC = CreateCompatibleDC(hdc)

''创建单色位图和其反象位图
hMaskBmp = CreateBitmap(nWidth, nHeight, 1, 1, ByVal 0&)
hInvBmp = CreateBitmap(nWidth, nHeight, 1, 1, ByVal 0&)
hResultBmp = CreateCompatibleBitmap(hdc, nWidth, nHeight)
hSrcBmp = CreateCompatibleBitmap(hdc, nWidth, nHeight)
hShowBmp = CreateCompatibleBitmap(hdc, nWidth, nHeight)
hPrevBitmapBmp = SelectObject(lngBitmapDC, hSaveBmp)

hSrcPrevBmp = SelectObject(lngSrcDC, hSrcBmp)
hSavePrevBmp = SelectObject(lngSaveDC, hShowBmp)
hMaskPrevBmp = SelectObject(lngMaskDC, hMaskBmp)
hInvPrevBmp = SelectObject(lngInvDC, hInvBmp)
hDestPrevBmp = SelectObject(lngNewPicDC, hResultBmp)

''将位图填入
BitBlt lngSaveDC, 0, 0, nWidth, nHeight, lngBitmapDC, XBegin, YBegin, vbSrcCopy

''将背景填入
BitBlt lngSrcDC, 0, 0, nWidth, nHeight, hdc, x, y, vbSrcCopy

lngOrigColor = SetBkColor(lngSaveDC, BkColor)
''生成单色前景
BitBlt lngMaskDC, 0, 0, nWidth, nHeight, lngSaveDC, 0, 0, vbSrcCopy
SetBkColor lngSaveDC, lngOrigColor
BitBlt lngInvDC, 0, 0, nWidth, nHeight, lngMaskDC, 0, 0, vbNotSrcCopy
''生成反相前景
BitBlt lngNewPicDC, 0, 0, nWidth, nHeight, lngSaveDC, 0, 0, vbSrcCopy

BitBlt lngNewPicDC, 0, 0, nWidth, nHeight, lngInvDC, 0, 0, vbSrcAnd
BitBlt lngSrcDC, 0, 0, nWidth, nHeight, lngMaskDC, 0, 0, vbSrcAnd
BitBlt lngNewPicDC, 0, 0, nWidth, nHeight, lngSrcDC, 0, 0, vbSrcPaint
BitBlt hdc, x, y, nWidth, nHeight, lngNewPicDC, 0, 0, vbSrcCopy
BitBlt hdc, x, y, nWidth, nHeight, lngNewPicDC, 0, 0, vbSrcCopy

SelectObject lngBitmapDC, hPrevBitmapBmp
SelectObject lngSaveDC, hSavePrevBmp
SelectObject lngNewPicDC, hDestPrevBmp
SelectObject lngMaskDC, hMaskPrevBmp
SelectObject lngInvDC, hInvPrevBmp
SelectObject lngSrcDC, hSrcPrevBmp
DeleteObject hMaskBmp
DeleteObject hInvBmp
DeleteObject hResultBmp
DeleteObject lngHBrush
DeleteObject hSrcBmp
DeleteObject hShowBmp
DeleteDC lngSrcDC
DeleteDC lngSaveDC
DeleteDC lngInvDC
DeleteDC lngMaskDC
DeleteDC lngNewPicDC
DeleteDC lngBitmapDC
End Function