扫描模拟.frm

Windows API函数,希望大伙有用哦

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4005
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5355
   LinkTopic       =   "Form1"
   ScaleHeight     =   290.17
   ScaleMode       =   0  'User
   ScaleWidth      =   363.173
   Begin VB.PictureBox Picture2 
      BorderStyle     =   0  'None
      Height          =   4035
      Left            =   0
      ScaleHeight     =   269
      ScaleMode       =   0  'User
      ScaleWidth      =   179.718
      TabIndex        =   1
      Top             =   0
      Width           =   5445
      Begin VB.CommandButton Command3 
         Caption         =   "退    出"
         Height          =   315
         Left            =   3960
         TabIndex        =   4
         Top             =   3360
         Width           =   1035
      End
      Begin VB.CommandButton Command2 
         Caption         =   "隔行扫描"
         Height          =   315
         Left            =   3960
         TabIndex        =   3
         Top             =   3030
         Width           =   1035
      End
      Begin VB.CommandButton Command1 
         Caption         =   "逐行扫描"
         Height          =   315
         Left            =   3960
         TabIndex        =   2
         Top             =   2700
         Width           =   1035
      End
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   4035
      Left            =   0
      Picture         =   "扫描模拟.frx":0000
      ScaleHeight     =   269
      ScaleMode       =   0  'User
      ScaleWidth      =   353
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   5445
   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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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
 Dim I As Integer, J As Integer, M As Integer, N As Integer
 Dim P1 As Integer, P2 As Integer, Px As Integer, Py As Integer
 Dim X() As Integer, Y() As Integer, D As Integer
 Dim Nx As Integer, Ny As Integer, Dx As Integer
Private Sub Form_Load()
  N = 24: M = N * Picture1.ScaleHeight / Picture1.ScaleWidth
  D = M * N
'调整数组大小
  ReDim X(N, M) As Integer, Y(N, M) As Integer
'计算图块大小
  Dx = Picture1.ScaleWidth / N
  P1 = Dx
  P2 = Dx
'按序号生成各图块坐标，以从左到右从上到下为序
     Ny = 0
      For I = 1 To M
        Nx = 0
       For J = 1 To N
        X(J, I) = Nx * Dx
        Y(J, I) = Ny * Dx
        Nx = Nx + 1
       Next J
       Ny = Ny + 1
      Next I
  End Sub
Private Sub Command1_Click()
 Command1.Visible = False
 Command2.Visible = False
 Command3.Visible = False
'逐行扫描
 Picture2.Cls
  For I = 1 To M
   For J = 1 To N
    Px = X(J, I)
    Py = Y(J, I)
    BitBlt Picture2.hDC, Px, Py, P1 - 1, P2 - 1, Picture1.hDC, Px, Py, vbSrcCopy
    Sleep 50
   Next J
 Next I
 Command1.Visible = True
 Command2.Visible = True
 Command3.Visible = True
End Sub
Private Sub Command2_Click()
 Command1.Visible = False
 Command2.Visible = False
 Command3.Visible = False
Picture2.Cls
'奇数场扫描
  For I = 1 To M - 1 Step 2
   For J = 1 To N
  Px = X(J, I)
  Py = Y(J, I)
    BitBlt Picture2.hDC, Px, Py, P1 - 1, P2 - 1, Picture1.hDC, Px, Py, vbSrcCopy
    Sleep 50
   Next J
 Next I
' 偶数场扫描
  For I = 2 To M Step 2
   For J = 1 To N
    Px = X(J, I)
    Py = Y(J, I)
    BitBlt Picture2.hDC, Px, Py, P1 - 1, P2 - 1, Picture1.hDC, Px, Py, vbSrcCopy
    Sleep 50
   Next J
 Next I
 Command1.Visible = True
 Command2.Visible = True
 Command3.Visible = True
End Sub

Private Sub Command3_Click()
 End
End Sub