Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


Screen Pal

Posted on 1998-09-11
Medium Priority
Last Modified: 2012-08-14
I would like to create screen pals using VB but I don't know where to start.

What I want to have a little animation running on the screen. It could be a lamb or a persona walking.
I would like to know how I can draw pictures onto the desktop and have them always on top of other windows. It should also be able to receive mouse events like mouse_click.

I hope you experts out there can point out to me which of the APIs would be useful to do this. Would Bitblt be appropriate? But how do I make it be able to receive events? Or Should I have the animation run on a form which is transparent?

Hope someone can help me out.
Thanks a lot in advance.
Question by:Shak
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
LVL 14

Expert Comment

ID: 1434332
Here is code to draw text on the desktop. You have to modify to draw bitmaps.

Option Explicit

' *** Arrange icons on desktop
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const GW_CHILD = 5
Private Const LVA_ALIGNLEFT = &H1
Private Const LVM_ARRANGE = &H1016

' *** Draw on the Desktop
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private 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
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Public Sub DrawDesktopDC(sText As String, nPosX As Long, nPosY As Long, color As OLE_COLOR)
   ' *** Draw on the Desktop
   Dim hdc  As Long
   Dim tR   As RECT
   Dim lCol As Long

   sText = "Have you ever dance with me"
   color = vbGreen

   ' First get the Desktop DC:
   hdc = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)

   ' Draw text on it:
   tR.Left = nPosX
   tR.Top = nPosY
   tR.Right = nPosX + Printer.TextWidth(sText)
   tR.Bottom = nPosY + Printer.TextHeight(sText)
   lCol = GetTextColor(hdc)
   SetTextColor hdc, color
   DrawText hdc, sText, Len(sText), tR, 0
   SetTextColor hdc, lCol

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

End Sub

Here is code to translate OLE_Color to RGB
' *** Get an RGB Colour from an OLE_COLOR
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Const CLR_INVALID = -1

Private Function TranslateColor(ByVal oClr As OLE_COLOR, Optional hPal As Long = 0) As Long
   ' *** Get an RGB Colour from an OLE_COLOR

   ' *** Sometimes you need to know the Red, Green and Blue values of a Visual Basic OLE Colour,
   ' *** particularly if you are going to use the colour in an API function.
   ' *** This functions shows you how to correctly convert an OLE_COLOR type to a RGB value using
   ' *** the OleTranslateColor API call exposed by OLEPRO32.DLL.
   ' *** It works for all colours, whether they are RGB colours, system colours of
   ' *** the type &H80000000F (vbButtonFace) or palette-matching colours such as &H2EECC99.

   ' *** Convert Automation color to Windows color
   If OleTranslateColor(oClr, hPal, TranslateColor) Then
      TranslateColor = CLR_INVALID
   End If

End Function


Author Comment

ID: 1434333
Thanks a lot waty for answering. It does indeed shed light on how to draw text. I had also wanted to drawtext and had thought of using bmps instead.

But the answer is very different for drawing bitmaps. A lot have to be changed. And also, this method of drawtext wouldn't allow me to let the drawn object raise events.

Hope you or someone else can help again!

Thanks in advance.


Expert Comment

ID: 1434334
Another way round is:
- Make a transparent form
- Resize the form as screen.width and height
- Make the form Topmost
- Disable Ctrl_Alt_Del, Ctrl_ESC (if making Screen Saver)
- Draw text, picture on the form
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!


Author Comment

ID: 1434335

Just one more question, but how exactly do I make a form transparent? Hope to get some pointers.

Thanks in advance.


Accepted Solution

shchuka earned 800 total points
ID: 1434336
You can easily set a form to be the top-most so that other windows apper behind it:

Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (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

call SetWindowPos(form.hwnd,-1,0,0,0,0,3)

Then there's API SetWindowRegion() which allows you to set the shape of your form to anything else besides the standard rectangle.  The following example will create a circle-shaped form with diameter 200:

Declare Function CreateEllipticRgn Lib "gdi32" Alias "CreateEllipticRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

dim hRgn as long
hRgn = CreateEllipticRgn(100,100,300,300)
call SetWindowRgn(form.hwnd,hRgn,true)

Look at the API's such as CreateEllipticRgn(),CreateRectRgn(),InvertRgn(), etc. to create the region you want and then set your form's shape to this region.

Quite obviously, you can catch any mouse events you want, since this is a form - and you can move the whole form wherever you want.  On the form you can place whatever controls you like and create whatever drawings you want.

Hope this helps.
LVL 14

Expert Comment

ID: 1434337
Here is how to make a form transparent

' *** Make form transparent
Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Const RGN_AND = 1
Public Const RGN_COPY = 5
Public Const RGN_DIFF = 4
Public Const RGN_OR = 2
Public Const RGN_XOR = 3

Private Type POINTAPI
   x As Long
   y As Long
End Type

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

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

Public Sub MakeFormTransparent(frm As Form)
   ' *** Make a form transparent
   Dim rctClient As RECT, rctFrame As RECT
   Dim hClient As Long, hFrame As Long
   ' *** Grab client area and frame area
   GetWindowRect frm.hWnd, rctFrame
   GetClientRect frm.hWnd, rctClient
   ' *** Convert client coordinates to screen coordinates
   lpTL.x = rctFrame.Left
   lpTL.y = rctFrame.Top
   lpBR.x = rctFrame.Right
   lpBR.y = rctFrame.Bottom
   ScreenToClient frm.hWnd, lpTL
   ScreenToClient frm.hWnd, lpBR
   rctFrame.Left = lpTL.x
   rctFrame.Top = lpTL.y
   rctFrame.Right = lpBR.x
   rctFrame.Bottom = lpBR.y
   rctClient.Left = Abs(rctFrame.Left)
   rctClient.Top = Abs(rctFrame.Top)
   rctClient.Right = rctClient.Right + Abs(rctFrame.Left)
   rctClient.Bottom = rctClient.Bottom + Abs(rctFrame.Top)
   rctFrame.Right = rctFrame.Right + Abs(rctFrame.Left)
   rctFrame.Bottom = rctFrame.Bottom + Abs(rctFrame.Top)
   rctFrame.Top = 0
   rctFrame.Left = 0
   ' *** Convert RECT structures to region handles
   hClient = CreateRectRgn(rctClient.Left, rctClient.Top, rctClient.Right, rctClient.Bottom)
   hFrame = CreateRectRgn(rctFrame.Left, rctFrame.Top, rctFrame.Right, rctFrame.Bottom)
   ' *** Create the new "Transparent" region
   CombineRgn hFrame, hClient, hFrame, RGN_XOR
   ' *** Now lock the window's area to this created region
   SetWindowRgn frm.hWnd, hFrame, True

End Sub


Featured Post

Ask an Anonymous Question!

Don't feel intimidated by what you don't know. Ask your question anonymously. It's easy! Learn more and upgrade.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
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.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…
Suggested Courses

636 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