getwindowdc.frm

是API教程5

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3735
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6045
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3735
   ScaleWidth      =   6045
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text3 
      Height          =   3375
      Left            =   180
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   180
      Width           =   5655
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetWindowDC& Lib "user32" (ByVal hwnd 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)
Private Declare Function CreateCompatibleBitmap& Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long)
Private Declare Function CreateCompatibleDC& Lib "gdi32" (ByVal hdc As Long)
Private Declare Function DeleteDC& Lib "gdi32" (ByVal hdc As Long)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long)
Private Declare Function SetBkColor& Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long)




Private star As Boolean



Private Sub Form_Load()
   star = False
   Form1.Width = 6135
   Form1.Show
   
   star = True
   DisPlay
End Sub



Sub DisPlay()

   Dim WndDC As Long
   Dim TmpDC As Long
   Dim TxtDC As Long
   Dim BackDC As Long
   Dim dl As Long
   Dim i As Integer
   Dim hBit As Long, hBit1 As Long, hbit2 As Long
   Dim oldBit As Long, oldBit1 As Long, oldbit2 As Long
   
   WndDC = GetWindowDC(Form1.hwnd)
   TmpDC = CreateCompatibleDC(WndDC)
   BackDC = CreateCompatibleDC(WndDC)
   TxtDC = CreateCompatibleDC(WndDC)
   
   hBit = CreateCompatibleBitmap(WndDC, 360, 20)      '创建一幅位图(下一讲内容)
   hBit1 = CreateCompatibleBitmap(WndDC, 360, 20)
   hbit2 = CreateCompatibleBitmap(WndDC, 360, 20)
   
   oldBit = SelectObject(TmpDC, hBit)
   oldBit1 = SelectObject(TxtDC, hBit1)
   oldbit2 = SelectObject(BackDC, hbit2)
   
   dl& = BitBlt(BackDC, 0, 0, 360, 20, WndDC, 24, 2, vbSrcCopy)  '准备背景图象
   dl& = SetBkColor(TxtDC, vbBlack)
   dl& = SetTextColor(TxtDC, vbWhite)
   
   Do
       For i = -150 To 360
            If Not star Then Exit Do
            dl& = BitBlt(TmpDC, 0, 0, 360, 20, BackDC, 0, 0, vbSrcCopy)
            dl& = TextOut(TxtDC, 0, 0, "欢迎访问《vb前线》!  ", 21)
            dl& = BitBlt(TmpDC, i, 2, 150, 15, TxtDC, 0, 0, vbSrcPaint)
            dl& = BitBlt(WndDC, 24, 2, 360, 20, TmpDC, 0, 0, vbSrcCopy)
            DoEvents
            Sleep 2         '延时
       Next
   Loop
   
   dl& = SelectObject(BackDC, oldbit2)
   dl& = SelectObject(TxtDC, oldBit1)
   dl& = SelectObject(TmpDC, oldBit)
   
   dl& = DeleteObject(hbit2)           '(下一讲内容)
   dl& = DeleteObject(hBit1)
   dl& = DeleteObject(hBit)
   
   dl& = DeleteDC(TmpDC)
   dl& = DeleteDC(BackDC)
   dl& = DeleteDC(TxtDC)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    star = False     '停止演示
End Sub