Solved

Paint Text on Screen (Like IBM Aptiva)

Posted on 2002-06-23
26
290 Views
Last Modified: 2011-09-20
I've seen this on an IBM Aptiva, but i'm seeing it more and more on different machines that come with custom software, or in software that was bundled with a keyboard that has 'extra' buttons.

Anyway to the point,

How might I 'paint' colored text (any size I may set) on to the screen in the bottom right corner?

I want my app to 'paint' whatever function the user has selected in the corner of the screen to confirm what they've selected.  For those who have seen what i'm talking about you'll understand.

I've already tried 'cutting' a form to a text path but I can't seem to get the sizing and positioning right at all - i'm wondering if someone has a different approach?  Maybe one that doesn't require an extra form?

Thanks!
0
Comment
Question by:soulfyre
  • 9
  • 8
  • 7
  • +2
26 Comments
 
LVL 18

Expert Comment

by:Crash2100
ID: 7101904
You could just create a transparent form and put text inside of it.  Here's one example that uses a bitmap to make the transparent outline for the form.  Just open the mainmask.bmp file and change it so the text you want to display on the screen is in there.

Transparent Form with bitmap mask 1 line code for call this DLL
http://www.visualbasiccode.com/asp/showzip.asp?ZipFile=http%3A%2F%2Fflymoon%2Efree%2Efr%2Ffile%2Fvb%2Ftransparentform%2Ezip&theID=1846
http://flymoon.free.fr/file/vb/transparentform.zip
0
 

Author Comment

by:soulfyre
ID: 7101923
Thanks for the reply!  There are two small problems with those pieces of code however for what I need, it uses a DLL file which I want to avoid and I need to be able to change the text on-the-fly without having to create all kinds of bitmaps.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7102018
hearing...
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7102057
I found an old program in my HD.
' you don't need the timer i think...

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function BeginPath Lib "gdi32" _
    (ByVal hdc 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 EndPath Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function GetRgnBox Lib "gdi32" _
    (ByVal hRgn As Long, lpRect As RECT) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" _
    (lpRect As RECT) As Long
Private Declare Function CombineRgn Lib "gdi32" _
    (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
    ByVal hSrcRgn2 As Long, _
    ByVal nCombineMode As Long) As Long
Private Const RGN_AND = 1
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
    (ByVal hwnd As Long, ByVal hRgn As Long, _
    ByVal bRedraw As Boolean) As Long

Private Declare Function ReleaseCapture Lib "user32" _
    () As Long
Private Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Dim Texto(0 To 2) As String
Dim strLength(0 To 2) As Integer
Dim XPos(0 To 2) As Integer

Private Function GetTextRgn(strTexto As String, intCounter As Integer, XPos As Integer) As Long
    Dim hRgn1 As Long, hRgn2 As Long
    Dim rct As RECT
    'Create a path on the form's device context...
    BeginPath hdc
    TextOut hdc, XPos, 0, strTexto, intCounter 'Chr$(88) & Chr$(88), 2
    EndPath hdc
    '... convert that path to a region for our form...
    hRgn1 = PathToRegion(hdc)
    GetRgnBox hRgn1, rct
    hRgn2 = CreateRectRgnIndirect(rct)
    '... and invert the region.
    CombineRgn hRgn2, hRgn2, hRgn1, RGN_AND

    DeleteObject hRgn1
    GetTextRgn = hRgn2
End Function

Private Sub GradateColors(Colors() As Long, _
ByVal Color1 As Long, ByVal Color2 As Long)
    On Error Resume Next

    Dim i As Integer
    Dim dblR As Double, dblG As Double, dblB As Double
    Dim addR As Double, addG As Double, addB As Double
    Dim bckR As Double, bckG As Double, bckB As Double

    dblR = CDbl(Color1 And &HFF)
    dblG = CDbl(Color1 And &HFF00&) / 255
    dblB = CDbl(Color1 And &HFF0000) / &HFF00&
    bckR = CDbl(Color2 And &HFF&)
    bckG = CDbl(Color2 And &HFF00&) / 255
    bckB = CDbl(Color2 And &HFF0000) / &HFF00&
    addR = (bckR - dblR) / UBound(Colors)
    addG = (bckG - dblG) / UBound(Colors)
    addB = (bckB - dblB) / UBound(Colors)

    For i = 0 To UBound(Colors)
        dblR = dblR + addR
        dblG = dblG + addG
        dblB = dblB + addB
        If dblR > 255 Then dblR = 255
        If dblG > 255 Then dblG = 255
        If dblB > 255 Then dblB = 255
        If dblR < 0 Then dblR = 0
        If dblG < 0 Then dblG = 0
        If dblG < 0 Then dblB = 0
        Colors(i) = RGB(dblR, dblG, dblB)
    Next
End Sub

Private Sub Form_Click()
Unload Me
End Sub

Private Sub Form_DblClick()
    'Always nice to have a way out
    Unload Me
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
x As Single, Y As Single)
    'Allow dragging of the form, even
    'without a titlebar.
    ReleaseCapture
    SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
End Sub

Private Sub Form_Paint()
    'Use a fancy gradient for the demo,
    'instead of that drab vbButtonFace.
    Dim Colors() As Long
    Dim Iter As Long

    Const Banding = 8

    ReDim Colors(ScaleHeight \ Banding) As Long
    GradateColors Colors(), vbWhite, vbBlack
    For Iter = 0 To ScaleHeight Step Banding
        Line (0, Iter)-(ScaleWidth, Iter + Banding), _
            Colors(Iter \ Banding), BF
    Next
End Sub

Private Sub Timer1_Timer()
Dim x As Long
Static Contador As Integer
Dim hRgn As Long
Me.Visible = True
Texto(0) = ")1998 - Done by"
strLength(0) = 15
XPos(0) = 0

Texto(1) = "Prowler_666."
strLength(1) = 12
XPos(1) = 50

Texto(2) = "Bye!"
strLength(2) = 4
XPos(2) = 200

If Contador = 3 Then Contador = 0

    hRgn = GetTextRgn(Texto(Contador), strLength(Contador), XPos(Contador))
    SetWindowRgn hwnd, hRgn, 1
    x = GetTextRgn(Texto(Contador), strLength(Contador), XPos(Contador))
    Debug.Print Texto(Contador), strLength(Contador), XPos(Contador)
    Contador = Contador + 1
   
    Me.Refresh
End Sub


0
 
LVL 2

Expert Comment

by:Ber
ID: 7102298
How about Getting the device context of the Desktop and using the draw text API to write the text to screen...???

Heres an Example...from the net

In a module paste the following.....

Option Explicit

Public Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" _
        (ByVal lpDriverName As String, lpDeviceName As Any, _
        lpOutput As Any, lpInitData As Any) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Public Declare Function DrawText Lib "user32" Alias "DrawTextA" _
        (ByVal hdc As Long, ByVal lpStr As String, _
        ByVal nCount As Long, lpRect As RECT, _
        ByVal wFormat As Long) As Long

Public Declare Function GetTextColor Lib "gdi32" _
        (ByVal hdc As Long) As Long

Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
        ByVal crColor As Long) As Long


In the form load event of a Form paste the following...

Private Sub Form_Load()
   Dim hdc As Long
   Dim tR As RECT
   Dim lCol As Long
   Dim TextSize As Integer
   Form1.Visible = False
   
   
   ' First get the Desktop DC:
   hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)

   ' Draw text on it:
   tR.Left = 600
   tR.Top = 500
   tR.Right = 1240
   tR.Bottom = 532
   lCol = GetTextColor(hdc)
   SetTextColor hdc, &HFF&
   TextSize = DrawText(hdc, "Experts Exchange", Len("Experts Exchange"), tR, 0)
   SetTextColor hdc, lCol

   ' Make sure you do this to release the GDI
   ' resource:
   DeleteDC hdc
End Sub

This Should Work .. Give it a try and see

Cheers...
Ber...
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7104005
Ber, your code is excellent but it has a drawback (never a better word): If you open any window (i mean, screen is repainted), the text would disappears.
0
 

Author Comment

by:soulfyre
ID: 7104852
Thanks for all the replies!  Richie, i'm sorry but I can't seem to see any results from your code and yes Ber's is great but I don't want the text to dissapear that easily and I can't find a way to force it off the screen once it's painted there.

Any suggestions?
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7104952
My code displays a changing text in the middle of screen in a gradient black-white color (from left to right)
I could send yoiu the complete app if you need.
Also, we have to add some code to put form always on top (with a little api)
0
 
LVL 2

Expert Comment

by:Ber
ID: 7106334
The Best way to force it to stay on the screen is to capture the Redraw message and Redraw your text each time the message is recieved.... as for getting it off the screen I think all you need do is force a redraw without redrawing the text

Cheers...
Ber...
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7107472
Hes, as i said before, your code is the best and short and less resource usage but play with painting messages from Screen is not a good idea. You have to subclass desktop window and if your app crash or terminate abnormally, all system will do too.
0
 

Author Comment

by:soulfyre
ID: 7108671
Okay, Richie could you please send me your project?  Does anyone know exactly what to use to have the text show in the bottom-right of the screen no matter what resolution the user is running?
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7108701
Ok. e-mail?
0
 
LVL 2

Expert Comment

by:Ber
ID: 7109362
As I said All you have to do is write an event handler to handle the redraw message , then no matter what the resolution it will work...!!!

Cheers...
Ber...
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:soulfyre
ID: 7115796
Sorry, my bad!  I thought my e-mail was available in my profile.

rodrego@rogers.com

Ber, i'm not worried about a redraw at any resolution, i'm curious as to how I could have the text appear in the bottom-right of the screen under any resolution.  For instance, if one would like to have their form centered horizontally at startup they could use "Form1.Left = (Screen.Width / 2) - (Form1.Width / 2)"

Thanks
0
 
LVL 2

Accepted Solution

by:
Ber earned 200 total points
ID: 7115948
Try this...

In a module paste the following...

Option Explicit

Public Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" _
       (ByVal lpDriverName As String, lpDeviceName As Any, _
       lpOutput As Any, lpInitData As Any) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Public Declare Function DrawText Lib "user32" Alias "DrawTextA" _
       (ByVal hdc As Long, ByVal lpStr As String, _
       ByVal nCount As Long, lpRect As RECT, _
       ByVal wFormat As Long) As Long

Public Declare Function GetTextColor Lib "gdi32" _
       (ByVal hdc As Long) As Long

Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
       ByVal crColor As Long) As Long

Public Declare Function WindowFromDC Lib "user32" (ByVal hdc As Long) As Long

Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
        lpRect As RECT, ByVal bErase As Long) As Long

Public Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

Public Const SM_CXSCREEN = 0 'X Size of screen
Public Const SM_CYSCREEN = 1 'Y Size of Screen


Add a timer to the form...

In the forms general Declarations Add the following...

Dim screentime As Integer


In the form load event add the following...

screentime = 0
Form1.Visible = False
Timer1.Interval = 5

Return to form view and double click on the timer...
In the timer1_timer() event add the following...

  Dim hdc As Long
  Dim tR As RECT
  Dim lCol As Long
  Dim TextSize As Integer
  Dim hwnd As Long
  Dim sucess As Integer
  Dim width As Integer
  Dim height As Integer
   
  ' First get the Desktop DC:
  hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)

  ' Draw text on it:
 
  width = GetSystemMetrics(SM_CXSCREEN)
  height = GetSystemMetrics(SM_CYSCREEN)

  tR.Left = width - (width / 4)
  tR.Top = height - (height / 4)
  tR.Right = (width - (width / 4)) + 200
  tR.Bottom = (height - (height / 4)) + 50
  lCol = GetTextColor(hdc)
  SetTextColor hdc, &HFF&
  TextSize = DrawText(hdc, "Experts Exchange", Len("Experts Exchange"), tR, 0)
  SetTextColor hdc, lCol

  ' Make sure you do this to release the GDI
  ' resource:
  screentime = screentime + 1
  If screentime = 50 Then
    hwnd = WindowFromDC(hdc)
    sucess = InvalidateRect(hwnd, tR, True)
    DeleteDC hdc
    End
  Else
    DeleteDC hdc
  End If


Based on the system metrics this will paint text in the bottom right corner of the screen for a few seconds and delete it after the time has elapsed....

Cheers...
Ber...
0
 

Author Comment

by:soulfyre
ID: 7118129
Ber, thanks again but still with your code, say for instance I wish to change the text while it's still displaying... it seems to get kind of messy?
0
 
LVL 2

Expert Comment

by:Ber
ID: 7120103
Its up to you... To be honest it would not take that much to modify it but if it doesn't do what you want it to do then it doesn't...

Cheers...
Ber...
0
 

Expert Comment

by:darknite
ID: 7151694
Ber, I have modified your example slightly so it functions the way I was looking for but I was wondering, how might I make the background transparent and change the font type/size?

Thanks!

BTW: I will award extra points for those features of course.
0
 

Author Comment

by:soulfyre
ID: 7151702
Please pardon any confusion, I posted the above comment from a friends house.  I didn't realise it was him logged in and not myself.

"Ber, I have modified your example slightly so it functions the way I was looking for but I was wondering, how might I make the background transparent and change the font type/size?

Thanks!

BTW: I will award extra points for those features of course."

Thanks.
0
 
LVL 2

Expert Comment

by:Ber
ID: 7155811
I am not sure you can do this using the method used above I think this would require a far more specific piece of code to change the individual pixels on the screen one by one to write some word to the screen, Alternatively you could try using BitBlt to draw bitmaps to the screen.

Cheers...
Ber...
0
 

Author Comment

by:soulfyre
ID: 7155872
I used to have some code that worked similiar to what you provided using text strings but I lost it a long time ago.  Would you be able to provide some example of what you suggested trying?
0
 
LVL 2

Expert Comment

by:Ber
ID: 7160870
Alright try this...

The following code requires a bitmap. Any element of the bitmap which is not red will not be drawn(this can be easily modified to handle other colours.The code takes a bitmap scans through it whereever it encounter a red pixel in the bitmap it draws a red pixel on the screen in a specified position, so for example if you were to create a "small" bitmap with your name  "Soulfyre" spelt out in red and then run this code using that bitmap it will write soulfyre out on the screen...Finally the picture should be saved in the same folder as the project...



In a module paste the following...

Option Explicit

Public Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" _
      (ByVal lpDriverName As String, lpDeviceName As Any, _
      lpOutput As Any, lpInitData As Any) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Type RECT
 Left As Long
 Top As Long
 Right As Long
 Bottom As Long
End Type

Public Declare Function WindowFromDC Lib "user32" (ByVal hdc As Long) As Long

Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
       lpRect As RECT, ByVal bErase As Long) As Long

Public Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

'loading sprites
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Const IMAGE_BITMAP = 0
Public Const LR_LOADFROMFILE = &H10
Public Const SM_CXSCREEN = 0 'X Size of screen
Public Const SM_CYSCREEN = 1 'Y Size of Screen

Public myBackBuffer As Long


Public Function LoadGraphicDC(sFileName As String) As Long
'cheap error handling
On Error Resume Next

'temp variable to hold our DC address
Dim LoadGraphicDCTEMP As Long

'create the DC address compatible with
'the DC of the screen
LoadGraphicDCTEMP = CreateCompatibleDC(GetDC(0))

'load the graphic file into the DC...
SelectObject LoadGraphicDCTEMP, LoadPicture(sFileName)

'return the address of the file
LoadGraphicDC = LoadGraphicDCTEMP
End Function




On the form add a timer and a Picture Box(make sure its a picture box and not an image box)...
Change the name of the Picture Box to bm...



In the general declarations paste the following....

Dim screentime As Integer




In the Form_Load() event paste the following...

screentime = 0
Form1.Visible = False
Timer1.Interval = 5
bm.AutoSize = True

myBackBuffer = LoadGraphicDC(App.Path + "\mypic.bmp")
Set bm.Picture = LoadPicture(App.Path + "\mypic.bmp")




In the timer1_timer() event paste the following...

Dim hdc As Long
Dim tR As RECT
Dim lCol As Long
Dim TextSize As Integer
Dim hwnd As Long
Dim sucess As Integer
Dim width As Integer
Dim height As Integer
Dim count As Integer
Dim counter As Integer
Dim colour As Long
Dim result As Long
       
' First get the Desktop DC:
hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)

' Draw text on it:
 
width = GetSystemMetrics(SM_CXSCREEN)
height = GetSystemMetrics(SM_CYSCREEN)

tR.Left = width - (width / 3)
tR.Top = height - (height / 4)
tR.Right = (width - (width / 4)) + 200
tR.Bottom = (height - (height / 4)) + 50
 
Me.ScaleMode = vbPixels
 For count = 1 To bm.height
     For counter = 1 To bm.width
        colour = GetPixel(myBackBuffer, counter, count)
        If colour = vbRed Then
            result = SetPixel(hdc, (tR.Left) + counter, (tR.Top) + count, colour)
        End If
    Next counter
Next count
 
' Make sure you do this to release the GDI
' resource:
screentime = screentime + 1
If screentime = 50 Then
  hwnd = WindowFromDC(hdc)
  sucess = InvalidateRect(hwnd, tR, True)
  DeleteDC hdc
  End
Else
  DeleteDC hdc
End If


This should work I have tested it several times and it seems fine but if you have any problems just ask

Cheers...
Ber...
0
 
LVL 2

Expert Comment

by:Ber
ID: 7160907
In the form load add the following...
bm.BackColor = vbWhite

In the code in the timer1_timer() event
Modify the following code section....

>>For count = 1 To bm.height
>>    For counter = 1 To bm.width
>>       colour = GetPixel(myBackBuffer, counter, count)
>>       If colour = vbRed Then
>>           result = SetPixel(hdc, (tR.Left) + counter, (tR.Top) + count, colour)
       End If
>>   Next counter
>>Next count


to look like this...

For count = 1 To (bm.height - 1)
    For counter = 1 To (bm.width - 1)
       colour = GetPixel(myBackBuffer, counter, count)
       If colour <> vbWhite Then
           result = SetPixel(hdc, (tR.Left) + counter, (tR.Top) + count, colour)
       End If
   Next counter
Next count


This modification will allow you to use a multi coloured bitmap (ie . you could write out your name with different colour characters and assuming the background is white it will not be drawn...)

Cheers...
Ber...
0
 

Author Comment

by:soulfyre
ID: 7162139
Sorry, I can't use that.  I have some code like that already that just masks out a bitmap and paints it to the screen but I need something where I can change the text at runtime.

// How long does Experts Exchange archive old questions for and how could I find one from a fair while back?  If I can find my previous question I have a good chunk of the code I used in there, but I can't seem to locate it.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7162207
Go to Member profile link at left of this page.
i think first code from Ber would fine but,if it isn't what you want, why don't use mine instead?
0
 
LVL 2

Expert Comment

by:Ber
ID: 7163624
>>Would you be able to provide some example of what you suggested trying?

I suggested changing each pixel on the screen one by one, I provided an example of this...

Cheers...
Ber...
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
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…

747 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

11 Experts available now in Live!

Get 1:1 Help Now