Solved

Screen Pal

Posted on 1998-09-11
6
642 Views
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.
0
Comment
Question by:Shak
6 Comments
 
LVL 14

Expert Comment

by:waty
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

0
 

Author Comment

by:Shak
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.

0
 

Expert Comment

by:dphuong
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
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:Shak
ID: 1434335
Interesting.

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

Thanks in advance.

0
 
LVL 2

Accepted Solution

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

Expert Comment

by:waty
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
   Dim lpTL As POINTAPI, lpBR As POINTAPI
   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

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

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no 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.
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…

760 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

19 Experts available now in Live!

Get 1:1 Help Now