请教有没有办法可以让vb在电脑屏幕上方显示字呢

请问有没有办法可以让vb在电脑屏幕上方显示字呢?
本帖最后由 ycwww 于 2015-02-07 04:25:54 编辑
突发7想,弄一个在电脑屏幕上方写出大字号的提醒标语 功能(字的显示位置要在vb程序面板),不知哪位大神有没有办法实现?如果有,请给出源码。


------解决思路----------------------
弄个这样的窗体,想搁哪就搁哪呗.........

Option Explicit
Private Sub Form_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    With Label1
        .Caption = "Hello,World!"
        .FontSize = 128
        .Move (Screen.Width - .Width) / 2, 0
    End With
    Me.Move 0, 0, Screen.Width, Label1.Height
End Sub



------解决思路----------------------
新建一个新工程,不用添加任何控件,把代码贴进form里,然后运行


Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) 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 WithEvents iTimer As VB.Timer

Private Sub Form_Load()
    Set iTimer = Me.Controls.Add("VB.Timer", "iTimer")
    iTimer.Interval = 100
    iTimer.Enabled = True
End Sub

Private Sub iTimer_Timer()
    Dim DC As Long, Txt As String
    Txt = "Hello World!"
    DC = GetDC(0)
    TextOut DC, Me.ScaleX(Screen.Width / 2, vbTwips, vbPixels), 0, Txt, LenB(StrConv(Txt, vbFromUnicode))
    ReleaseDC 0, DC
End Sub

------解决思路----------------------
这是你可能想要的进阶效果,再复杂的就不给你写了。

Private Const TRANSPARENT = 1
Private Const DEFAULT_CHARSET = 1
Private Const OUT_DEFAULT_PRECIS = 0
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) 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 Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal e As Long, ByVal o As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal cp As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private WithEvents iTimer As VB.Timer

Private Sub Form_Load()
    Set iTimer = Me.Controls.Add("VB.Timer", "iTimer")
    iTimer.Interval = 100
    iTimer.Enabled = True
End Sub
 
Private Sub iTimer_Timer()
    Dim DC As Long, Txt As String, hFont As Long
    Txt = "Hello World!"
    DC = GetDC(0)
    SetBkMode DC, TRANSPARENT
    SetTextColor DC, IIf(Second(Now) Mod 2 = 0, vbRed, vbYellow)
    hFont = CreateFont(30, 20, 0, 0, 0, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, "黑体")
    SelectObject DC, hFont
    TextOut DC, Me.ScaleX(Screen.Width / 2, vbTwips, vbPixels), 0, Txt, LenB(StrConv(Txt, vbFromUnicode))
    DeleteObject hFont
    ReleaseDC 0, DC
End Sub

------解决思路----------------------
楼主参考一下这个代码。

这个代码比较简单。
显示文字的窗口是置顶了的,如果没有别的也“置顶”的窗口把它挡住,就不用进行不断的刷新。

新建一个“EXE工程”,再增加一个新窗体Form2,用来显示文字。
Form1为启动窗口(新建工程就有的,默认为启动),在它里面画两个CommandButton。
点Command1显示Form2 ,点Command2关闭Form2 。
添加Form2之后,在属性窗口中把 ShowInTaskbar 设置为 False ,其它可不用改。
当然你也可以把代码中设置了的那些“固定”的属性设置好,这样可把代码中的相应语句去掉。

Form1的代码:
Private Sub Command1_Click()
   Form2.Show 0, Me
End Sub

Private Sub Command2_Click()
   Unload Form2
End Sub


Form2的代码:
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongW" (ByVal hWnd As Long, _
                    ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongW" (ByVal hWnd As Long, _
                    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
                    ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
                    ByVal wFlags As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hWnd As Long, _
                    ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long


Private Sub Form_Load()
   Call SetWindowLong(hWnd, -20, &H80020 Or GetWindowLong(hWnd, -20))
   Call SetLayeredWindowAttributes(hWnd, 0, 0, 1)
   Call SetWindowPos(hWnd, -1, 0, 0, 0, 0, 19)
   AutoRedraw = True
   BorderStyle = 0
   Caption = "-"
   Width = Screen.Width
   Height = Screen.Height
   BackColor = 0        '窗口背景黑色
   ForeColor = &HC000FF '文字颜色(不能跟背景一样)
   FontSize = 96        '文字大小
   '显示内容。
   Print "Hello, world!";
   '注意上面那句,后面“分号”不能少!!!
   '移到顶部居中
   Call Move((Screen.Width - CurrentX) \ 2, 0)
   
   '上面的简单演示,注意文字大小和内容,显示结果不能超过一屏宽度。
   '如果有其它显示格式或需求,自己去处理细节方面的东西。
End Sub