小弟我程序设计时出小问题,高手帮帮忙
我的程序有一个分支是,将字符直接输出到桌面,不通过窗体,可以不,如果不行,能用透明窗体实现吗???如何实现,小弟不才望高手指教 --------------------编程问答-------------------- 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
--------------------编程问答-------------------- 另将Form的BorderStyle设为None --------------------编程问答-------------------- 能不能不用按钮,窗体载入后直接显示 --------------------编程问答-------------------- 设置窗体为最大:
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 Function
Private Sub Form_Click()
x = 2000
y = 2000
fnt = 48
txt = "用于显示文字"
dd = prnt(x, y, fnt, txt)
End Sub
Private Sub Form_DblClick()
End '终止程序运行
End Sub
'最后,在Form中加上如下代码。
Private Sub Form_Load()
SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
End Sub
--------------------编程问答-------------------- 增加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 Function
Private Sub Form_DblClick()
End '终止程序运行
End Sub
'最后,在Form中加上如下代码。
Private Sub Form_Load()
SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
Timer1.Interval = 1000
End Sub
Private Sub Timer1_Timer()
x = 2000
y = 2800
fnt = 48
txt = "用于显示文字"
dd = prnt(x, y, fnt, txt)
Timer1.Enabled = False
End Sub
--------------------编程问答-------------------- 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 Sub
Private 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 = 300
ret = DrawText(hd, c, 10, r, 0)
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 Long
Sub 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 Long
Sub main()
TextOut GetDC(0), 100, 100, "hell world", 10
End Sub
--------------------编程问答-------------------- 解释一下:
TextOut 这个API可以向指定的HDC场景在X,Y处输出长度为nCount的字符串lpString
而GETDC这个API可以获得指定窗体句柄的HDC,桌面的句柄是固定的,就是GETDC(0)
--------------------编程问答-------------------- 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 Function
Private Sub Form_DblClick()
End '终止程序运行
End Sub
'最后,在Form中加上如下代码。
Private Sub Form_Load()
SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
Timer1.Interval = 1000
End Sub
Private Sub Timer1_Timer()
x = 2000
y = 2800
fnt = 48
txt = "用于显示文字"
dd = prnt(x, y, fnt, txt)
Timer1.Enabled = False
End Sub
补充:VB , 基础类