回 帖 发 新 帖 刷新版面

主题:VB调用API小程序段纠错!各位师傅都来帮一下

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个回复)

沙发

'Call UpdateWindow(h_window)
注释掉这句看下.

板凳

根据我以前的实验,我记得在VB中调用API对桌面窗体进行操作都是徒劳,因为不会有任何效果,我想应该是被系统给屏蔽了

3 楼

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 楼

版副啊,哪里有显示“测试一下”啊,在桌面上没看到,和桌面墙纸有关么???

我试了,如果直接取form.hdc,在窗体上显示出来的也只是"测试"

5 楼

vista下没问题,XP下不知道.
GetDesktopWindow()返回的是桌面窗口(所有顶层窗口的父窗口)
我看效果和直接写屏幕一样(hdc = GetDC(0))

6 楼

用错了一个函数。正确的代码如下:

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 楼

你还可以把字放大到桌面,代码如下:

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 楼

还真是这样,在XP下要用GetWindowDC才会有效果。看来我以前也一直用错

记得我在98下试验hwnd = GetDesktopWindow()取得的数总是为0,所以可以直接GetDC(0),在vista下想必也是这样,而在XP SP2下,取得的桌面窗体句柄却是65556

不知MS在这中间搞了什么动作

我来回复

您尚未登录,请登录后再回复。点此登录或注册