用到的API如下:GetPixel,SetWindowRgn,CreateRectRgn,CombineRgn,DeleteObject
哪位热心的高手有时间的话请帮我解释下for循环,或重点解释下几个API在本例中的作用,我看得好晕!
代码如下:
只用到一个picture控件
Private Sub Form_Load()
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
Picture1.Picture = LoadPicture("f:\u.jpg")
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 '设置窗体区域
End Sub
哪位热心的高手有时间的话请帮我解释下for循环,或重点解释下几个API在本例中的作用,我看得好晕!
代码如下:
只用到一个picture控件
Private Sub Form_Load()
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
Picture1.Picture = LoadPicture("f:\u.jpg")
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 '设置窗体区域
End Sub
才两层循环，算个P啊
同意。要是LZ连这样的代码看着都晕的话，建议：
1. 三思，自己学编程时到底下了多少功夫。
2. 考虑，自己还要不要继续学编程了。
Do Until rs_旧表资料.EOF
var_目前进度 = var_目前进度 + 1
pbar1.Value = Int(var_目前进度 / var_总进度 * 100)
lbl总进度.Caption = "已完成 " & Int(var_目前进度 / var_总进度 * 100) & "%"
lbl总进度.Refresh
pbar1.Refresh
If rs_旧表资料("TABLE_TYPE") = "TABLE" Then
table_name = Trim(rs_旧表资料("TABLE_NAME"))
Do Until rs_新表资料.EOF
If rs_新表资料("TABLE_TYPE") = "TABLE" And Trim(rs_新表资料("TABLE_NAME")) = table_name Then
lbl总进度项.Caption = "资料表 " & rs_新表资料("TABLE_NAME")
txt = txt & vbCrLf & vbCrLf & "正在转文件 " & rs_新表资料("TABLE_NAME") & "..."
txt.SelStart = Len(txt.Text)
txt.SelLength = 1
lbl总进度项.Refresh
'Frm转档.Refresh
'如果找到有相同的表则开始转档
'///////////////从这里开始转档代码//////////////////////////
'首先要删除新表所有的资料
sql = "delete * from [" & table_name & "]"
conn_新连接.Execute sql
sql = "select * from [" & table_name & "]"
rs_新资料.Open sql, conn_新连接, 1, 3
rs_旧资料.Open sql, conn_旧连接, 1, 3
var_分进度 = rs_旧资料.RecordCount
If var_分进度 = 0 Then
var_分进度 = 1
End If
pbar2.Max = 100
pbar2.Min = 0
var_目前分进度 = 0
For var_j = 1 To rs_旧资料.RecordCount
var_目前分进度 = var_目前分进度 + 1
pbar2.Value = Int(var_目前分进度 / var_分进度 * 100)
lbl分进度.Caption = "已完成 " & Str(Int(var_目前分进度 / var_分进度 * 100)) & "%"
'Frm转档.Refresh
pbar2.Refresh
lbl分进度.Refresh
If Len(txt.Text) > 1000 Then
txt.Text = Right(txt, Len(txt.Text) - 500)
End If
txt = txt & vbCrLf & "正在处理: " & rs_旧资料.Fields(0).Name & "－" & rs_旧资料.Fields(0).Value
txt.SelStart = Len(txt.Text)
txt.SelLength = 1
rs_新资料.AddNew
update_flag = False '有这个变量来判断是否表向新表中添加了记录
For var_k = 0 To rs_旧资料.Fields.Count - 1
fields_name = Trim(rs_旧资料.Fields(var_k).Name) '取得所有字段名
For var_l = 0 To rs_新资料.Fields.Count - 1
If Trim(rs_新资料.Fields(var_l).Name) = fields_name Then
'如果在相同的表中找到有相同的字段则开始向新表添加记录
rs_新资料(fields_name) = rs_旧资料(fields_name)
update_flag = True '只要有一个字段更新了,则表明要执行update();
End If
Next var_l
Next var_k
If update_flag Then
rs_新资料.Update
Else
rs_新资料.CancelUpdate
End If
rs_旧资料.MoveNext
Next var_j
rs_新资料.Close
rs_旧资料.Close
End If
rs_新表资料.MoveNext
Loop
rs_新表资料.MoveFirst
End If
rs_旧表资料.MoveNext
Loop
我一看API 就晕……
楼主提供的代码大致要实现的功能是：根据图片像素来镂空窗体，像素与（0，0）点相同的保留，其它镂空掉，即产生一个异形窗体.
至于API的功能，可以打诸入apiGuide之类软件来学习研究，msdn也有帮助。
我会再接再厉!!!!!!!!!11
'遇到错误,则忽略
On Error Resume Next
'获取自身路径
If Right$(App.Path, 1) <> "\" Then
SelfFilePath = App.Path & "\"
Else
SelfFilePath = App.Path
End If
'效验文件
If FileExists(ConfigFile) = False Then
ConfigFile = SelfFilePath & ConfigFile
If FileExists(ConfigFile) = False Then
Call MsgBox("配置文件未找到!", 16, "实时错误!")
Exit Sub
End If
End If
SysConfigFile = ConfigFile
'全局变量赋值
MainHwnd = hWnd'重写系统菜单,去除系统菜单图标
Dim mSystemMenuHwnd As Long
'获取系统菜单句柄
mSystemMenuHwnd = GetSystemMenu(MainHwnd, False)
If mSystemMenuHwnd = 0 Then
MsgBox "错误!试图获取系统菜单句柄时错误,可能此窗体无系统菜单!"
End
End If'获取系统菜单总数
mSysTotal = GetMenuItemCount(mSystemMenuHwnd)
If mSysTotal = -1 Then
Call MsgBox("错误!试图获取系统菜单总数时错误,可能此菜单总数小于1!", 16, "实时错误!")
End
End If'重定义数组维数
ReDim Preserve mSysM(mSysTotal) As MenuData
'获取系统菜单ID
Dim TemI As Long, TempStr As String * 128, TempCheck As LongTempStr = String(128, Chr$(0))For TemI = 0 To mSysTotal - 1 Step 1
With mSysM(TemI)
.mHwnd = GetMenuItemID(mSystemMenuHwnd, TemI)
If .mHwnd = -1 Then
Call MsgBox("错误!试图获取系统菜单中位于第" & TemI & "级ID时出错,可能此菜单无ID!", 16, "实时错误!")
End
End If
If .mHwnd = 0 Then .mString = "%Line%"
If .mHwnd <> -1 And .mHwnd <> 0 Then
'获取菜单各ID处字符串
TempCheck = GetMenuString(mSystemMenuHwnd, .mHwnd, TempStr, 128, &H0&) 'MF_BYCOMMAND 方式
If TempCheck = 0 Then
Call MsgBox("错误!试图获取系统菜单中位于第" & TemI & "级ID的字符串时出错,可能此级ID无字符串!", 16, "实时错误")
End
End If
.mString = Left$(TempStr, lstrlen(TempStr) - 1)
End If
End With
Next TemIFor TemI = mSysTotal - 1 To 0 Step -1
'移除菜单
TempCheck = RemoveMenu(mSystemMenuHwnd, TemI, &H400&) 'MF_BYPOSITION 方式
If TempCheck = 0 Then
Call MsgBox("试图移除系统菜单中位于第" & TemI & "级时出错,未知错误!", 16, "实时错误!")
End
End If
Next TemI Dim TemJ As Long, TemK As Long, TemStr As String, Hstr As DbStr, HstrA As DbStr, HstrB As DbStr
Dim SubStep As Long, GrandStep As Long
'添加系统菜单项
TemJ = Val(ReadString("System", "Total", SysConfigFile))
For TemK = 1 To Val(TemJ)
'系统菜单总数累加
mSysTotal = mSysTotal + 1
'改变数组大小
ReDim Preserve mSysM(mSysTotal) As MenuData
TemStr = ReadString("System", Right$("000" & TemK, 3), SysConfigFile)
mSysM(mSysTotal - 1).mString = TemStr
mSysM(mSysTotal - 1).mHwnd = CreatePopupMenu()
Next TemKFor TemI = 0 To mSysTotal - 1 Step 1
'增加/重写系统菜单
With mSysM(TemI)
If .mString <> "%Line%" Then
TempCheck = AppendMenu(mSystemMenuHwnd, &H0&, .mHwnd, .mString)
If TempCheck = 0 Then
Call MsgBox("错误!试图重建系统菜单中位于第" & TemI & "级ID的菜单时出错,未知错误!", 16, "实时错误!")
End
End If
Else
TempCheck = AppendMenu(mSystemMenuHwnd, &H800&, .mHwnd, ByVal 0&)
If TempCheck = 0 Then
Call MsgBox("错误!试图重建系统菜单中位于第" & TemI & "级ID的分隔线时出错,未知错误!", 16, "实时错误!")
End
End If
End If
End With
Next TemI
'创建弹出式菜单
mPopupMenuHwnd = CreatePopupMenu()
TemJ = Val(ReadString("Popup", "Total", SysConfigFile))
'弹出式菜单总数
mPopupTotal = TemJ
'改变数组大小
ReDim Preserve mPopM(mPopupTotal) As MenuData
For TemK = 1 To Val(TemJ)
TemStr = ReadString("Popup", Right$("000" & TemK, 3), SysConfigFile)
With mPopM(TemK)
.mString = TemStr
If .mString = "%Line%" Then
Call AppendMenu(mPopupMenuHwnd, MF_SEPARATOR, ByVal 0&, ByVal 0&)
Else
.mHwnd = CreateMenu()
'如果还有下级菜单,则还需要加上MF_POPUP样式
Call AppendMenu(mPopupMenuHwnd, MF_STRING, .mHwnd, .mString)
End If
End With
Next TemK
'创建窗体菜单
hFormMenu = CreateMenu()
'获取根菜单总数
mRootTotal = Val(ReadString("Root", "Total", SysConfigFile))
'改变数组大小
ReDim Preserve mRoot(mRootTotal) As MenuData
For TemI = 1 To mRootTotal
'获取菜单字串
TemStr = ReadString("Root", Right$("000" & TemI, 3), SysConfigFile)
'过滤字串
Hstr = FiltrateStr(TemStr)
mRoot(TemI).mString = Hstr.dStrA
'根菜单不允许分隔线
If mRoot(TemI).mString = "%Line%" Then
Call MsgBox("错误:根菜单不允许使用分隔线!", 16, "实时错误!")
End
Else
If mRoot(TemI).mString = "" Then
Call MsgBox("错误:菜单项不允许空字符串!", 16, "实时错误!")
End
End If
'创建菜单
mRoot(TemI).mHwnd = CreatePopupMenu()
Call AppendMenu(hFormMenu, MF_STRING Or MF_POPUP, mRoot(TemI).mHwnd, mRoot(TemI).mString)
End If
Dim SubMenuMem As Long
For TemJ = 1 To Val(Hstr.dStrB)
'总数累加
mTotal = mTotal + 1
'记录此级子菜单Index,以便下级菜单调用
SubMenuMem = mTotal
ReDim Preserve mMenu(mTotal) As MenuData
'子菜单加一
SubStep = SubStep + 1
TemStr = ReadString("Sub", Right$("000" & SubStep, 3), SysConfigFile)
'过滤字串
HstrA = FiltrateStr(TemStr)
mMenu(mTotal).mString = HstrA.dStrA
'过滤分隔线
If mMenu(mTotal).mString = "%Line%" Then
Call AppendMenu(mRoot(TemI).mHwnd, MF_SEPARATOR, ByVal 0&, ByVal 0&)
Else
'创建子菜单
mMenu(mTotal).mHwnd = CreatePopupMenu()
If Val(HstrA.dStrB) = 0 Then
'此级菜单无子级
Call AppendMenu(mRoot(TemI).mHwnd, MF_STRING, mMenu(mTotal).mHwnd, mMenu(mTotal).mString)
Else
'此级菜单还有子级
Call AppendMenu(mRoot(TemI).mHwnd, MF_STRING Or MF_POPUP, mMenu(mTotal).mHwnd, mMenu(mTotal).mString)
End If
End If
For TemK = 1 To Val(HstrA.dStrB)
'总数累加
mTotal = mTotal + 1
ReDim Preserve mMenu(mTotal) As MenuData
'孙菜单加一
GrandStep = GrandStep + 1
'获取字串
TemStr = ReadString("Grand", Right$("000" & GrandStep, 3), SysConfigFile)
'过滤字串
HstrB = FiltrateStr(TemStr)
mMenu(mTotal).mString = HstrB.dStrA
'过滤分隔线
If mMenu(mTotal).mString = "%Line%" Then
Call AppendMenu(mMenu(SubMenuMem).mHwnd, MF_SEPARATOR, ByVal 0&, ByVal 0&)
Else
'创建孙菜单
mMenu(mTotal).mHwnd = CreatePopupMenu()
Call AppendMenu(mMenu(SubMenuMem).mHwnd, MF_STRING, mMenu(mTotal).mHwnd, mMenu(mTotal).mString)
End If
Next TemK
Next TemJ
Next TemI
lpPrevWndProc = SetWindowLong(MainHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
主循环两重,分别按照图片的高和宽扫描像素,然后根据条件判断操作.
遇到这样的东西,可以把内部的循环体写成一个函数,然后在循环中调用,这样就简单多了:Private Sub Form_Load()
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
Picture1.Picture = LoadPicture("f:\u.jpg")
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
DoSth '写成这样有利于分析程序
Next
Next
Region = Fullr
SetWindowRgn Me.hWnd, Region, True '设置窗体区域
End Subprivate sub DoSth()
If GetPixel(hDC, I, j) = myColor Or I = PicWidth Then
...
...
End If
end sub这样写就比较清晰了,但是程序的性能会下降很多,可以在分析调试完毕后将SUB中的内容再贴回去.
通过两个循环扫描透明象素
crn = CreateRectRgn(linex, j, I, j - 1) '创建两个象素矩形区域
CombineRgn Fullr, Fullr, crn, RGN_OR '合并区域 合并成透明边界
SetWindowRgn Me.hWnd, Region, True '设置异型窗体区域
tRec(J) = CStr(B)
End Select
End If 'Is Skip
Next 'For V ItType
If IsSkip = False Then
For V = 1 To V1 'RecExTT
With uRecEx(V)
J = CoKey(CStr(.ID))
If J > 0 Then
Select Case .DtType
Case EnMDC.VtDate
tRec(J) = .Dat(K)
Case EnMDC.VtLong
If .lng(K) Then
tRec(J) = .lng(K)
End If
End Select
End If
End With
Next 'For V RecEx
End If 'Skip
Next 'For K
End Select 'ObjItem
Next
FRct.CursorLocation = adUseClient
If Not Wcn.State = 1 Then Wcn.ConnectionString = CnStr: Wcn.Open
FRct.Open sql, Wcn, adOpenStatic, adLockPessimistic
Set FRct.ActiveConnection = Nothing
If Not FRct.RecordCount <= 0 Then
For i = 0 To FRct.RecordCount - 1
strItemT = strItemT & ".1" & "<->" & FRct("pst_detitem") & "<->" & FRct("pst_noff") & "<->" & FRct("pst_noffuom") & "<->" & FRct("pst_wastepc") & "<->" & FRct("pst_lineno") & "<->" & FRct("pst_lui") & "<->" & FRct("pst_lud") & "<->" & FRct("pst_eres") & "<->" & ","
'查询一级子信息
SSql = "select pst_paritem,pst_detitem,pst_noff,pst_noffuom,pst_wastepc,pst_lineno,pst_lui,pst_lud,pst_eres from maxmast.pst where pst_paritem='" & Trim(FRct("pst_detitem")) & "' order by pst_lineno"
SRct1.Open SSql, Wcn, adOpenStatic, adLockReadOnly
If SRct1.RecordCount > 0 Then
For j = 0 To SRct1.RecordCount - 1
strItemT = strItemT & "..2" & "<->" & SRct1("pst_detitem") & "<->" & SRct1("pst_noff") & "<->" & SRct1("pst_noffuom") & "<->" & SRct1("pst_wastepc") & "<->" & SRct1("pst_lineno") & "<->" & SRct1("pst_lui") & "<->" & SRct1("pst_lud") & "<->" & SRct1("pst_eres") & "<->" & ","
'查询二级子信息
SSql = "select pst_paritem,pst_detitem,pst_noff,pst_noffuom,pst_wastepc,pst_lineno,pst_lui,pst_lud,pst_eres from maxmast.pst where pst_paritem='" & Trim(SRct1("pst_detitem")) & "' order by pst_lineno"
SRct2.Open SSql, Wcn, adOpenStatic, adLockReadOnly
If SRct2.RecordCount > 0 Then
For k = 0 To SRct2.RecordCount - 1
strItemT = strItemT & "...3" & "<->" & SRct2("pst_detitem") & "<->" & SRct2("pst_noff") & "<->" & SRct2("pst_noffuom") & "<->" & SRct2("pst_wastepc") & "<->" & SRct2("pst_lineno") & "<->" & SRct2("pst_lui") & "<->" & SRct2("pst_lud") & "<->" & SRct2("pst_eres") & "<->" & ","
'查询三级子信息
SSql = "select pst_paritem,pst_detitem,pst_noff,pst_noffuom,pst_wastepc,pst_lineno,pst_lui,pst_lud,pst_eres from maxmast.pst where pst_paritem='" & Trim(SRct2("pst_detitem")) & "' order by pst_lineno"
SRct3.Open SSql, Wcn, adOpenStatic, adLockReadOnly
If SRct3.RecordCount > 0 Then
For l = 0 To SRct3.RecordCount - 1
strItemT = strItemT & "....4" & "<->" & SRct3("pst_detitem") & "<->" & SRct3("pst_noff") & "<->" & SRct3("pst_noffuom") & "<->" & SRct3("pst_wastepc") & "<->" & SRct3("pst_lineno") & "<->" & SRct3("pst_lui") & "<->" & SRct3("pst_lud") & "<->" & SRct3("pst_eres") & "<->" & ","
'查询四级子信息
SSql = "select pst_paritem,pst_detitem,pst_noff,pst_noffuom,pst_wastepc,pst_lineno,pst_lui,pst_lud,pst_eres from maxmast.pst where pst_paritem='" & Trim(SRct3("pst_detitem")) & "' order by pst_lineno"
SRct4.Open SSql, Wcn, adOpenStatic, adLockReadOnly
If SRct4.RecordCount > 0 Then
For m = 0 To SRct4.RecordCount - 1
strItemT = strItemT & ".....5" & "<->" & SRct4("pst_detitem") & "<->" & SRct4("pst_noff") & "<->" & SRct4("pst_noffuom") & "<->" & SRct4("pst_wastepc") & "<->" & SRct4("pst_lineno") & "<->" & SRct4("pst_lui") & "<->" & SRct4("pst_lud") & "<->" & SRct4("pst_eres") & "<->" & ","
'查询五级子信息
SSql = "select pst_paritem,pst_detitem,pst_noff,pst_noffuom,pst_wastepc,pst_lineno,pst_lui,pst_lud,pst_eres from maxmast.pst where pst_paritem='" & Trim(SRct4("pst_detitem")) & "' order by pst_lineno"
SRct5.Open SSql, Wcn, adOpenStatic, adLockReadOnly
If SRct5.RecordCount > 0 Then
For n = 0 To SRct5.RecordCount - 1
strItemT = strItemT & "......6" & "<->" & SRct5("pst_detitem") & "<->" & SRct5("pst_noff") & "<->" & SRct5("pst_noffuom") & "<->" & SRct5("pst_wastepc") & "<->" & SRct5("pst_lineno") & "<->" & SRct5("pst_lui") & "<->" & SRct5("pst_lud") & "<->" & SRct5("pst_eres") & "<->" & ","
'查询六级子信息
SSql = "select pst_paritem,pst_detitem,pst_noff,pst_noffuom,pst_wastepc,pst_lineno,pst_lui,pst_lud,pst_eres from maxmast.pst where pst_paritem='" & Trim(SRct5("pst_detitem")) & "' order by pst_lineno"
SRct6.Open SSql, Wcn, adOpenStatic, adLockReadOnly
If SRct6.RecordCount > 0 Then
For s = 0 To SRct6.RecordCount - 1
strItemT = strItemT & ".......7" & "<->" & SRct6("pst_detitem") & "<->" & SRct6("pst_noff") & "<->" & SRct6("pst_noffuom") & "<->" & SRct6("pst_wastepc") & "<->" & SRct6("pst_lineno") & "<->" & SRct6("pst_lui") & "<->" & SRct6("pst_lud") & "<->" & SRct6("pst_eres") & "<->" & ","
SRct6.MoveNext
Next
End If
SRct6.Close
Set SRct6 = Nothing
SRct5.MoveNext
Next
End If
SRct5.Close
Set SRct5 = Nothing
SRct4.MoveNext
Next
End If
SRct4.Close
Set SRct4 = Nothing
SRct3.MoveNext
Next
End If
SRct3.Close
Set SRct3 = Nothing
SRct2.MoveNext
Next
End If
SRct2.Close
Set SRct2 = Nothing
SRct1.MoveNext
Next
End If
SRct1.Close
Set SRct1 = Nothing
FRct.MoveNext
Next
Else
Exit Function
MsgBox "此物料无子物料，请查看！", vbOKOnly, "系统错误！"
End If
楼主提供的代码大致要实现的功能是：根据图片像素来镂空窗体，像素与（0，0）点相同的保留，其它镂空掉，即产生一个异形窗体.不过看你们在比谁的代码复杂觉得有点 x.x.x.x.....
同意 sunskyfeng(雨后森林)和我一直在寻找() 的观点，代码要为易维护考虑，不是越复杂越牛，代码是越精炼越牛。
那个函数地址、那个进程插入、那个修改vTable表。
这算是入门？？？