首页 >> 读书频道 >> 电脑 >> 用API制作图形窗体
 
· 本章小结
· VB托盘程序详解中
· 有声样式单
· VB托盘程序详解上
· SENDMESSAGE函
· 计数器和自动编号
· 向控件发送系统热键
· SENDMESSAGE函
· 格式化页面
· 在VB中终止Win9X
· CSS2中有哪些新特点?
· 回调(CallBacks
 
· 电视剧《刁蛮公主》下载和
· 美容养颜手册
· 加油金顺剧情分集介绍完整
· 红楼梦:120回全本[清
· 素质教育在美国
· 全唐诗卷四十六
· 韩剧《布拉格恋人》剧情介
· 夜航船[作者:明·张岱]
· 局外人[作者:韩·可爱淘
· 现场流行病学
· 源氏物语[日本:紫式部]
· 武林寓言故事
 
· (出租)中动商场部分及写
· (出租)中动动漫基地&#
· 喜剧学院
· 《善德女王》剧情介绍
· 魔女18号 剧情
· 丑女无敌剧情介绍
· 魔女幼熙剧情介绍
· 龙游天下剧情介绍
· 震撼世界的七日剧情介绍
· 静静的白桦林剧情介绍
· 心情日记—老公今天我想对
· 旗舰剧情介绍
欢迎来到月影社区!如果您觉得这里不错,请推荐给您的朋友们。月影社区:http://wf66.com/

用API制作图形窗体


查看有无更新版本

关键字:VB 2006-9-18

 

使用GetBitmapBits函数,将图片的颜色信息读到一个数组中,然后就对数组的数据进行扫描,使用CreateRectRgn函数生成每一个有用点的图窗体,再使用CombineRgn函数对有用的图象合并,组成所要的窗体,最后使用SetWindowRgn来设定窗体

程序代码:
Module1

Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long

Public Const RGN_OR = 2

Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Public Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Dim bmByte() As Byte

Public Declare Function ReleaseCapture Lib "user32" () As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'Public Const WM_SYSCOMMAND = &H112
'Public Const SC_MOVE = &HF012
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull)
Dim X As Long, Y As Long
Dim Rgn1 As Long, Rgn2 As Long
Dim SPos As Long, EPos As Long
Dim bm As BITMAP
Dim hbm As Long
Dim Wid As Long, Hgt As Long
Dim xoff As Long, yoff As Long
获取窗体背景图片尺寸

hbm = hForm.Picture
GetObjectAPI hbm, Len(bm), bm
Wid = bm.bmWidth
Hgt = bm.bmHeight

ReDim bmByte(1 To Wid, 1 To Hgt)
GetBitmapBits hbm, Wid * Hgt, bmByte(1, 1) 获取图像数组

如果没有传入transColor参数,则用第一个像素作为透明色

If transColor = vbNull Then transColor = bmByte(1, 1)

Rgn1 = CreateRectRgn(0, 0, 0, 0)

For Y = 1 To Hgt 逐行扫描
X = 0
Do
X = X + 1

While (bmByte(X, Y) = transColor) And (X < Wid)
X = X + 1 跳过是透明色的点
Wend
SPos = X
While (bmByte(X, Y) <> transColor) And (X < Wid)
X = X + 1 跳过不是透明色的点
Wend
EPos = X - 1

'这一段是合并区域
If SPos <= EPos Then
Rgn2 = CreateRectRgn(SPos - 1, Y - 1, EPos, Y)
CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
DeleteObject Rgn2
End If
Loop Until X >= Wid
Next Y

SetWindowRgn hForm.hwnd, Rgn1, True 设定窗体形状区域
DeleteObject Rgn1

End Sub

Form1

Private Sub Form_Load()

Form1.Left = Screen.Width / 2 - Form1.Width / 2
Form1.Top = Screen.Height / 2 - Form1.Height / 2

If Me.Picture <> 0 Then Call SetAutoRgn(Me)

End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
移动窗体
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&

End If
End Sub

用API制作图形窗体

[ 1 ]
用API制作图形窗体 num

打印本页 关闭

关于我们版权声明本站导航友情连结作品演示 TOP↑