要是能创建半透明的刷子就好了,就不必像这样以图层的方式实现透明阴影效果。

代码:

 'code by lichmama@cnblogs.com
'绘制阴影图层
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, _
ByVal nHeight 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, _
ByVal nWidth As Long, _
ByVal crColor As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, _
ByVal tx As Long, _
ByVal ty As Long, _
ByVal Tw As Long, _
ByVal Th As Long, _
ByVal hdc As Long, _
ByVal sx As Long, _
ByVal sy As Long, _
ByVal sw As Long, _
ByVal sh As Long, _
ByVal BLENDFUNCT As Long) As Long
Private Const PS_SOLID = Private Sub Command1_Click()
Dim hMemdc As Long
Dim hBmp As Long
Dim hBrush As Long
Dim hPen As Long
Dim w As Long
Dim h As Long w = &
h = & hMemdc = CreateCompatibleDC(&)
hBmp = CreateCompatibleBitmap(Me.hdc, w, h)
Call SelectObject(hMemdc, hBmp) hBrush = CreateSolidBrush(RGB(, , ))
Call SelectObject(hMemdc, hBrush) hPen = CreatePen(PS_SOLID, &, RGB(, , ))
Call SelectObject(hMemdc, hPen) Call Rectangle(hMemdc, &, &, w, h)
Call AlphaBlend(Picture2.hdc, &, &, w, h, hMemdc, &, &, w, h, &H10000 * ) Call DeleteObject(hBrush)
Call DeleteObject(hPen)
Call DeleteObject(hBmp)
Call DeleteObject(hMemdc)
End Sub

贴张图:

VB6之阴影图层的更多相关文章

  1. VB6史无前例的子类化之透明按钮

    [原创文章,转发请保留版权信息] 作者:mezstd 文章地址:http://www.cnblogs.com/imez/p/3299728.html 效果图: 请原谅笔者无耻地称之为史无前例,至少在笔 ...

  2. VB6与VB.NET对照表

    VB6与VB.NET对照表 VB6.0 VB.NET AddItem Object名.AddItem Object名.Items.Add ListBox1.Items.Add ComboBox1.It ...

  3. 自写函数VB6 STUFF函数 和 VB.net 2010 STUFF函数 详解

    '*************************************************************************'**模 块 名:自写函数VB6 STUFF函数 和 ...

  4. VB6.0中,DTPicker日期、时间控件不允许为空时,采用文本框与日期、时间控件相互替换赋值(解决方案)

    VB6.0中,日期.时间控件不允许为空时,采用文本框与日期.时间控件相互替换赋值,或许是一个不错的选择. 实现效果如下图: 文本框txtStopTime1 时间框DTStopTime1(DTPicke ...

  5. VB6.0 和VB.NET 函数对比

    VB6.0和VB.Net的对照表 VB6.0 VB.NET AddItem Object名.AddItem Object名.Items.Add ListBox1.Items.Add ComboBox1 ...

  6. MODI与VB6

    作者:马健邮箱:stronghorse_mj@hotmail.com主页:http://www.comicer.com/stronghorse发布:2016.12.16 在我写的<用MODI O ...

  7. vb6保存项目到c盘的安装目录

    工程保存在安装目录("C:\Program Files (x86)\Microsoft Visual Studio\VB98\errhandler1.vbp")里. 文件管理器找不 ...

  8. 【VB6】使用VB6创建和访问Dom树【爬虫基础知识 】

    使用VB6创建和访问Dom树 关键字:VB,DOM,HTML,爬虫,IHTMLDocument 我们知道,在VB中一般大家会用WebBrowser来获取和操作dom对象. 但是,有这样一种情形,却让我 ...

  9. 吐个槽,对VB6.0 还有VBS 说ByeBye

    往事不堪回首,折腾了个把月的老系统,心中郁结,不吐不快.系统架构是ASP +VBS +VB6.0 + SQL Server2000, 第一个版本开发完成大概是在2000年.基本是处于交接无力,看代码就 ...

随机推荐

  1. 线程机制、CLR线程池以及应用程序域

    最近在总结多线程.CLR线程池以及TPL编程实践,重读一遍CLR via C#,比刚上班的时候收获还是很大的.还得要多读书,读好书,同时要多总结,多实践,把技术研究透,使用好. 话不多说,直接上博文吧 ...

  2. Hibernate与Jpa的关系(2)

    [转自:http://blog.163.com/hero_213/blog/static/398912142010312024809/ ] 近年来ORM(Object-Relational Mappi ...

  3. kafka 0.10.2 部署失败后,重新部署

    删除kafka各个节点log目录 删除zookeeper上kafka相关的目录 [root@m1 ~]# zkCli.sh Connecting to localhost: -- ::, [myid: ...

  4. 前端教你学UI——人物处理(一)

    一.序言 本文作为本系列的第一篇写UI的文章,开头还是有必要申明一些东西的,本系列主要是为了作为博主在前端工作之余学习UI的一个记录,同时为了让更多的同行学习到一些编程之外的其他东西.所以本文会尽可能 ...

  5. CORS协议与Spring注解的冲突

    众所周知,HTML5的CORS协议,支持各种request method,远胜于仅支持get方式的JSONP. 但今天,我用CORS协议,却一直不成功. 跨域异常,如图 POST http://10. ...

  6. poj2069

    poj2069 题意 求一个覆盖所有点的最小球体的半径.即求空间内一点到所有点的距离的最大值最小的点. 分析 模拟退火算法,但这道题竟然不用随机函数就能过了,主要体现了算法的渐近收敛性, 起始点随意取 ...

  7. 静态代码块详解(原出处:http://versioneye.iteye.com/blog/1129579)

    一 般情况下,如果有些代码必须在项目启动的时候就执行的时候,需要使用静态代码块,这种代码是主动执行的;需要在项目启动的时候就初始化,在不创建对象的情 况下,其他程序来调用的时候,需要使用静态方法,这种 ...

  8. EF编辑

    //修改推荐的信息 var productRe = db.Shop_ProductRecommends.Single(item => item.Id == model.Id); productR ...

  9. 关于MyEclipse修改项目名称后,部署到tomcat显示旧的项目名称

    问题:用Myeclipse部署项目的时候,     出现部署到tomcat下的项目是之前的项目,而不是当前的项目.   解决方案:工程名->右键->Properties->MyEcl ...

  10. ArcGIS API for JavaScript根据两个点坐标在地图上画线

    ArcGIS API for JavaScript根据两个点坐标在地图上画线比如说a(xxxx,xxxxx),b(xxxx,xxxxx).利用这两个点画一条线 var polyline = new e ...