主题:VB调用API小程序段纠错!各位师傅都来帮一下
kgdfgeifjn
[专家分:10] 发布于 2009-02-05 00:19:00
Private Sub Form_Click()
Form1.Hide
Dim str As String
Dim a As point
Dim b As point
Dim myrect As rect
a.x = 0
a.y = 0
b.x = Screen.Width / Screen.TwipsPerPixelX
b.y = Screen.Height / Screen.TwipsPerPixelY
myrect.current = b
myrect.origin = a
h_window = GetDesktopWindow()
dc = GetDC(h_window)
str = "新年快乐"
Call TextOut(dc, 0, 0, str, Len(str))
Call DrawText(dc, str, -1, myrect, DT_CENTER)
Call UpdateWindow(h_window)
Call ReleaseDC(h_window, dc)
End Sub
请各位朋友帮看看,api调用 ,没有提示错误,但是没有什么效果
回复列表 (共8个回复)
沙发
tanchuhan [专家分:15140] 发布于 2009-02-05 06:50:00
'Call UpdateWindow(h_window)
注释掉这句看下.
板凳
merry05 [专家分:8920] 发布于 2009-02-05 09:16:00
根据我以前的实验,我记得在VB中调用API对桌面窗体进行操作都是徒劳,因为不会有任何效果,我想应该是被系统给屏蔽了
3 楼
tanchuhan [专家分:15140] 发布于 2009-02-05 12:47:00
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal _
x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_Click()
Dim hwnd As Long, hdc As Long
hwnd = GetDesktopWindow()
hdc = GetDC(hwnd)
Call TextOut(hdc, 400, 400, "测试一下", 4)
Call UpdateWindow(hwnd)
Call ReleaseDC(hwnd, hdc)
End Sub
有显示"测试一下", 不过在这里调用UpdateWindow是多余的.
4 楼
merry05 [专家分:8920] 发布于 2009-02-05 15:44:00
版副啊,哪里有显示“测试一下”啊,在桌面上没看到,和桌面墙纸有关么???
我试了,如果直接取form.hdc,在窗体上显示出来的也只是"测试"
5 楼
tanchuhan [专家分:15140] 发布于 2009-02-05 20:15:00
vista下没问题,XP下不知道.
GetDesktopWindow()返回的是桌面窗口(所有顶层窗口的父窗口)
我看效果和直接写屏幕一样(hdc = GetDC(0))
6 楼
一江秋水 [专家分:9680] 发布于 2009-02-06 07:07:00
用错了一个函数。正确的代码如下:
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Sub Command1_Click()
Dim hwnd As Long, hdc As Long
hwnd = GetDesktopWindow()
hdc = GetWindowDC(hwnd)
TextOut hdc, 400, 400, "新年好", 6
ReleaseDC hwnd, hdc
End Sub
另外注意TextOut函数最后的参数,它是字节为单位,一个汉字为2个字节
7 楼
一江秋水 [专家分:9680] 发布于 2009-02-06 07:33:00
你还可以把字放大到桌面,代码如下:
Option Explicit
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Command1_Click()
Dim hwnd As Long, hdc As Long, st As String
st = "新年好"
Picture1.AutoRedraw = True: Picture1.ScaleMode = 3: Me.ScaleMode = 3
Picture1.Width = Picture1.TextWidth(st): Picture1.Height = Picture1.TextHeight(st)
Picture1.CurrentX = 0: Picture1.CurrentY = 0: Picture1.Print st
hwnd = GetDesktopWindow()
hdc = GetWindowDC(hwnd)
StretchBlt hdc, 150, 130, 400, 300, Picture1.hdc, 0, 0, Picture1.Width, Picture1.Height, vbSrcCopy
ReleaseDC hwnd, hdc
End Sub
8 楼
merry05 [专家分:8920] 发布于 2009-02-06 08:50:00
还真是这样,在XP下要用GetWindowDC才会有效果。看来我以前也一直用错
记得我在98下试验hwnd = GetDesktopWindow()取得的数总是为0,所以可以直接GetDC(0),在vista下想必也是这样,而在XP SP2下,取得的桌面窗体句柄却是65556
不知MS在这中间搞了什么动作
我来回复