怎样将一张图片从下开始渐进的显示出来？？

Question

BitBlt VB声明 
Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (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 
说明 
将一幅位图从一个设备场景复制到另一个。源和目标DC相互间必须兼容 
返回值 
Long，非零表示成功，零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
hDestDC Long，目标设备场景 
x,y Long，对目标DC中目标矩形左上角位置进行描述的那个点。用目标DC的逻辑坐标表示 
nWidth,nHeight Long，欲传输图象的宽度和高度 
hSrcDC Long，源设备场景。如光栅运算未指定源，则应设为0 
xSrc,ySrc Long，对源DC中源矩形左上角位置进行描述的那个点。用源DC的逻辑坐标表示 
dwRop Long，传输过程要执行的光栅运算 
注解 
在NT环境下，如在一次世界传输中要求在源设备场景中进行剪切或旋转处理，这个函数的执行会失败
如目标和源DC的映射关系要求矩形中像素的大小必须在传输过程中改变，那么这个函数会根据需要自动伸缩、旋转、折叠、或切断，以便完成最终的传输过程
 

Answer 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
'w、h为图像的宽、高
For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
Next

Answer 2

to:zyl910(910：分儿，我来了！)  我有两个矢量图，它们放在了picturebox里面，一个包含另一个，然后我让一个模拟背景，另一个从上到下，渐进的显示出来，不知是否可以用这个api?
（两个picturebox的大小相同，两个矢量图的大小相同）

Answer 3

我有两个矢量图，它们放在了picturebox里面，一个包含另一个，然后我让一个模拟背景，另一个从上到下，渐进的显示出来本身就可以了

Answer 4

PaintPicture 方法
      用以在 Form, PictureBox 或 Printer 上绘制图形文件（.bmp、.wmf、.emf、.cur、.ico或 .dib）的内容。不支持命名参数。语法object.PaintPicture picture, x1, y1, width1, height1, x2, y2, width2, height2, opcodePaintPicture 方法的语法包含下列部分：部分 描述 
object 可选的。一个对象表达式，其值为“应用于”列表中的一个对象。如果省略 object，带有焦点的 Form 对象缺省为 object。 
Picture 必需的。要绘制到 object 上的图形源。Form 或 PictureBox 必须是 Picture 属性。 
x1, y1 必需的。均为单精度值，指定在 object 上绘制 picture 的目标坐标（x-轴和y-轴）。object 的 ScaleMode 属性决定使用的度量单位。  
Width1 可选的。单精度值，指示 picture 的目标宽度。object 的 ScaleMode 属性决定使用的度量单位。如果目标宽度比源宽度 (width2) 大或小，将适当地拉伸或压缩 picture。如果该参数省略，则使用源宽度。 
Height1 可选的。 单精度值，指示 picture 的目标高度。object 的 ScaleMode 属性决定使用的度量单位。如果目标高度比源高度 (height2) 大或小，将适当地拉伸或压缩 picture。如果该参数省略，则使用源高度。 
x2, y2 可选的。均为单精度值，指示 picture 内剪贴区的坐标（x-轴和y-轴）。object 的 ScaleMode 属性决定使用的度量单位。如果该参数省略，则缺省为 0。 
Width2 可选的。单精度值，指示 picture 内剪贴区的源宽度。object 的 ScaleMode 属性决定使用的度量单位。如果该参数省略，则使用整个源宽度。 
Height2 可选的。 单精度值，指示 picture 内剪贴区的源高度。object 的 ScaleMode 属性决定使用的度量单位。如果该参数省略，则使用整个源高度。 
Opcode 可选的。是长型值或仅由位图使用的代码。它用来定义在将 pictur 绘制到 object 上时对 picture 执行的位操作（例如， vbMergeCopy 或 vbSrcAnd 操作符）。关于位操作符常数的完整列表，请参阅 Visual Basic Help 文件中的 RasterOp Constants 主题。 
在使用opcode时有一些限制。例如，如果资源是图标或图元文件，则只能使用 vbSrcCopy，而不能使用其他的opcode；并且，与图案 (或 SDK 术语中的"画笔")，如 MERGECOPY、 PATCOPY、 PATPAINT 和 PATINVERT，相交互的opcode实际上是同目标的 FillStyle 属性交互。注意   Opcode 用于将按位操作传递到位图。当传递其他图象类型时将一个值给该参数会造成“无效过程调用或参数”错误。这是设计的原因。要避免这个错误，对于除位图外的图象，将 Opcode 参数置为空。
 
说明通过使用负的目标高度值 (height1) 和 / 或目标宽度值 (width1) ，可以水平或垂直翻转位图。 可以省略任何多个可选的尾部的参数 。如果省略了一个或多个可选尾部参数，则不能在指定的最后一个参数后面使用逗号。如果想指定某个可选参数，则必须先指定语法中出现在该参数前面的全部参数。注意，在将一个.Bmp加载入 PictureBox 控件和使用 Windows API 函数 BitBlt() 添加图片之间有一点不同。当您对一个图象使用 BitBlt() 时，PictureBox 控件不知道象您使用 LoadPicture方法那样去调整大小。将 ScaleWidth 和 ScaleHeight 属性设置为图象的大小也不起作用。如果您想在使用 BitBlt 之后用 PictureBox 调整新图片的大小，必须用代码手工做，转换单位并处理边框，下面是如何这样做的一个简单示例：Sub ResizePictureBoxToImage(pic as PictureBox, twipWd _
  as Integer, twipHt as Integer)
 ' 该代码假设所有的单位都为缇。如果
 ' 不是，必须在调用该例程之前，转换为缇。
 ' 这里也假设图象显示在0,0处。
 Dim BorderHt as Integer, BorderWd as Integer
 BorderWd = Pic.Width - Pic.ScaleWidth
 BorderHt = Pic.Height - Pic.ScaleHeight
 pic.Move pic.Left, pic.Top, twipWd + BorderWd, _
   twipHt + BorderHt
End Sub

Answer 5

TO:liuzhanwen(研究一下！) (  ) 
必须动态的显示出来。

Answer 6

TO:zyl910(910：分儿，我来了！)矢量图好像不行啊

Answer 7

为什么不直接用PaintPicture方法？
For i = h - 1 To 0 Step -1
    Picture1.PaintPicture 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
Next

Answer 8

加如一个FLASH插件啊！
这样做是最简单的方法！

Answer 9

to: toperray(绿皮狼) 
你显示的是矢量图？
那必须先插点
然后延时实现
延时可用sleep函数

Answer 10

那很简单呀
你先在picture1中显示背景
然后在另一picture2中显示前景
再用BitBlt 将picture2中的图片与picture1中的进行逻辑运算，当然你只能一行一行的复制，复制完一行延时一段时间，ok？

Answer 11

to: easypower(阿里) 能具体一下嘛，最好有代码事例。

Answer 12

http://www.dapha.net/vb/down.asp?id=1625&file=http://www.dapha.net/soure/pic/Alpha Blending with Picture Boxes.zip
软件名称 图片透明合成效果  
软件类型  
运行环境 VB6.0/Win9x 
授权方式 免费代码 
软件大小 26K 
软件评价  
上传时间 2002-1-10 
相关链接 主页 
本日下载 1  本周：105  总计：105 
下载地址1 下载 
软件简介 程序主要是透明的合成两张图片, 打开程序后已经有一张大图在表单上.只需要选择透明颜色和另外一张图片. 然后在大图片上点一下, 选中的另外一张图片就合成到大图片上, 而且是透明的

Answer 13

picture1中显示背景
picture2中放置前景
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3
Picture1.AutoRedraw = True
Picture2.Visible = FalsePicture1.Picture = LoadPicture(背景)
Picture2.Picture = LoadPicture(前景)通过一个循环来实现.
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
'w、h为图像的宽、高
For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
Next

Answer 14

to:zyl910(910：分儿，我来了！) 连接有误啊，能不能发给我？

Answer 15

http://www.21code.com/codebase/?pos=down&id=1754
名称:FastestGraphicalEffectsInPUREVBUPD.zip
URL:http://www.microsoft.com&item=member&login=www.21code.com&passwordhash=1011959112&downloadsrv=china_bjtelcom&file=&[email protected]/codebase/go.php?data=dmJjb2RlL3ZiY2RncnBoL0Zhc3Rlc3RHcmFwaGljYWxFZmZlY3RzSW5QVVJFVkJVUEQuemlw
大小: 81KB 
完成时间:Fri Jan 25 19:52:08 2002
引用页:http://www.21code.com/codebase/?pos=down&id=1754
注释:源码类型： VisualBasic源码-图形方面   尚无图片... 
 
 
  
上传时间： 2001-10-28  
  
下载次数： 101  
    
源码大小： 83 KB 源码评价：      
    
预计下载时间： 33.6K:0时0分20秒 56K:0时0分12秒 128K:0时0分5秒  
  
  
下载连接：下载连接 (No.1) 下载服务器状况检查： （说明） 
  
源码简介：
 快速图形处理程序，有几种常见的处理效果，但是速度都比其他示例快！

Answer 16

zyl910(910：分儿，我来了！) 
你图形方面不错呀! :)

Answer 17

to: 505(五五) 我用你的方法实现不了，不知到哪里有问题？下面是我的代码：Option Explicit
Dim i As Single
Dim h As Single
Dim w As Single
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 LongPrivate Sub Form_Load()
h = Picture1.Height
w = Picture1.WidthPicture1.Picture = LoadPicture("e:\temp1.wmf")
Picture2.Picture = LoadPicture("e:\temp2.wmf")
For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
Next
End Sub帮我看看那里的问题

Answer 18

For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
Next中间延时一下！试一下
For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
    sleep(200)
Next当然前面要申明
着是api 函数

Answer 19

to:easypower(阿里) 
sleep函数没法用，编译通不过

Answer 20

你申明没有？
如同BitBlt 一样要申明
你用api view 看看

Answer 21

Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Answer 22

回复人： ToperRay(绿皮狼) (  ) 信誉：100  2002-5-18 19:37:38  得分:0  
 
 
  我怎么下不了啊？
 
====================================================================
浏览http://www.21code.com/codebase/?pos=down&id=1754

Answer 23

to:zyl910(910：分儿，我来了！) 那个代码我下了，代码有些麻烦，如果有简单的方法，我不想用它，
非常感谢你。

Answer 24

不可能哟
那你用timer控件来延时
要不自己写延时函数
等一下
我给你

Answer 25

Public Sub delay(ys As Integer)        '延时函数Dim t0 As Longt0 = GetCurrentTime()                  '获得当前时间Do While GetCurrentTime() - t0 < ys    '延时ysLoop
    
End Sub
当然也用上了api

Answer 26

to: easypower(阿里) 和用sleep效果一样,都是工程死掉

Answer 27

哦
我知道了
你在for 循环中间在加一句
doevents
酸了
qq交流
我懒得刷新
12378537
（朋友别黑）

Answer 28

哦
我知道了
你在for 循环中间在加一句
doevents
酸了
qq交流
我懒得刷新
12378537
（朋友别黑）

Answer 29

For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
    DoEvents
Next

Answer 30

Option Explicit
Dim i As long
Dim h As long
Dim w 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 LongPrivate Sub Form_Load()'加上这几句
Form1.ScaleMode = 3
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3h = Picture1.Height
w = Picture1.WidthPicture1.Picture = LoadPicture("e:\temp1.wmf")
Picture2.Picture = LoadPicture("e:\temp2.wmf")
For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
Next
End Sub

Answer 31

把Pic2(0)、Pic2(1)设置320*200的图片VERSION 5.00
Begin VB.Form FrmTM 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "透明算法"
   ClientHeight    =   3195
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   3600
      Top             =   90
   End
   Begin VB.CheckBox Chk1 
      Caption         =   "演示"
      Height          =   285
      Left            =   2670
      TabIndex        =   5
      Top             =   30
      Width           =   735
   End
   Begin VB.PictureBox Pic2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   315
      Index           =   1
      Left            =   1770
      ScaleHeight     =   255
      ScaleWidth      =   225
      TabIndex        =   4
      Top             =   2070
      Visible         =   0   'False
      Width           =   285
   End
   Begin VB.PictureBox Pic2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   315
      Index           =   0
      Left            =   870
      ScaleHeight     =   255
      ScaleWidth      =   225
      TabIndex        =   3
      Top             =   2040
      Visible         =   0   'False
      Width           =   285
   End
   Begin VB.HScrollBar HSBar1 
      Height          =   285
      LargeChange     =   5
      Left            =   990
      Max             =   100
      TabIndex        =   2
      Top             =   30
      Value           =   100
      Width           =   1635
   End
   Begin VB.PictureBox Pic1 
      AutoRedraw      =   -1  'True
      Height          =   1185
      Left            =   0
      ScaleHeight     =   75
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   127
      TabIndex        =   0
      Top             =   360
      Width           =   1965
   End
   Begin VB.Label Lbl1 
      Alignment       =   1  'Right Justify
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   210
      TabIndex        =   1
      ToolTipText     =   "不透明度"
      Top             =   0
      Width           =   675
   End
End
Attribute VB_Name = "FrmTM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As LongPrivate MapTMD As Single
Private MeName As StringPrivate Sub Chk1_Click()
    If Chk1.Value Then
        HSBar1.Value = 100
        Timer1.Enabled = True
    Else
        Timer1.Enabled = False
        HSBar1.Value = 100
    End If
    
End SubPrivate Sub Form_Load()
    Dim I As Long
    
    Do
        Pic1.Width = Pic1.Width + Screen.TwipsPerPixelX
    Loop Until Pic1.ScaleWidth = 320
    Do
        Pic1.Height = Pic1.Height + Screen.TwipsPerPixelY
    Loop Until Pic1.ScaleHeight = 200
    Me.Width = Pic1.Width + (Me.Width - Me.ScaleWidth)
    Me.Height = Pic1.Height + 360 + (Me.Height - Me.ScaleHeight)
    
    'For I = 0 To 1
    '    Pic2(I).Picture = LoadResPicture(101 + I, vbResBitmap)
    'Next I
    MeName = Me.Caption
    'Debug.Print hUp, hDn
    
    HSBar1_Change
    
End SubPrivate Sub HSBar1_Change()
    Dim TS As Single
    
    TS = Timer
    
    Lbl1.Caption = HSBar1.Value & "%"
    MapTMD = HSBar1.Value / 100!
    'Debug.Print MapTMD
    DrawTM
    
    Debug.Print Timer - TS
    
End SubPrivate Sub HSBar1_Scroll()
    Lbl1.Caption = HSBar1.Value & "%"
End SubPublic Function TMC(TMD As Single, UpC As Long, DnC As Long) As Long
'TMD：透明度。0:完全透明；1：不透明。
'UpC：上层色
'DownC：下层色
    Dim UpR As Long, UpG As Long, UpB As Long
    Dim DnR As Long, DnG As Long, DnB As Long
    Dim OutR As Long, OutG As Long, OutB As Long
    
    UpR = UpC And &HFF
    UpG = (UpC And &HFF00&) \ &H100
    UpB = (UpC And &HFF0000) \ &H10000
    DnR = DnC And &HFF
    DnG = (DnC And &HFF00&) \ &H100
    DnB = (DnC And &HFF0000) \ &H10000
    
    OutR = DnR + CLng((UpR - DnR) * TMD)
    If OutR < 0 Then OutR = 0
    If OutR > 255 Then OutR = 255
    OutG = DnG + CLng((UpG - DnG) * TMD)
    If OutG < 0 Then OutG = 0
    If OutG > 255 Then OutG = 255
    OutB = DnB + CLng((UpB - DnB) * TMD)
    If OutB < 0 Then OutB = 0
    If OutB > 255 Then OutB = 255
    TMC = RGB(OutR, OutG, OutB) ' OutR + OutG * &H100& + OutB * &H10000
    
End FunctionPrivate Sub DrawTM()
    Dim hUp As Long, hDn As Long, hOut As Long
    Dim OutC As Long
    Dim I As Long, J As Long
    
    'Me.Caption = MeName + "(计算中……)"
    
    hUp = Pic2(0).hdc
    hDn = Pic2(1).hdc
    hOut = Pic1.hdc
    For I = 0 To 319
        For J = 0 To 199
            OutC = TMC(MapTMD, GetPixel(hUp, I, J), GetPixel(hDn, I, J))
            SetPixelV hOut, I, J, OutC
        Next J
    Next I
    
    Pic1.Refresh
    'Me.Caption = MeName
    
End SubPrivate Sub Timer1_Timer()
    Static FX As Boolean
    
    If HSBar1.Value = HSBar1.Max Then
        FX = False
    ElseIf HSBar1.Value = HSBar1.Min Then
        FX = True
    End If
    
    If FX Then
        HSBar1.Value = HSBar1.Value + 5
    Else
        HSBar1.Value = HSBar1.Value - 5
    End If
    
End Sub

Answer 32

在循环之前能看到picture1、picture2中的图像吗？

Answer 33

Option Explicit
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 LongPrivate Sub Command1_Click()
Dim i As Long
Dim h As Long
Dim w As Long
h = Picture1.Height
w = Picture1.Width
For i = h - 1 To 0 Step -1
    BitBlt Picture1.hDC, 0, i, w, h, Picture2.hDC, 0, 0, vbSrcCopy
    Picture1.Refresh
NextEnd SubPrivate Sub Form_Load()Form1.ScaleMode = 3
Picture1.ScaleMode = 3
Picture2.ScaleMode = 3Picture1.AutoRedraw = TruePicture1.Picture = LoadPicture("c:\1.bmp")'背景
Picture2.Picture = LoadPicture("c:\2.bmp")'前景End Sub已验证通过