小弟我程序设计时出小问题，高手帮帮忙

Question

我的程序有一个分支是，将字符直接输出到桌面，不通过窗体，可以不，如果不行，能用透明窗体实现吗？？？如何实现，小弟不才望高手指教

Answer 1

Option Explicit
   ' 在Form的声明部分加上以下代码：
    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 SetParent Lib "user32" (ByVal hWndChild _
    As Long, ByVal hWndNewParent As Long) As Long
    Const WS_EX_TRANSPARENT = &H20&
    Const GWL_EXSTYLE = (-20)
Private Sub Command1_Click()
    Print "Hello" '用于显示文字
End Sub
     
Private Sub Command2_Click()
    End '终止程序运行
End Sub    '最后，在Form中加上如下代码。
Private Sub Form_Load()
    SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
End Sub

Answer 2

设置窗体为最大：
Option Explicit
   ' 在Form的声明部分加上以下代码：
    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 SetParent Lib "user32" (ByVal hWndChild _
    As Long, ByVal hWndNewParent As Long) As Long
    Const WS_EX_TRANSPARENT = &H20&
    Const GWL_EXSTYLE = (-20)
    Dim x, y, fnt As Integer
    Dim txt As String
    Dim dd As Long
'打印函数
Public Function prnt(x As Variant, y As Variant, fnt As Variant, txt As Variant)
    Me.CurrentX = x
    Me.CurrentY = y
    Me.FontSize = fnt
    Me.Print txt
End FunctionPrivate Sub Form_Click()
    x = 2000
    y = 2000
    fnt = 48
    txt = "用于显示文字"
    dd = prnt(x, y, fnt, txt)
End SubPrivate Sub Form_DblClick()
    End '终止程序运行
End Sub    '最后，在Form中加上如下代码。
Private Sub Form_Load()
    SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
End Sub

Answer 3

增加TIMER控件可满足窗体载入后直接显示文字，其中打印函数可控制打印位置及字号：
Option Explicit
   ' 在Form的声明部分加上以下代码：
    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 SetParent Lib "user32" (ByVal hWndChild _
    As Long, ByVal hWndNewParent As Long) As Long
    Const WS_EX_TRANSPARENT = &H20&
    Const GWL_EXSTYLE = (-20)
    Dim x, y, fnt As Integer
    Dim txt As String
    Dim dd As Long
'打印函数
Public Function prnt(x As Variant, y As Variant, fnt As Variant, txt As Variant)
    Me.CurrentX = x
    Me.CurrentY = y
    Me.FontSize = fnt
    Me.Print txt
End FunctionPrivate Sub Form_DblClick()
    End '终止程序运行
End Sub    '最后，在Form中加上如下代码。
Private Sub Form_Load()
    SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
    Timer1.Interval = 1000
End SubPrivate Sub Timer1_Timer()
    x = 2000
    y = 2800
    fnt = 48
    txt = "用于显示文字"
    dd = prnt(x, y, fnt, txt)
    Timer1.Enabled = False
End Sub

Answer 4

Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function TextOut Lib "gdi32.dll" 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 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Sub Command1_Click()
Dim h As Long, hd As Long, ret As Long
h = GetDesktopWindow
hd = GetWindowDC(h)
Dim c As String
c = "asdfffffffffffffffff"
ret = TextOut(hd, 100, 100, c, 10)
End SubPrivate Sub Command2_Click()
Dim h As Long, hd As Long, ret As Long
h = GetDesktopWindow
hd = GetWindowDC(h)
Dim c As String
c = "asdfffffffffffffffff"
Dim r As RECT
r.Bottom = 400
r.Left = 300
r.Right = 400
r.Top = 300ret = DrawText(hd, c, 10, r, 0)End Sub

Answer 5

怎么越来越复杂呢: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 LongSub command1_click()
TextOut GetDC(0), 100, 100, "hell world", 10
End Sub就可以啦,如果不要程序窗体,那就把代码都放到模块中去: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 LongSub main()
TextOut GetDC(0), 100, 100, "hell world", 10
End Sub

Answer 6

解释一下:TextOut 这个API可以向指定的HDC场景在X,Y处输出长度为nCount的字符串lpString而GETDC这个API可以获得指定窗体句柄的HDC,桌面的句柄是固定的,就是GETDC(0)

Answer 7

Option Explicit
   ' 在Form的声明部分加上以下代码：
    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 SetParent Lib "user32" (ByVal hWndChild _
    As Long, ByVal hWndNewParent As Long) As Long
    Const WS_EX_TRANSPARENT = &H20&
    Const GWL_EXSTYLE = (-20)
    Dim x, y, fnt As Integer
    Dim txt As String
    Dim dd As Long
'打印函数
Public Function prnt(x As Variant, y As Variant, fnt As Variant, txt As Variant)
    Me.CurrentX = x
    Me.CurrentY = y
    Me.FontSize = fnt
    Me.Print txt
End FunctionPrivate Sub Form_DblClick()
    End '终止程序运行
End Sub    '最后，在Form中加上如下代码。
Private Sub Form_Load()
    SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
    Timer1.Interval = 1000
End SubPrivate Sub Timer1_Timer()
    x = 2000
    y = 2800
    fnt = 48
    txt = "用于显示文字"
    dd = prnt(x, y, fnt, txt)
    Timer1.Enabled = False
End Sub