注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

显示图片的特效  

2007-07-05 11:08:19|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
显示图片的特效

请在相应目录中增加一个JPG图片后再执行程序

控件:
1 picture
1 command

代码:

\'需求一个PictureBox( Named picture2),一个Command按键)
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 Long
Private Declare Function CreateCompatibleDC 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As

Long

Const SRCCOPY = &HCC0020
Private Picture1 As New StdPicture

Private Sub Command1_Click()
    Dim i As Long
    Dim j As Long
    Dim height5 As Long, width5 As Long
    Dim hMemDc As Long

    \'stdPicture物件的度量单位是Himetric所以要转换成Pixel
    height5 = ScaleY(Picture1.Height, vbHimetric, vbPixels)
    If height5 > Picture2.ScaleHeight Then
        height5 = Picture2.ScaleHeight
    End If
    width5 = ScaleX(Picture1.Width, vbHimetric, vbPixels)
    If width5 > Picture2.ScaleWidth Then
        width5 = Picture2.ScaleWidth
    End If
    \'Create Memory DC
    hMemDc = CreateCompatibleDC(Picture2.hdc)
    \'将Picture1的BitMap图指定给hMemDc
    Call SelectObject(hMemDc, Picture1.Handle)
    For i = height5 To 1 Step -1
        Call BitBlt(Picture2.hdc, 0, i, width5, 1, _
                    hMemDc, 0, i, SRCCOPY)
        For j = i - 1 To 1 Step -1
            Call BitBlt(Picture2.hdc, 0, j, width5, 1, _
                    hMemDc, 0, i, SRCCOPY)
        Next j
    Next
    Call DeleteDC(hMemDc)
End Sub

Private Sub Form_Load()
    Dim i As Long
    Picture2.ScaleMode = 3 \'设定成Pixel的度量单位
    \'设定待Display的图
    Set Picture1 = LoadPicture("c:\\0061B0DA.jpg")
End Sub
 
  评论这张
 
阅读(585)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017