Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Shaped form
Message
From
31/05/2010 16:24:42
 
 
To
31/05/2010 06:26:34
General information
Forum:
Visual FoxPro
Category:
Other
Title:
Environment versions
Visual FoxPro:
VFP 9 SP2
Miscellaneous
Thread ID:
01466611
Message ID:
01466681
Views:
104
This message has been marked as the solution to the initial question of the thread.
>Hi all, is there a way to give a shape to a form which is not simply rectangular ?
>I need to have elliptical transparent form ....
>
>thanks
>Alessio
Hi,

just happend t read an article by someone, hiding behind "RealShyFox" on an other forum. He published an example howto make an irregular form and also used Sergey's moving form without tittlebar class. Enjoy it;
PUBLIC oform1
 
oForm1 = NEWOBJECT("form1")
oForm1.Show()

RETURN
 
DEFINE CLASS form1 AS form
    
    ShowWindow = 2
      nFlags = 0
 
    ADD OBJECT command1 AS commandbutton WITH ;
        Top = 192, Left = 152, Height = 27, Width = 84, ;
        Caption = "Exit", Name = "Command1"
 
    ADD OBJECT command2 AS commandbutton WITH ;
        Top = 84, Left = 48, Height = 27, Width = 108, ;
        Caption = "Make \<Transparent", SpecialEffect = 2, Name = "Command2"
 
    PROCEDURE Load
        DECLARE Long ReleaseCapture IN WIN32API
        DECLARE Long SendMessage IN WIN32API ;
                Long HWND, Long wMsg, Long wParam, Long Lparam
    ENDPROC
 
     PROCEDURE Init
             
    DECLARE INTEGER SetLayeredWindowAttributes IN win32api;
        INTEGER HWND,  INTEGER crKey, INTEGER bAlpha, INTEGER dwFlags

    *These functions get and set a window's attributes
    DECLARE INTEGER SetWindowLong IN user32.DLL ;
        INTEGER hWnd, INTEGER nIndex, INTEGER dwNewLong

    DECLARE INTEGER GetWindowLong IN user32.DLL ;
        INTEGER hWnd, INTEGER nIndex
        
         WITH Thisform
            .AutoCenter = .T.
            .BorderStyle= 0
            .Caption    = ""
            .Closable    = .F.
            .ControlBox    = .F.
            .TitleBar    = 0
            .BackColor    = RGB(255,0,255)
            .Height        = 370
            .Width        = 410
            .Picture    = "C:\Program Files\Microsoft Visual FoxPro 9\Samples\Solution\Toledo\i_2.bmp"
            .nFlags = 0
        ENDWITH    
        
     ENDPROC
     
     PROCEDURE MakeIrregular
********************************************************************************
* To create a non-rectangular form, a transparent color needs to be set.
* Anything drawn using this color will be transparent, and any
* mouse clicks in these regions will pass through to the visible form.
*
* This technique only works in Windows 2000/XP but it is much more efficient
* than previous techniques of setting a bounding region for the form.
*
* This can be used to create non-rectangluar forms, to create hovering agents,
* or simply to confuse your coworkers <g>.
*
* Although this function makes a form transparent, the Form must be setup
* accept these changes. First, the ShowWindow property MUST BE set to
* 2 'As Top-Level Form'. Otherwise the window cannot be drawn layered.
* Second, if you want to turn off the window's frame, since it will not be
* drawn transparent, you can set the following properties:
*    BorderStyle = 0
*    Caption        = ""
*    Closable    = .F.
*    ControlBox    = .F.
*    TitleBar    = 0
*
********************************************************************************
*-- Pass in the window handle (Thisform.HWIND) and the color to make transparent.
LPARAMETERS nHWND, nColor, nAction

*Constants for SetLayeredWindowAttributs
#DEFINE LWA_COLORKEY    1
#DEFINE LWA_ALPHA        2

*Constants for SetWindowLong and GetWindowLong
#DEFINE GWL_EXSTYLE        -20
#DEFINE WS_EX_LAYERED    0x00080000

LOCAL lnFlags

*The form's window must be set to Layered, so that it is drawn
* in a separate layer.
do case
   case nAction = 1 && Make Transparent
      lnFlags = GetWindowLong(nHWND, GWL_EXSTYLE)    &&Gets the existing flags from the window
      thisform.nFlags = lnFlags
      lnFlags    = BITOR(lnFlags, WS_EX_LAYERED)            &&Appends the Layered flag to the existing ones
      SetWindowLong(nHWND, GWL_EXSTYLE, lnFlags)        &&Sets the new flags to the window
      SetLayeredWindowAttributes(nHWND, nColor, 0, LWA_COLORKEY)
   case nAction = 2 && Make Opaque
      SetWindowLong(nHWND, GWL_EXSTYLE, thisform.nFlags)      &&Sets the original flags to the window
      SetLayeredWindowAttributes(nHWND, nColor, 0, 0)
endcase
    ENDPROC

     
    PROCEDURE MouseDown
        LPARAMETERS nButton, nShift, nXCoord, nYCoord
        #DEFINE WM_SYSCOMMAND 0x112
        #DEFINE WM_LBUTTONUP 0x202
        #DEFINE MOUSE_MOVE 0xf012
 
        IF nButton = 1         && LMB
            = ReleaseCapture()
            * Complete left click by sending 'left button up' message
            = SendMessage(Thisform.HWnd, WM_LBUTTONUP, 0x0, 0x0)
            * Initiate Window Move
            = SendMessage(Thisform.HWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0x0)
        ENDIF
    ENDPROC
    
    PROCEDURE Destroy
        CLEAR DLLS    
    ENDPROC
 
    PROCEDURE command1.Click
        Thisform.Release()
    ENDPROC
    
    PROCEDURE command2.Click
    
   If this.Caption = 'Make \<Transparent'
       Thisform.Makeirregular(Thisform.HWnd,Thisform.BackColor,1)
    This.Caption = 'Make \<Opaque'
        Else
    Thisform.Makeirregular(Thisform.HWnd,Thisform.BackColor,2)
    This.Caption = 'Make \<Transparent'
   Endif
    
    ENDPROC
    
ENDDEFINE
Regards,

Koen
Previous
Reply
Map
View

Click here to load this message in the networking platform