Screen Pal

Posted on 1998-09-11
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
Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.


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 200 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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

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…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

688 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