Solved

Painting Text On Screen?

Posted on 2000-02-18
21
580 Views
Last Modified: 2011-10-03
If anyone has, or has seen the "Aptiva EZ Buttons" application that makes text appear in the bottom right hand part of your screen whenever you press the cd keys or whatever... I would like code that I could use to display Text there.  Like "Play" in green for 3 seconds and then it disappears.  Basically, I want to "paint" text onto the screen to confirm to the user what they just pressed in my program.  How might I do this?  Thanks!
0
Comment
Question by:rodrego
  • 7
  • 7
  • 3
  • +3
21 Comments
 

Expert Comment

by:rdolivaw
ID: 2536169
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.
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2536262
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!
0
 

Expert Comment

by:rdolivaw
ID: 2536418
mcrider:

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

rdolivaw
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2536456
rdolivaw, thanks! Not all of the experts here are that good about withdrawing answers...


My answer is my previous comment...

Cheers!
0
 
LVL 32

Expert Comment

by:Erick37
ID: 2536496
Do you not have to call ReleaseDC() after GetWindowDC()?
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2536629
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!
0
 
LVL 12

Expert Comment

by:roverm
ID: 2537000
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
0
 
LVL 3

Expert Comment

by:paulstamp
ID: 2537974
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.
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2539111
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

   

0
 

Author Comment

by:rodrego
ID: 2540400
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?
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 14

Expert Comment

by:mcrider
ID: 2540421
You rejected my answer??? Why?
0
 

Author Comment

by:rodrego
ID: 2540433
Sorry!  It's great but could you please tell me how I would change the Foreground, Background (Transparent), and make the text larger?
0
 
LVL 14

Accepted Solution

by:
mcrider earned 300 total points
ID: 2540566
Here you go... The complete example again... This time with the font size set at 16, the forcolor green, and the backcolor transparent...

By the way, don't you think this is worth a couple more points... and an "A"? ;-)


Cheers!


THE CODE:


    Private Const DESIREDFONTSIZE = 16 'THIS IS THE FONT SIZE TO USE
   
    Private Const TRANSPARENT = 1
    Private Const LF_FACESIZE = 32
    Private Type LOGFONT
       lfHeight As Long
       lfWidth As Long
       lfEscapement As Long
       lfOrientation As Long
       lfWeight As Long
       lfItalic As Byte
       lfUnderline As Byte
       lfStrikeOut As Byte
       lfCharSet As Byte
       lfOutPrecision As Byte
       lfClipPrecision As Byte
       lfQuality As Byte
       lfPitchAndFamily As Byte
       lfFaceName As String * LF_FACESIZE
    End Type
    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 Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
    Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
    Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 Sub Command1_Click()
    Dim lret As Long
    Dim lX As Long
    Dim lY As Long
    Dim lDC As Long
    Dim tBuf As String
    Dim lf As LOGFONT
    Dim hFont As Long
    Dim hOldfont As Long
    Dim Result As Long

    tBuf = "Hello There!"
    lX = Screen.Width / Screen.TwipsPerPixelX - 120
    lY = Screen.Height / Screen.TwipsPerPixelY - 40
    lDC = GetWindowDC(GetDesktopWindow())
    lf.lfHeight = (DESIREDFONTSIZE * -20) / Screen.TwipsPerPixelY
    hFont = CreateFontIndirect(lf)
    hOldfont = SelectObject(lDC, hFont)
    SetTextColor lDC, RGB(0, 140, 0)
    SetBkMode lDC, TRANSPARENT
    lret = TextOut(lDC, lX, lY, tBuf, Len(tBuf))
    Result = SelectObject(lDC, hOldfont)
    Result = DeleteObject(hFont)
    ReleaseDC GetDesktopWindow(), lDC
    Debug.Print lret
    End Sub
    Private Sub Command2_Click()
    InvalidateRect 0, ByVal 0, 0
    End Sub
0
 

Author Comment

by:rodrego
ID: 2540631
Adjusted points to 300
0
 

Author Comment

by:rodrego
ID: 2540632
Yes I do.  Thank you very much!
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2540639
Thanks for the points! Glad I could help!


Cheers!
0
 

Author Comment

by:rodrego
ID: 2540820
Is there any other way to make the text dissappear without the "flashy" refresh?
0
 
LVL 32

Expert Comment

by:Erick37
ID: 2540920
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
0
 

Author Comment

by:rodrego
ID: 2540957
Cool, thanx but it keeps saying "Variable not defined" and highlighting the RDW_ERASE Const thing...  Any ideas?
0
 
LVL 32

Expert Comment

by:Erick37
ID: 2540980
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.
0
 

Author Comment

by:rodrego
ID: 2541273
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... :)
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now