开发工具:
文件大小: 662byte
下载次数: 0
上传时间: 2012-02-20
详细说明： 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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, _ ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _ ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcR gn1 As Long, _ ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Const RGN_OR = 2 Dim I As Integer, j, myint, linex As Integer Dim Fullr, myColor, crn As Long Dim Region, PicWidth, PicHeight As Long Dim mystart, mybool As Boolean Private Sub Form_Load() Dim hDC As Long Me.Width = Picture1.Width '设置窗体宽度等于图形宽度 Me.Height = Picture1.Height '设置窗体宽度等于图形宽度 Picture1.ScaleMode = vbPixels '设置Picture1度量单位为像素 Picture1.AutoRedraw = True '设置Picture1自动重绘有效 Picture1.AutoSize = True '设置Picture1自动调整大小 Picture1.BorderStyle = vbBSNone '设置Picture1的边框样式 Me.BorderStyle = vbBSNone '设置窗体的边框样式 hDC = Picture1.hDC mystart = True mybool = False I = 0 j = 0 PicWidth = Picture1.ScaleWidth PicHeight = Picture1.ScaleHeight linex = 0 myColor = GetPixel(hDC, 0, 0) '获取picture1指定像素的rgb值 For j = 0 To PicHeight - 1 For I = 0 To PicWidth - 1 If GetPixel(hDC, I, j) = myColor Or I = PicWidth Then '透明像素 If mybool Then mybool = False crn = CreateRectRgn(linex, j, I, j - 1) '创建矩形区域 If mystart Then Fullr = crn mystart = False Else CombineRgn Fullr, Fullr, crn, RGN_OR '合并区域 DeleteObject CreateRectRgn(linex, j, I, j - 1) '删除透明区域 End If End If Else '非透明像素 If Not mybool Then mybool = True linex = I End If End If Next Next Region = Fullr SetWindowRgn Me.hWnd, Region, True '设置窗体区域 myint = 0 End Sub Private Sub Timer1_Timer() '形成动画 Dim hDC As Long myint = myint + 1 If myint = 1 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz3.bmp") If myint = 2 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz4.bmp") If myint = 3 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz5.bmp") If myint = 4 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz6.bmp") If myint = 5 Then myint = 0 hDC = Picture1.hDC mystart = True mybool = False I = 0 j = 0 Me.Width = Picture1.Width Me.Height = Picture1.Height PicWidth = Picture1.ScaleWidth PicHeight = Picture1.ScaleHeight linex = 0 myColor = GetPixel(hDC, 0, 0) '获取picture1指定像素的rgb值 For j = 0 To PicHeight - 1 For I = 0 To PicWidth - 1 If GetPixel(hDC, I, j) = myColor Or I = PicWidth Then '透明像素 If mybool Then mybool = False crn = CreateRectRgn(linex, j, I, j - 1) '创建矩形区域 If mystart Then Fullr = crn mystart = False Else CombineRgn Fullr, Fullr, crn, RGN_OR '合并区域 DeleteObject CreateRectRgn(linex, j, I, j - 1) '删除透明区域 End If End If Else '非透明像素 If Not mybool Then mybool = True linex = I End If End If Next Next Region = Fullr SetWindowRgn Me.hWnd, Region, True '设置窗体区域 End Sub Private Sub Picture1_Click() End End Sub ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
