Painting Text On Screen?

Rodego:

Try this:  add a label on the form where you want the message to appear, setting the caption to nothing and the forecolor to whatever you want in the properties.

On the click event for the command button something like the following gives you about a 3-second pause on a 200MHZ processor:

Private Sub Command1_Click()
Dim Ctr0 As Integer, Ctr1 As Integer

    Label1.Caption = "You just pressed the button"
    DoEvents
    For Ctr0 = 0 To 5000
        For Ctr1 = 0 To 10000
        Next Ctr1
    Next Ctr0
    Label1.Caption = ""
End Sub


You can adjust the For/Next values to increase or decrease the time (you need two loops because you'll get an overflow error if you make a single loop big enough to show at all).  

You could also make a loop using the "NOW" date/time constant:

.....

Ctr = Second(now) + 3 - IIf(Second(now) > 56, 60, 0)
DoEvents
Do Until Second(now) = Ctr
Loop

.....

This finds the current second from the system clock, adds three seconds to it then loops until the new current second equals that.  This makes it processor independent; the IIf() function keeps the Ctr value from going over 60 and messing up the timing.  You could make this a function and pass the timing, in seconds, for whatever event you're using.

Good luck.

rodrego,

Actually, I think you're looking for something like this... If this helps you, please reject the current answer and select this comment as the correct answer...

Here's an example that will paint "Hello There!" in the bottom-righthand corner of the screen.

1) Start a new project and add 2 command buttons to FORM1.

2) Add the following code to the DECLARATIONS Section of FORM1.


    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 GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
    lpRect As Any, ByVal bErase As Long) As Long
    Private Sub Command1_Click()
    Dim lret As Long
    Dim lX As Long
    Dim lY As Long
    Dim tBuf As String
    tBuf = "Hello There!"
    lX = Screen.Width / Screen.TwipsPerPixelX - 120
    lY = Screen.Height / Screen.TwipsPerPixelY - 40
    lret = TextOut(GetWindowDC(GetDesktopWindow()), lX, lY, tBuf, Len(tBuf))
    Debug.Print lret
    End Sub
    Private Sub Command2_Click()
    InvalidateRect 0, ByVal 0, 0
    End Sub


3) Run the program and click the COMMAND1 Button.  The text will appear on the screen.

4) Press the COMMAND2 button and the screen will be refreshed and the text will disappear.


Cheers!

mcrider:

I like your answer better, too, so I'm withdrawing mine.

rdolivaw

rdolivaw, thanks! Not all of the experts here are that good about withdrawing answers...


My answer is my previous comment...

Cheers!

Do you not have to call ReleaseDC() after GetWindowDC()?

Well, the documentation says you do, but I've used the code without it and I don't have any problems... But if you want it the way the documentations says to do it, add the following to the DECLARATIONS section of FORM1:

   Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Then REPLACE the Command1_Click subroutine above with this one:


    Private Sub Command1_Click()
    Dim lret As Long
    Dim lX As Long
    Dim lY As Long
    Dim lDC As Long
    Dim tBuf As String
    tBuf = "Hello There!"
    lX = Screen.Width / Screen.TwipsPerPixelX - 120
    lY = Screen.Height / Screen.TwipsPerPixelY - 40
    lDC = GetWindowDC(GetDesktopWindow())
    lret = TextOut(lDC, lX, lY, tBuf, Len(tBuf))
    ReleaseDC GetDesktopWindow(), lDC
    Debug.Print lret
    End Sub



Cheers!

Another way to do it:

Like the SetUp1 does when installing an application: paint the Text somewhere on the screen.
See SetUp1.vbp, frmSetUp1, Sub DrawBackGround.

Then place a timer on your form and start it (enabled = true) every time you draw the text.
Delete the text when the Timer event triggers ! (don't forget to reset the timer (enabled = false).

D'Mzzl!
RoverM

mcrider - how do you get rid of the text again ? That works nicely,  but rodrego wants the text to appear for a few seconds and then dissappear.

The code under the Command2 Button will get rid of the text...

   InvalidateRect 0, ByVal 0, 0


So, you could replace the Command1_Click subroutine I gave you with this:


Private Sub Command1_Click()
    Dim lTimer
    Dim lret As Long
    Dim lX As Long
    Dim lY As Long
    Dim lDC As Long
    Dim tBuf As String
   
    'PRINT THE TEXT TO THE SCREEN
    tBuf = "Hello There!"
    lX = Screen.Width / Screen.TwipsPerPixelX - 120
    lY = Screen.Height / Screen.TwipsPerPixelY - 40
    lDC = GetWindowDC(GetDesktopWindow())
    lret = TextOut(lDC, lX, lY, tBuf, Len(tBuf))
    ReleaseDC GetDesktopWindow(), lDC

    'SLEEP FOR 3 SECONDS
    lTimer = Timer + 3
    Do While lTimer > Timer
        DoEvents
    Loop
   
    'GET RID OF THE PRINTED TEXT
    InvalidateRect 0, ByVal 0, 0
    End Sub

   

Wow, thanx for the large response.  mcrider, your answer is exactly what i'm looking for, but could you please show me how you would make the white background transparent, the foreground green, and the text larger?

You rejected my answer??? Why?

Sorry!  It's great but could you please tell me how I would change the Foreground, Background (Transparent), and make the text larger?

Adjusted points to 300

Yes I do.  Thank you very much!

Thanks for the points! Glad I could help!


Cheers!

Is there any other way to make the text dissappear without the "flashy" refresh?

Instead of using InvalidateRect to repaint everything, use RedrawWindow to redraw only a specified portion of the desktop.  Here is a little example you can add to Mcrider's code:

Option Explicit

Private Sub Command1_Click()
    'Define the text window's height and width in pixels
    Const H = 25
    Const W = 100
    Const RDW_FLAGS = (RDW_ERASE Or RDW_INVALIDATE Or RDW_ERASENOW Or RDW_ALLCHILDREN)
    Dim rc As RECT
    Dim lhWnd As Long
    Dim lDC As Long
    Dim sMsg As String
    Dim dx As Long, dy As Long
    dx = Screen.Width / Screen.TwipsPerPixelX
    dy = Screen.Height / Screen.TwipsPerPixelY
    sMsg = "Hello DC"
    lhWnd = GetDesktopWindow
    'make a rectangle for the text
    rc.Right = W
    rc.Bottom = H
    'Move the rectangle anywhere you like
    Call OffsetRect(rc, dx - W, dy - H - 50)
    lDC = GetWindowDC(lhWnd)
    'Draw text in rect
    Call DrawText(lDC, sMsg, Len(sMsg), rc, DT_LEFT)
    Call Sleep(3000)
    Call ReleaseDC(lhWnd, lDC)
    'Redraw the rect region
    Call RedrawWindow(lhWnd, rc, ByVal 0, RDW_FLAGS)
End Sub

Cool, thanx but it keeps saying "Variable not defined" and highlighting the RDW_ERASE Const thing...  Any ideas?

Use the API Viewer Add-In which comes with VB.  In Add-Ins->Add-In Manager select API Viewer.  Then the API Viewer will appear in the Add-Ins menu.

Open the Viewer and open the WIN32API.TXT file located in the WINAPI directory.

Most of the Consts, Declares, and Types for the Win32 API will be listed.
Copy the declares and consts that your program needs from there and paste them in your code.  If you are pasting into a form, remove the Public keyword and replace it with Private, otherwise use as is in a Module.

Great, thanks!!  I had a little trouble mixing all the code and get it to do what I needed but I figured it out eventually with only minor injuries... :)