屏蔽键盘的键(如 Win、Ctrl),使用底层键盘钩子(Hook)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
'从网上找来的,原文……大家不要费脑筋去读了,因为把它整理成 VB 懂的格式费了我20分钟。
'可以屏蔽一切你想要屏蔽的键……当然代码要输入完全,否则……

'模块代码(mMain.bas)

Option Explicit

Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type

Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const VK_LWIN = &H5B
Private Const VK_RWIN = &H5C
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13
Private Const VK_CONTROL = &H11
Private Const VK_ESCAPE = &H1B
Private Const VK_MENU = &H12
Private Const VK_TAB = &H9
Private Const VK_Delete = &H2E

Private lngHook As Long

'使用底层KeyboardHook阻拦按键消息
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim blnHook As Boolean
Dim p As PKBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP
Call CopyMemory(p,ByVal lParam,Len(p))
If p.vkCode = VK_LWIN Or p.vkCode = VK_RWIN Then blnHook = True '按下了左/右Win键
If p.vkCode = VK_CONTROL Or p.vkCode = VK_ESCAPE Then blnHook = True '按下了Ctrl Esc键,如不需屏蔽可注释这句
If p.vkCode = VK_MENU Or p.vkCode = VK_TAB Then blnHook = True '按下了Alt Tab键,如不需屏蔽可注释这句
Case Else '不做
End Select
End If
If blnHook Then
LowLevelKeyboardProc = 1
Else
Call CallNextHookEx(WH_KEYBOARD_LL,nCode,wParam,lParam)
End If
End Function

Public Sub HooK()
lngHook=SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
End Sub

Public Sub UnHooK()
Call UnhookWindowsHookEx(lngHook)
End Sub

'窗体代码(fMain.frm)

Private Sub Form_Load()
Call HooK '屏蔽Win键
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHooK '取消屏蔽Win键
End Sub
分享到 评论

从 PE 文件或图标里获取并绘制大尺寸的图标(大于 32×32)

最近在创作一个类似 Windows 资源管理器的程序。有几个难关:动态加载图标与 ListView 的结合、获取文件详细信息(三个时间、大小[不是用 FileLen,所以可以支持 Double 级别的大小]、类型和图标)、弹出标准资源管理器菜单、获取超过 32×32 的图标。

其中只剩下最后这个没有攻破。今天在 Google 上查找,终于找到了突破口!感谢第一个发现这个函数的网友。

或许你会问:不是有 ExtractIcon 和 ExtractIconEx 吗?为什么费尽心思来找这个?这是由于 ExtractIcon 和 ExtractIconEx 只能提取 16×16、32×32 的图标,对于 Windows XP 的 48×48 图标已经无能为力,更别说 Windows Vista 的 256×256 的图标了。所以这个函数是专门用来提取大图标和不规则图标的(如 Windows Vista 的 ImageRes.dll 中第一个图标,大小是 40×40)。

现在附代码如下,可以不用 LoadIcon 直接获得 PE 文件或图标中的指定大小的图标。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Option Explicit

Private Declare Function PrivateExtractIcons Lib "user32" _
Alias "PrivateExtractIconsA" (ByVal sFile As String, ByVal nIconIndex As Long, _
ByVal cxIcon As Long, ByVal cyIcon As Long, ByVal phicon As Long, piconid As Long, _
ByVal nIcons As Long, ByVal flags As Long) As Long

'精华!这个函数一般是找不到的!有了这个,不用使用 LoadIcon、ExtractIcon、ExtractIconEx 了
Public Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long

Public Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type

Public Const DI_NORMAL = &H3&
Public Const LR_DEFAULTCOLOR = &H0&
Public Const LR_DEFAULTSIZE = &H40

'封装之后的函数
Public Sub DrawIconToDC(ByVal PE_Icon As String, ByVal IconIndex As Long, ByVal hDC As Long, cX As Long, cY As Long, X As Long, Y As Long)
'PE_Icon 是 PE 文件(*.exe;*.dll;*.ocx;*.vxd;*.cpl 等等)或图标文件的文件名
'IconIndex 是图标的索引,以绝对值为准(如 0=0,-1=1)
'hDC 是目标 DC(Device Context,设备上下文)。可以使用 GetDC(hWindow) 获取一个窗口的 DC。
'cX 是欲加载的图标宽度
'cY 是欲加载的图标高度
'X 是绘制在目标上的 X 坐标(模式由 hDC 所指的设备所决定)
'Y 是绘制在目标上的 Y 坐标‍(模式由 hDC 所指的设备所决定)
Dim lRet As Long
Dim phicon As Long
Dim picon As Long
'Dim cX As Long '欲加载的图标宽度
'Dim cY As Long '欲加载的图标高度
'Windows 会自动根据 cX 和 cY 的值决定加载哪个图标(若有多种格式)
'如,存在 48×48、32×32 图标时,cX=36, cY=32 将加载 48×48 的图标,
'并按照 36×32 的大小输出

'MsgBox PrivateExtractIcons("C:\Windows\System32\imageres.dll", -1, 0, 0, 0, picon, 1, 0)
lRet = PrivateExtractIcons(PE_Icon, 2, cX, cY, VarPtr(phicon), picon, 1, LR_DEFAULTCOLOR) 'Or LR_DEFAULTSIZE)
'MsgBox "Return val:" & lRet, vbInformation
'Dim pII As ICONINFO
'GetIconInfo phicon, pII
DrawIconEx Me.hDC, X, Y, phicon, 0, 0, 0, 0, DI_NORMAL
'Print "cX:" & pII.xHotspot * 2 & vbCrLf & "cY:" & pII.yHotspot * 2
'MsgBox picon
'必须销毁图标,因为 Windows 不会帮你
DestroyIcon phicon
End Sub

使用方法:

1
Call DrawIconToDC("C:\Windows\System32\cmd.exe", 0, Picture1.hDC, 48, 48, 0, 0)
分享到 评论

Google 翻译——杰作啊

为什么这么说呢?在 Google 翻译中输入“字母+-men”的字符串,就会出来有趣的东西……下面是详细的列表,原文复制。

A-men 阿战警
B-men 乙战警
BF-men 高炉战警
C-men 的C -男子
D-men ð战警
E-men 电子人
F-men 架F -男子
G-men 的G -男子
H-men H型男人
I-men 本人战警
J-men 日本男人
K-men 钾男人
L-men L型的男子
M-men 的M -男子
N-men 的N -男子
O-men O型男人
P-men 的P -男子
Q-men 调Q男人
R-men 的R -男子
S-men 的S -男人
T-men T型男人
U-men U型男人
V-men V型男人
W-men 钨男人
X-men X战警
Y-men Y型男人
Z-men Z型男人

a-men 一战警
b-men β-人
c-men 的C -男子
d-men ð战警
e-men 电子人
f-men 架F -男子
g-men 克战警
h-men H型男人
i-men 我战警
j-men 日本男人
k-men k个男人
l-men 升战警
m-men 米战警
n-men 欧米茄男士
o-men O型男人
p-men p型男人
q-men 调Q男人
r-men 的r -男子
s-men 的S -男人
t-men T型男人
u-men U型男人
v-men V型男人
w-men 瓦特战警
x-men X战警
y-men Y型男人
z-men Z型男人

分享到 评论

附中趣事志补(2)

要知道这篇文章我是没有备份的。原因是……看下面就知道了。

用佘氏

看出来了么?HL2+用佘氏!至于后面这个,因为涉及到个人隐私,不透露。

No name

分享到 评论

附中趣事志补(1)

之后的修改都将以“补”的形式出现。

本次增加内容(2010/9/23):

外号那一块,我忘记说第4种了。这就是“bish”。这个是怎么来的?嗯,一位同学姓Q,好事者使用了近音词Qbish来称呼(发音而已)。本义是……将手指一次放进一个双门的洞里面的动作。然后 bish 又泛滥了,什么 Dabish、Xiaobish,等等,漫天飞舞……

老师也有失言的时候。

美术老师(特级的……):“嗯。是大卫吗?呵呵呵,是大卫。”请注意“呵呵呵”三个字无法描述当时他的表情、动作和语气……准确,但是不雅地说,像傻子。

语文老师:“助敌杀夫。”在讲《芦花荡》的时候……老师“助敌杀夫”了。

历史老师:“然后,他 Shǐ 了。”怎么个 Shǐ 法?想不通。

一位同学的外号演变很有趣。有两个分支。宿舍外,由于名字是 CRF,所以就成了“臭**”。宿舍内,生活习惯问题,从“大臭鞋”到“大肉(鞋?蟹?)”再到……“大闸蟹”。自己试着把这12个字都用阴平读出来……之后此人与舍友讨论“乳猪”,辨析“乳”字在此处的用法。不可否认的是,此人文采出众,而且很要强。最后说“乳”字乃“小”之意的时候,来了一句很经典的话:“‘小’,那么这宿舍怎么说?‘乳房’?”结果之后这位和讨论对象就很喜欢用“乳”字互称。对象名“Ge”,所以会听到这样的话:“我每天上学经过一条乳沟”、“我很喜欢吃大乳鸽”……然后“战火燃起”,“大乳鸽”、“大闸蟹”混响……化学组插嘴:事实上应该命名为 CrF3(三氟化铬)更合适……“大肉鸽”,化学组老二,话说这个“肉鸽”名号就是大闸蟹取的……

Peter 语录:

“I wrong.”(我错了)

“哎呀,我 play egg 了。”(完蛋)

“哇,无敌越也用佘氏!”

“Go you!”(去你的)

“请问能不能借{物品}啊?”(经常这么说!)

分享到 评论

附中各种有趣的事情(2)

回到正题。之后还有一些事情发生。这是一件与DBQ、FBQ 和另外一个下文也会提及的同学(老贼)有关的事情。我们对行为 X 的音效有特定的称呼:“Ash”或者“Ush”,这两个词也是DBQ的最爱……见到人就“Ush”一下。“Ash”这个词就是“灰烬”的意思,所以有人总是说“灰灰”,就代表“Ash ash”……“Ush”这个词不是一个正规的词,它只有一种形式“Usher”,意思是“剧院领座员”。其实这个词不是“Ush”的名词形式吗,而“Ush”是……所以,“Usher”在这里就有了“***”的意思。想想,还有一个说唱歌手(亚瑟小子),也就是“Usher”了,囍。某一天老贼被 FBQ 叫起来回答“将来想要做什么”,结果老贼在 DBQ 的怂恿之下回答了“Usher”!全班笑翻。FBQ 自然不知道这里面的缘故(而且根据下文,词汇量……),问老贼:“这是什么?”老贼一本正经地回答:“剧院领座员。”全班再次笑翻。FBQ 还很高兴,说:“没想到我们班的同学还有这种志向!”她还没有,也不会提及我们在她的电脑上新建了一个名为“FBQ”的隐藏账户了。

我们还有一些“有趣的”规则。其中,φ(大写形式为Φ,音 phi)也是一个很好的代表物。这就像一串冰糖葫芦,被一根木条穿过……就像……(文字已隐藏),所以一只手大拇指和食指围成一个圈,另一只手的食指穿过就有了 X 意思。说实话,根据一篇文章,这个手势威尼斯人都认得;若是中国人就表示找市中心,若是非中国人就表示找红灯区。不知道这以后会不会延伸,让红灯区也挂上这个恶名呢。一般人做这个手势的时候,另外三根手指都会直立,看起来就像是“OK”一样。结果我最近做了一次,让另外一些同学猜是什么意思。结果他们想了想,说“臭氧”(O3)!确实是“O3”啊……我无语了。O3(这里没有打错!)是一个同学的外号,他的名字以 Yang 字结尾,根据我们这些“科学性”的人一想,就成了“臭 Yang”,然后就是“臭氧”……

我们班有一个强人,此人从初中就开始显现实力。我们有普遍的圣人崇拜倾向,所以就送外号曰“无敌 Y”或“LY 无敌”。到了高一,新加入的同学在最短的时间内认同了这一点,结果“LY 无敌”就被“选”为“班级口号”。因此又延伸出一些“无敌”、“大师”、马斯特(Master):“HS 无敌”、“K 大师”(2个)、“马斯特 M”……只要有一次“成名”的机会,很可能就会被“封为”“马斯特”。高一时全校运动会上,我们差点就要选“高一*班 LY 无敌”作为口号了……只不过老师“从中作梗”,班长也比较严肃地支持“正常的”口号,所以最后还是用了一个差得多的口号。

我们这里还有贼,就是“老贼”。之所以得到这个别称,是“坊间流传”老贼在初三的时候“偷学校的化学药品”以中饱私囊。注意,此流言没有经过证实,但是根据老贼的药品储量和质量好像真的应该这么说……得到这个别名之后,我们碰到一些问题,比如,课室的门锁了而课室管理员还没有来的时候,就会说“让老贼进去,反正他很有经验”。

我们的话题都是高度地专业化的。比如今天(2010年9月3日)我们班就出现了了新的“X 话题”。起因不清楚了,估计是 LYY 和 HS 的“讨论”吧,反正我从生化楼回来做题,刚好赶上开始说“括约肌”。我当然知道括约肌是什么,当然是……很恶心(Words are harmonized)。然后又听到了“海绵体”……^$*#^$,开始了。然后在场的人就“兴致勃勃”地讨论起“海绵体大战括约肌”来(事实上一开始前面三个字我没听清,之后求讲解才知道的)。然后,我们班的精英们(留下来搞卫生)就不断地大声地讲这两个东西……当然,这里有人去过生物竞赛培训,所以……更专业了……其间夹杂着“Dane”(广州话,发音不好打,用发音相近的英文词语代替)的声音,但是没有人停下来……&*$&*%(^,看来他们很喜欢这个话题啊……真是“数理化组大混战”,特别是 HS 回敬 LYY 的“你是想大战括约肌还是大战海绵体”……连 X 话题都这么专业。

还有一些化学组内部的情况。有一个 SL(Salty Lake),他得到这个外号是因为“遗传”。当 HS 想要戏弄的时候就会说“咸死啦”或者“湖哥”。当然,不知道为什么他也摊上了原级长(高一时的)的外号“HIA”;原级长得到这个是因为他讲话的时候会说“……嗯,HIA”(这个嘛,HIA 只是发音的拼写,或者写成这样,更清晰:[‘hia])。但是这个是怎么来的,我也不清楚。我们见到他也喊“HIA”,一段时间之后他又得到了“局长”的外号,原因是这个:“Huafu Intelligence Agency”(对比 CIA,Central Intelligence Agency),缩写还是“HIA”……还有一个“丙酮酸”,这个是根据生物必修一的“葡萄糖的分解”得来的。丙酮酸包括3个基团,甲基、酮基(羰基)和羧基。甲基嘛,是因为“芨芨草”;“酮基”,是一位同学名字结尾时“Tong”;“羧基”,是因为一位同学自认“酸腐”,而羧基因为氧对电子的吸引使氢容易电离,显酸性。这三个人的大体思想特征倒是挺统一的。内行人士都知道,“该该该不该改改该该该改的错误呢”是什么意思……都是“gai”(10个),创纪录了……因为对象本人要求,这里就不公开了。还有一位“犀利哥”,这是公认实力强劲的一个同学,被封“犀利”(广州话,强)。关于一位被称为“洞”的同学,那是因为在高一开学的时候有个人故意叫错名字,结果后来竟然变成了全班公认的外号了……

华附真是一个有趣的地方,充满了欢乐(囍),不过还是需要技术的,连玩笑都需要高技术……没有高技术的人就会被淘汰。

PS:请不要对这篇文章做非法评论,否则会被放进黑名单。特别适用于同班者。

PPS:I am not headcrabbed. (No spelling mistakes here.)

PPPS:The cake is great. – GLaDOS, from the game Portal series

PPPPS:Thanks for your visit at the MIC Studio, which is leaded by the Black Mesa Research Facilities.

PPPPPS:这里的“附中”指的是华师附中,其他什么乱七八糟的,滚蛋。

PPPPPPS:本文所用到的所有人物名称都是简写,禁止对这篇文章所提到的人物进行人肉搜索,这是不道德的!

MIC

分享到 评论

附中各种有趣的事情(1)

附中,有着强大的凝聚力。下面就是一些有趣的事情。

先从初一军训说起。记得最深刻的就是两件事:一件是“洁厕精洗碗事件”,另一件是“高歌事件”。DL 同学一次洗碗,随手用了洗衣台上的一瓶清洁剂。当时,他还以为是普通的洗洁精,但是之后……有同学“严肃地”指出,那瓶东西是洁厕精!这件事在6个小时之内就传遍了全级,影响力持续了半个学期。另一位同学则在洗澡的时候在浴室大声唱歌,内容是什么我倒忘了,这种“野性的行为”倒是使他具有了一定的吸引力。

接下来就是混合部分,将会涉及各个方面的内容。

初中最有名的外号系列有四个,分别是“J 系列”、“Botch 系列”、“狗系列”和“D 系列”。

1、关于“J”,我们只知道当初有两个同学上学时走在一起,其中一个说了3个字……然后这3个字的结构发生了2次变化,最终简化成了一个字母——J。不久之后,“J”这个字母就出名了。很多人的名字都被改编成与“J”有关的。直到现在,都存在着“刘J”之类的绰号……只要是名字带有声母 j 或类似的声母的字,立刻就会被“J”所代替……如果没有,就会贴上一个。唉,人间地狱啊——“*子J”、“JJJ”(事实上是一位老师……),等等等等,“J”铺天盖地而来。刚好初二有个就有“林 JJ”……之后,由于“J”和“丁”十分相似,很多的又变成“丁”了,有如“PF丁”之类的绰号占据了半壁江山。不过很巧的是,PF 丁本人很喜欢“丁”这个字,初中时每次见到我都会说“第10个字母”(即 J)或者直接说“丁”,甚至对“红桃勾”很感兴趣。巧合吧……

2、Botch 这个词,在 Word 文档的自动检查下竟然没有红线(出错),一查结果是“因笨拙而弄坏”或者“笨拙的工作”的意思。不过这个词在我们的心目中就没有这么好运了,因为……读音……就是*$&$#!^@*(这个词 is harmonized)的翻版。所以,它特别适合我们这些高智商搞怪人士的青睐。我们班(2班)的“四大传声筒”之一的 YD,非常喜欢这个,当然 J 这个字母也不例外。他给几乎所有人的名(如果名字是两个字就是名字)后面加上“Botch”。此时涌现的是“Da Botch”、“Wei Botch”、“FD Botch”等等。后来可能他觉得这样不过瘾,在“Botch”后面又加了“断”、“没”、“痿”、“Gay”、“龟”以及其他很多种的字,此时这个后缀就得发三个音节的音了。不过 D 同学的例子很好玩,大家念一下“Da Botch”看看。然后再念“Double 7”,其中“7”按中文的读法。所以这位仁兄被赐予了“77”的别名。当然,根据这个词的来源,此人又被称作 DBQ。还有很好玩的地方就是,下文的“D 系列”与他也有关,他又成为了“Dum Da”、“Dog Da”、“Dum dum Da”……反正很多种,但是简写都是一堆的“D”!发展到最后,一个“DDDDD”就行了,或者美其名曰“地对地导弹”。一次下文的英语老师恰好说到“Seventy seven”的时候,全班爆笑……由于初二的英语老师“太过随和”,落得了一个“FBQ”的“美名”。当然这还是在这个同学的操纵下。

3、狗,说实话是一种有意思的动物,特别是有人会去学习它的作风的时候……此时,第一个吃螃蟹的人就被达同学叫做“狗”(“L 狗”,或许参考了 LG 吧)。之后在这个“宣传队”、“播种机”的宣传下,又有一批人成为了“狗”的牺牲品。如“C 狗”。不过说实话除了第一个真的有点像狗以外,其他的倒是不这么像。为什么呢?话说 LG 等众人(包括 CG、DD)都喜欢玩小球(也就是把网球当作足球踢),而 LG“很有钱”,经常买网球来踢,所以 DD 有几次就偷了 LG 的网球(5元)然后谎称“我捡到了一个”,又“恰巧”LG 的网球没了,所以 LG 就以30-40元的价钱买下了自己的网球……DD 净赚了卖出价……

4、D 系列,是指“Dog”、“Dum”和“Dum dum”。“Dog”其实就是“狗”的英文翻译,只要能称为“狗 X”的,也会被称为“Dog X”。至于“Dum dum”,是根据《博物馆奇妙夜》的“Dum dum, give me gum gum”而来的。结果“Dum”或者“Dum dum”迅速地流传,成为了伟大的前缀。如“Dum J”或“Dog J”、“DD”等等。

这里插一段题外话。先揭第二段的谜底吧,答案就是“boqi”。这个词与 iPod 倒是有联系,看这个:

ipod and boqi

这个是从一位网友的图片得到灵感的……不知乔布斯有没有想到这种“iPod 的‘中国情结’”……他的图片就是把一个 iPod 放到镜子前面……所以这个应该叫做镜像(Reflection),之所以要提英文是因为“镜像”还有一个意思就是“光盘镜像”,也称“光盘映像”,这个词的翻译就应该是“Image”了。这又让我想起了著名的“注意你的 P 和 Q”(Remind your Ps and Qs),意思是注意礼节,来源就是以前使用拉丁文的国家的排字工很可能会把“b”、“d”、“p”和“q”的字模搞错。

分享到 评论

拖动无标题栏的窗口

很多时候编程都需要拖动无标题栏的窗口,我不想每次都去查 API 浏览器和 MSDN,所以就把代码放到博客上。其实 Form(Form1)改为任何具有 hWnd 属性的控件都可以。

Option Explicit

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Dim Pt As POINTAPI
Private bM As Boolean, oldX As Long, oldY As Long

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
SetCapture Form1.hwnd
bM = True
GetCursorPos Pt
oldX = Pt.X
oldY = Pt.Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not bM Then Exit Sub
GetCursorPos Pt
Form1.Left = Form1.Left + (Pt.X - oldX) * Screen.TwipsPerPixelX
Form1.Top = Form1.Top + (Pt.Y - oldY) * Screen.TwipsPerPixelY
oldX = Pt.X
oldY = Pt.Y
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
bM = False
End Sub

这样就可以了。随意拖动没有标题栏的窗口。

但是,更好的方法是使用 SendMessage 发送 WM_NCLEFTBUTTONDOWN 消息,采用 HTCAPTION。

分享到 评论

小程序:模拟蓝屏

最近去了微软的网站,找到了这个:

http://technet.microsoft.com/en-us/sysinternals/bb897558.aspx

经典的蓝屏……比国内什么“神州蚂蚁”做的逼真多了。

分享到 评论

鼠标,别动!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit  
Private Const lBorder As Long = 4
Dim R As RECT

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Private Declare Function ClipCursorByNum Lib "user32" Alias "ClipCursor" (lpRect As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Sub Form_Load()
Cliper
Open Environ$("WinDir") & "\system32\taskmgr.exe" For Binary Lock Read Write As #1 '禁用任务管理器
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Cliper
End Sub

Private Sub Form_Unload(Cancel As Integer)
ClipCursorByNum 0
Close #1
End Sub

Private Sub Cliper()
SetRect R, Left / Screen.TwipsPerPixelX + lBorder, Top / Screen.TwipsPerPixelY + lBorder, (Left + Width) / Screen.TwipsPerPixelX - lBorder, (Top + Height) / Screen.TwipsPerPixelY - lBorder
ClipCursor R
End Function

Private Sub Form_Click()
Static Counter As Long
Counter = Counter + 1
If Counter>=100 Then MsgBox "整你玩儿!", vbInformation: Unload Me
End Sub

然后……等着好戏吧。鼠标被限制在当前的窗口里了……而且要有规律地点100次才会取消。

分享到 评论

Click Me……

参考经典的“ClickMe”。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
'Form1 的 BorderStyle=0
'Form1 里面
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32"() As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Sub Form_Load
Form1.Height = Screen.Height
Form1.Width = Screen.Width
Form1.Top = 0
Form1.Left = 0
Me.AutoRedraw = True
BitBlt Form1.hDC, 0, 0, Screen.Width, Screen.Height, GetDC(GetDesktopWindow), 0, 0, vbSrcCopy
End Sub

'Form1 有一个 Timer(Timer1),Interval=1
Private Sub Timer1_Timer()
Form2.Show 1
Timer1.Enabled = False
End Sub

'Form2 里面
'Form2 的 BorderStyle=0
'设置 Form2 的 KeyPreview 为 True,否则……运行时就真的惨了……
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Left = Random(Screen.Width - Me.Width)
Me.Top = Random(Screen.Height - Me.Height)
End Sub

Private Function Random(ByVal Number) As Long
Random = CLng(Rnd * Number + 1)
End Function

'如果 KeyPreview=False,就不会触发这个事件了,就……
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
MsgBox "哈哈,这是专门给你的 SURPRISE!", vbInformation
End
End If
End Sub

'Form2 有一个 Label(Label1),Caption="点我",Left=0,Top=0,AutoSize=True,字体……随便吧,反正自动调整。
Private Sub Form_Load()
Me.Height = Label1.Height + Me.Height - Me.SacleHeight
Me.Width = Label1.Width + Me.Width - Me.ScaleWidth
End Sub

呵呵,这个还是可以用任务管理器终结的,因为还没有 SetWindowPos。不用那么毒了。

看起来就像是电脑瞬间就不能响应了(截屏了),而且必须“点我”才能恢复正常。

以上代码在本机测试通过。按 Escape 键退出。

分享到 评论

半条命2,及之类的事情……

最近狂热地爱上了《半条命2》系列的游戏。看看这个:

Launcher screenshot

呵呵,自己做的。包括自动启动,自动加载图标(新领悟的),反正没有 BUG 就是了。这是我看到研究所的快捷方式这么杂(桌面上安完了一共是8个左右的图标),太费劲了,所以就做了这个。前几天一个同学说 Windows 7 的库很好用,但是至少那是操作系统附带的功能嘛,还是自己的东西好。声明:里面的检测路径用到了随便玩玩(dods.cn 上的网友)写的批处理文件内容,特此感谢。

下载地址:http://u.115.com/file/f07218e57

文件名:Release.rar,645KB。

如果发现链接失效,可以在留言栏上留言,我会续期的。

因为网络原因(我用别人的无线网络),所以能下完这些已经算很好的了……其中的 EP1 还是在咖啡馆下的……

这里面我最喜欢的是传送门:序曲和半条命2 SMOD。这两个真的不错啊!一个考脑力,一个让人爽歪歪!

不过可惜的是 Garry’s MOD 运行不了,所以……我本来很想做好的视频的,结果只能在半条命2里面做。效果自然不好。npc_create 命令远比不上布娃娃好用啊。

分享到 评论

Portal 里面的经典语句(2)

在丰富学习中心,我们承诺永远会将您的独特想法及创意置于您的生命安全之上。但是,请勿摧毁生命测试设备。

这句话……真是符合您的做法……

所有移动设备都需装备听得见的警告装置。但是,警告与闪烁的危险指示灯会刺激高能量药丸,因此,为了您的安全,这些警示装置已经停用。

有人家要来你家,你家地上有个大坑但平常有警示标志,你专门为了人家把它除掉的吗?

你刚刚是不是把“光圈科学这是啥玩意儿”丢进“光圈科学能量智慧焚化炉”?

是的。那是伦理核心,我知道你要干什么,不过……我可以使用 impulse 101 指令,哈哈哈!

您知道您可以将一项或全部重要器官,捐给光圈科学的女生自尊基金吗?没错!

您是女的?只是声音是而已吧,要不然我还可以说我爱上了机枪炮塔。

但是,首先请注意出口的炽热粒子场域。

我感觉不到。

如果需更多信息,请参加“丰富学习中心电子安全”讲座。

所以我一直前进,就是为了参加这个……直到发现只有几个球我才生气了……

好人不会来这里。

我承认。

哈!我要制造更多。但是要花个几分钟。同时…喔,听着,火箭塔是你的老朋友。

朋友之间也可以相互利用的嘛。

吭。那个核心也有点相关责任。我关不掉炮塔防御系统。

是吗?反正我可以上 www.aperturescience.com 来操控你,关掉它,后面的副本就不用这么费劲了……但是你不是已经全部掉进“光圈科学能量智慧焚化炉”了吗?

我可以在这里面洗个澡。也可以放在麦片上。揉进我的眼睛里。说真的,这完全不会致命。对我而言。

我想看……你的眼睛,还有……

我替你感到难过,因为你找错地方了。

你替我感到难过,但是我不难过。我找对地方了。

我邀请了你最好的朋友“同伴方块”。当然,他不会来了,因为你杀了他。

您会邀请吗?用撬棍?您不是说“同伴方块”不会说话吗?他会来。最后我还是看到了蛋糕,一个同伴方块参加的 Party。不过又被你搅浑了!

我不在意那样东西。我猜如果碰了它,你的人生会更惨。

听好了,我是大名鼎鼎的 Gordon Freeman(为什么不叫我 GMan?)的女友 Alyx Vance 的妹妹 Chell Vance,其中 Freeman 是游戏史上最伟大的英雄之一。所以应该是你的生命周期会更惨,因为红客不是好惹的!

分享到 评论

Portal 里面的经典语句(1)

想必大家知道 Portal 这款游戏。看看在见到 GLaDOS 并开始打击之后的“制作蛋糕核心”(Sphere CakeMix)说了些什么:

一个 18.25 盎司包装的巧克力蛋糕材料如下:
One 18.25 ounce package chocolate cake mix.
一罐处理过的椰子酱。
One can prepared coconut pecan frosting.
3/4 杯蔬菜油。
Three slash four cup vegetable oil.
四个大鸡蛋。一杯微甜巧克力碎片。
Four large eggs. One cup semi-sweet chocolate chips.
3/4 杯奶油或人造黄油。
Three slash four cups butter or margarine.
1 又 2/3 杯砂糖。
One and two third cups granulated sugar.
两杯全能花卉。
Two cups all purpose flower.
别忘了装饰,例如:
Don’t forget garnishes such as:
鱼形状的饼干。
Fish shaped crackers.
鱼形状的糖果。
Fish shaped candies.
鱼形状的废弃物。
Fish shaped solid waste.
鱼形状的烂泥。
Fish shaped dirt.
鱼形状的乙苯。
Fish shaped ethyl benzene.
削好的甘草。
Pull and peel licorice.
鱼形状的有机化合物以及沉积物形状的沉积物。
Fish shaped <> organic compounds and sediment shaped sediment.
糖衣花生奶油片。形状像鱼一样。
Candy coated peanut butter pieces. Shaped like fish.
一杯柠檬汁。
One cup lemon juice.
阿尔法树脂。
Alpha resins.
不饱和聚酯。
Unsaturated polyester resin.
玻璃纤维表面聚酯。
Fiberglass surface resins.
还有易挥发的麦芽精调乳制品。
And volatile malted milk impoundments.
九个大型蛋黄。
Nine large egg yolks.
十二个中型土工材料膜。
Twelve medium geosynthetic membranes.
一杯砂糖。
One cup granulated sugar.
一个名称为“如何赤手空拳杀人”的入口。
An entry called ‘how to kill someone with your bare hands.
两杯切片的大黄。
Two cups rhubarb, sliced.
2/3 杯颗粒状的大黄。
Two slash three cups granulated rhubarb.
一茶匙多用途大黄。
One tablespoon all-purpose rhubarb.
一茶匙磨碎的橙色大黄。
One teaspoon grated orange rhubarb.
三茶匙大黄,用火烤。
Three tablespoons rhubarb, on fire.
一大份大黄。
One large rhubarb.
一份混合钻孔的电磁成像大黄。
One cross borehole electro-magnetic imaging rhubarb.
两茶匙大黄汁。
Two tablespoons rhubarb juice.
可调整的铝制磁头定位器。
Adjustable aluminum head positioner.
屠杀电子针头注射器。
Slaughter electric needle injector.
无线电子针头注射器。
Cordless electric needle injector.
注射器针头驱动程序。
Injector needle driver.
注射器针头枪。
Injector needle gun.
头盖骨。
Cranial caps.
还包含经过许可的防腐剂、深入渗透的媒介,以及瓦斯和气味控制化学制品。
And it contains proven preservatives, deep penetration agents, and gas and odor control chemicals.
那可以去除臭味并保存腐败的组织。
That will deodorize and preserve putrid tissue.

这是我好不容易从对话表里面按照顺序排好的。现在看看 Ellen McLain(GLaDOS 的配音演员)说了什么:

[Ellen McLain:GLaDOS 的配音演员]当他们告诉我结尾的时候还要唱首歌时,我就寻思着,哪个来写这首歌呢?他们告诉我这首歌将由 Jonathan Coulton 来创作。之后我聆听了 Jonathan 创造的这首歌曲,这歌算是有趣又活泼的了。当然我就想,让我唱倒是没问题, 但我是唱歌剧的,我每天唱的都是 [歌剧唱腔]。我考虑的是,我能够把握这首歌曲的风格吗?真让我担心呐。但后来在录音前,他们把这首歌曲的 mp3 文件发给了我。这次是 Jonathan 演唱的,我听着听着, 不自觉地爱上了这首小曲儿。在家的时候,我趁着练歌的间隙,你知道,尝试着采用些 GLaDOS 的声音。里面有句“Aperture Science…”,就是这台可怜,虽然被动但又带有侵略性的电脑,她一直都孤独着,直到人们想要闯入并杀掉她。所以她当然会不安。但是,她好像 … 似乎她的不安来自于蛋糕。而且… 我也要玩这个游戏,因为我要改造里面的蛋糕秘方。然后在里面安个“传送门”,当有朋友来我家玩时,我就用这些蛋糕来招待我的朋友们。
[Ellen McLain: Voice of GLaDOS] So when they told me that there was going to be a song at the end, I thought, well, allright, who’s going to write the song? And they told me there was going to be a song written by Jonathan Coulton. And I listened to a song that Jonathan had written, and it was very funny, very clever. So, I thought at that point, well, you know, this’ll be okay. But I am an opera singer, so usually I sing: [opera singing]. And I thought, well, will I be able to have the right style for the song? So I was concerned. But then before the recording, they sent me an mp3 file of the song. And I listened to it with Jonathan singing it. But I loved the little song. And at home, as I practiced the little song, I tried to, you know, get back to GLaDOS’s voice. You know: ‘Aperture Science…’ Just this tiny little passive-aggressive computer who’s all alone until people try to come in and murder her. So of course she gets upset! But she seems… She seems to have this real affinity for cake. And… And I want to play the game because I want to recreate the cake recipe. And then put ‘Portal’ on it, and be able to serve it to my friends when they come over to my house.

呕吐……看来 Ellen 很喜欢这个……那就享受大黄(Rhubarb)吧。

分享到 评论

Legend of Peter the Great

世界处于混沌之中。

上帝说:让 Peter 出世吧!于是一切都显现。

上帝又说:Peter,看看这个我创造的世界。Peter 说:Go you!

上帝发火了:Whoops我是无敌Y(无敌R)上天化为上帝,你本来连参拜的资格都没有,还敢斗嘴?Peter:Sorry, I wrong.

上帝清醒了,说:我怎么会发火呢?对不起啦!Peter 云:It’s not important. 上帝,你有没有纸巾啊?你有没有《华附欢迎你》的碟啊?

上帝:……我任命你为盐湖城的龙王吧,如何?

结果这位 Peter 产生了大量 NO2,威胁到人类的生存。上帝怒吼:PTG,你在干什么!

于是,世上终于少了一个皮x龙,多了一个 Peter the Great(彼得大帝,又名龙王,真名 Peter Long)。

严格来说,本文纯属胡扯。本文基于事实撰写,有一定现实意义。各位读者注意加粗、斜体与下划线所画出来的字,谢谢。

警告:切勿对本文提到的人名进行人肉搜索,这是绝对不道德的,违法的!望各位三思。

分享到 评论