Transparencies in visual foxpro

Published on by Yousfi Benameur

In visual foxpro the only control having a windows handle (hwnd) is the form.The
transparency can then be applied and monitoring  only to this window.
Some Controls have the backstyle property (0,1) but cannot control the transparency.
The backstyle Specifies whether the background of an object is transparent or opaque.Its
 Available at design time and run time.An object's BackStyle property is ignored if the
 object's Theme property is set to True (.T.).
Majority of  samples below relaive to the form window.

 

Below 6 codes relative to forms & transparency effects


*1*Download the image below as "garden.png" or apply any  transparent png image

http://img.over-blog-kiwi.com/1/43/54/07/20150311/ob_120d2d_garden.png
*the code makes a form (top level or showwindow=0,1 but desktop=.t.) as transparent form.
*see the help in contextuel menu attached to the image.

*the code makes transparency(colorkey+alpha).can adjust any transparency between 0-255 (better 80-255), make borders or no, titlebar or no,the form is movable by mouse.

*Begin code

clea all
Set Defa To Addbs(Justpath(Sys(16,1)))

Publi yform
yform=Newobject("ytranspa0")
yform.Show
Read Events
Return
*
Define Class ytranspa0 As Form
BorderStyle = 0
Top = 29
Left = 65
Height = 380
Width = 590
Desktop = .T. &&is showWindow=0,1
ShowWindow = 2
ShowTips = .T.
Caption = "form Transparency"
TitleBar = 0
BackColor = Rgb(0,0,0)
Name = "Form1"

Add Object image1 As Image With ;
Picture = "garden.png", ;
Height = 237, ;
Left = 96, ;
MousePointer = 15, ;
Top = 36, ;
Width = 348, ;
ToolTipText = "Rightclick to fire the contextuel menu", ;
Name = "Image1"

Procedure maketranspa
Lparameters xtranspa
If Empty(xtranspa)
xtranspa=255
Endi
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000

Local nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor, xtranspa,LWA_ALPHA+LWA_COLORKEY) &&+LWA_ALPHA)
Retu
Endproc

Procedure ymenu
Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
Define Bar 1 Of raccourci Prompt "Help"
Define Bar 2 Of raccourci Prompt "change opacity (0)-80-255"
Define Bar 3 Of raccourci Prompt "change Borderstyle"
Define Bar 4 Of raccourci Prompt "change Titlebar"
Define Bar 5 Of raccourci Prompt "exit"
On Selection Bar 1 Of raccourci _Screen.ActiveForm.yhelp()
On Selection Bar 2 Of raccourci _Screen.ActiveForm.yopa()
On Selection Bar 3 Of raccourci _Screen.ActiveForm.BorderStyle=Iif( _Screen.ActiveForm.BorderStyle=0,2,0)
On Selection Bar 4 Of raccourci _Screen.ActiveForm.TitleBar=Iif( _Screen.ActiveForm.TitleBar=0,1,0)
On Selection Bar 5 Of raccourci _Screen.ActiveForm.Release
Activate Popup raccourci
Endproc

Procedure yhelp

Local m.myvar
    TEXT to m.myvar noshow
-Forms Transparency  can be applied only in the two cases below
-Top level forms (showWindow=2)
-Forms.showWIndow=0,1 but mandatory with desktop=.t.

the windows styles are applied to the window form.This can also be obtained directly
with createWindow API function with the style ex_layered_window.
the API set layeredAttributes can apply two constants to render the transparency
    -Alpha
    -Colorkey
    -or both
-This API dont render better the contours.Its supersteded with the new API updateLayeredWindow
    ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc

Procedure yopa
Local m.xtranspa
m.xtranspa=Int(Val(Inputbox("Change transparency 0-255 (better 80-255)","","200")))
If m.xtranspa=0 Or Empty(m.xtranspa)
m.xtranspa=200
Endi
Thisform.maketranspa(m.xtranspa)
Endproc

Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release
Endi
Endproc

Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Endproc

Procedure Init
*applied on form.showWindow=2 top level form
*applied on form.showWindow=0,1 but mandatory form.desktop=.t.


If ! Thisform.ShowWindow=2 And !Thisform.Desktop=.T.
Messagebox("Transparency set layeredWindow can be applied only to top level form !",16+4096,"Error",1000)
Return .F.
Endi

thisform.image1.picture=getpict("png")  && a transparent PNG
Thisform.maketranspa()
Retu

Endproc


Procedure Load
Declare Integer GetWindowLong In user32;
INTEGER HWnd, Integer nIndex

Declare Integer SetWindowLong In user32;
INTEGER HWnd, Integer nIndex, Integer dwNewLong

Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags

Endproc


Procedure image1.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
lnHandle = Thisform.HWnd &&getFocus()
param1 = 274
param2 = 0xF012
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
Endproc

Procedure image1.RightClick
Thisform.ymenu()
Endproc

Procedure Destroy
Clea Events
Endproc

Enddefine
*

*-- End code

 


Setlayered window API renders only the window contents not tyhe titlebar & borders.Must set these manually.
Setlayered window API renders only the window contents not tyhe titlebar & borders.Must set these manually.
Setlayered window API renders only the window contents not tyhe titlebar & borders.Must set these manually.
Setlayered window API renders only the window contents not tyhe titlebar & borders.Must set these manually.
Setlayered window API renders only the window contents not tyhe titlebar & borders.Must set these manually.
Setlayered window API renders only the window contents not tyhe titlebar & borders.Must set these manually.

Setlayered window API renders only the window contents not tyhe titlebar & borders.Must set these manually.


UpdateLayeredWindow APi is described in this msdn Article:

https://msdn.microsoft.com/en-us/library/windows/desktop/ms633556%28v=vs.85%29.aspx

it replaces the old SetlayeredWindow API (see the code above) who dont render fine the transparency principally in contours and borders of images (bmp,png).

this APi Updates the position, size, shape, content, and translucency of a layered window.

*Windows 8:  The WS_EX_LAYERED style is supported for top-level windows and child windows. Previous Windows
*versions support WS_EX_LAYERED only for top-level windows.
*Here no need to gdiplusX/system.app , i added the APIs doing the job .I make dimensions also retrieved with native image class

-first and before to begin running the code below download this zip from foxite

http://www.foxite.com/uploads/a6322296-e2ab-48bd-ae2a-547504a0e6a5.zip

it contains an application for splash screen using the updateLayeredWindow API.Just extract from here one file : structs.fxp (there is no prg , the authors have not shipped it in the zip).This file contains some structures to apply to the API updateLayeredWindow as shown in the code of alpha1.scx of the zip.


*2*Structs.fxp is recquired to run the code below.

*Begin code

Clea All
Publi m.yrep
m.yrep=Addbs( Justpath(Sys(16,1)))
Set Defa To (yrep)

Do ydeclare

Publi yform
yform=Newobject("ytranspa")
yform.Show
Read Events
Retu
*
Define Class ytranspa As Form
    BorderStyle = 0
    Height = 366
    Width = 541
    ShowWindow = 2  && work also with showWindow =0,1,2 form (but with  desktop=.t. for ShowWindow=0,1)
    ShowInTaskbar = .F.
    AutoCenter = .F.
    Caption = "Form1"
    TitleBar = 1
    BorderStyle=0

    Desktop=.T.
    AlwaysOnTop = .T.
    Name = "Form1"

    Add Object image1 As Image With ;
        Picture = "garden.png", ;
        Stretch = 0, ;
        BackStyle = 0, ;
        Height = 237, ;
        Left = 60, ;
        MousePointer = 15, ;
        Top = 48, ;
        Width = 348, ;
        Name = "image1"

    Procedure Destroy
    Release Proc  Structs

    Clear Dlls "ReleaseCapture", "SendMessage"
    Clea Events
    Endproc

    Procedure Init
    If ! File(m.yrep+"structs.fxp")
        Messagebox("Structs.fxp must be in source folder ! cancelling...",16+4096,"Error",1000)
        Return .F.
    Endi
    Set Procedure To Structs Additive
    Local m.xpict
    m.xpict=Getpict("png")
    Thisform.image1.Picture=m.xpict
    Thisform.TitleBar=0
    If Thisform.ShowWindow=2
        _Screen.WindowState=1
    Endi

    Local loPointSource, loTopPos, loSize, loARGB, loBlend
    loPointSource = Createobject('struct')
    loPointSource.AddField('x', 'LONG', 0)
    loPointSource.AddField('y', 'LONG', 0)

    loTopPos = Createobject('struct')
    loTopPos.AddField('x', 'LONG', 0)
    loTopPos.AddField('y', 'LONG', 0)

    loSize = Createobject('struct')
    loSize.AddField('cx', 'LONG', 0)
    loSize.AddField('cy', 'LONG', 0)

    Local mxtncolor
    m.tncolor=Getcolor()
    If m.tncolor=-1
        m.tncolor=0
    Endi

    Local lnRed,lnGreen,lnBlue,lnAlpha   &&any color
    m.lnRed    = Bitrshift(Bitand(m.tncolor, 0x0000FF),0)
    m.lnGreen    = Bitrshift(Bitand(m.tncolor, 0x00FF00),8)
    m.lnBlue    = Bitrshift(Bitand(m.tncolor, 0xFF0000),16)
    m.lnAlpha=0      &&can change 0-255 function of color you chose to make transparent
    loARGB = Createobject('struct')
    loARGB.AddField('Blue', 'BYTE', m.lnBlue)

    loARGB.AddField('Green', 'BYTE', m.lnGreen)
    loARGB.AddField('Red', 'BYTE', m.lnRed)
    loARGB.AddField('Alpha', 'BYTE', m.lnAlpha)


    loBlend = Createobject('struct')
    loBlend.AddField('BlendOp', 'BYTE', 0)
    loBlend.AddField('BlendFlags', 'BYTE', 0)
    loBlend.AddField('SourceConstantAlpha', 'BYTE', 0)
    loBlend.AddField('AlphaFormat', 'BYTE', 0)

*https://msdn.microsoft.com/en-us/library/windows/desktop/ms633556%28v=vs.85%29.aspx
    #Define ULW_COLORKEY 0x00000001
    #Define ULW_ALPHA    0x00000002
    #Define ULW_OPAQUE   0x00000004

    #Define AC_SRC_OVER  0x00
    #Define AC_SRC_ALPHA 0x01

    #Define GWL_EXSTYLE        -20
    #Define WS_EX_LAYERED    0x00080000

 

    Local screenDc, memDc, hBitmap, oldBitmap, loBitmap As xfcBitmap
    screenDc = GetDC(0)
    memDc = CreateCompatibleDC(screenDc)

    nBitmap=0
    hbm=0
    GdipCreateBitmapFromFile(Strconv(This.image1.Picture+0h00,5),@nBitmap)
    GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)

    loBitmap=nBitmap
    hBitmap=hbm
    oldBitmap = SelectObject(memDc, hBitmap)

    Local oo
    oo=Createobject("image")
    oo.Picture=This.image1.Picture

    loSize.fld['cx'] = oo.Width  &&loBitmap.Width
    loSize.fld['cy'] = oo.Height   &&loBitmap.Height
    oo=Null

    loPointSource.fld['x'] = 0
    loPointSource.fld['Y'] = 0

    loTopPos.fld['x'] = This.Left
    loTopPos.fld['Y'] = This.Top

    loBlend.fld['BlendOp'] = AC_SRC_OVER
    loBlend.fld['BlendFlags'] = 0
    loBlend.fld['SourceConstantAlpha'] = 255

    loBlend.fld['AlphaFormat'] = AC_SRC_ALPHA

    Local lcTopPos, lcSize, lcPointSource, lcBlend, lnFlags
    lcTopPos = loTopPos.Structure
    lcSize = loSize.Structure
    lcPointSource = loPointSource.Structure
    lcBlend = loBlend.Structure

    SetWindowLong(This.HWnd, GWL_EXSTYLE, WS_EX_LAYERED)
    UpdateLayeredWindow(This.HWnd, screenDc, @lcTopPos, @lcSize, memDc, @lcPointSource, 0, @lcBlend,ULW_ALPHA+ ULW_COLORKEY)

    ReleaseDC(0, screenDc)
    If (hBitmap != 0)
        SelectObject(memDc, oldBitmap)
        DeleteObject(hBitmap)
    Endif
    DeleteDC(memDc)

    Store Null To loBitmap

    Clear Dlls "SetWindowLong", ;
        "UpdateLayeredWindow", "GetDC", "ReleaseDC", "CreateCompatibleDC", ;
        "DeleteDC", "SelectObject", "DeleteObject"

    Store Null To loPointSource, loTopPos, loSize, loARGB, loBlend
    Endproc

    Procedure KeyPress
    Lparameters nKeyCode, nShiftAltCtrl
    If nKeyCode==27
        Thisform.Release()

    Endif
    Endproc

    Procedure image1.MouseDown  &&move the form without its titlebar
    Lparameters nButton, nShift, nXCoord, nYCoord
    lnHandle = Thisform.HWnd  &&GetFocus()
    param1 = 274
    param2 = 0xF012
    bb=ReleaseCapture()
    bb=SendMessage(lnHandle, param1, param2,0)
    Endproc

    Procedure image1.RightClick
    Thisform.ymenu()
    Endproc
    Procedure ymenu
    Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
    Define Bar 1 Of raccourci Prompt "Help"
    Define Bar 2 Of raccourci Prompt "exit"

    On Selection Bar 1 Of raccourci   _Screen.ActiveForm.yhelp()
    On Selection Bar 2 Of raccourci   _Screen.ActiveForm.Release
    Activate Popup raccourci
    Endproc

    Procedure yhelp
    Local m.myvar
    TEXT to m.myvar noshow
-Forms Transparency  can be applied only in the two cases below
-Top level forms (showWindow=2)
-Forms.showWIndow=0,1 but mandatory with desktop=.t. (child windows)

the windows styles are applied to the window form.This can also be obtained directly
with createWindow API function with the style ex_layered_window.
the API set UpdatelayeredAttributes can apply two constants to render the transparency
     -ULW_COLORKEY
     -ULW_ALPHA
     -ULW_OPAQUE

-This API renders fine the contours of PNG transparent images.It renders entier window (form).
-the form is movable by mousedown on image.
    ENDTEXT

    Messagebox(m.myvar,0+32+4096,"Summary help")
    Endproc

    Procedure Destroy
    Clea Events
    Endproc

Enddefine

Procedure ydeclare

Declare Long    GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long    GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap

Declare Integer SetWindowLong In user32.Dll ;
    Integer HWnd, Integer nIndex, Integer dwNewLong

Declare Integer UpdateLayeredWindow In User32.Dll ;
    Integer HWnd, ;
    Integer hdcDst, ;
    String @ pptDst, ;
    String @ psize, ;
    Integer hdcSrc, ;
    String @ pprSrc, ;
    Integer crKey, ;
    String @ pblend, ;
    Integer dwFlags

Declare Integer GetDC In User32.Dll ;
    Integer HWnd

Declare Integer ReleaseDC In User32.Dll ;
    Integer HWnd, ;
    Integer hDC

Declare Integer CreateCompatibleDC In Gdi32.Dll ;
    Integer hDC

Declare Integer DeleteDC In Gdi32.Dll ;
    Integer hDC

Declare Integer SelectObject In Gdi32.Dll ;
    Integer hDC, ;
    Integer hObject

Declare Integer DeleteObject In Gdi32.Dll ;
    Integer hObjectendproc

Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
Endproc

*End code


Transparencies in visual foxpro
Transparencies in visual foxpro
Transparencies in visual foxpro

can also download from foxite (same thread as above) the zip using the setlayeredWindow API to make form transparency.there is an exe file with a prg+2 forms making same effect as the first code above.

http://www.foxite.com/uploads/b1ac7e1f-362e-4d5c-95b0-c08ab748df5b.zip

This code uses the setLayeredWindow API.See the contours are not rendered as well.


Transparencies in visual foxpro

*3*- This code use setLayeredWindow API to make transparency on a top level form with image and grid

Dblclick on form borders to switch between form transparent and opaque.

*Begin code

publi oform
oform=newObject("ytransp")
oform.show
read events
return
*
DEFINE CLASS ytransp AS form
    DataSession = 1
    BorderStyle = 3
    Height = 440
    Width = 735
    ShowWindow = 2
    DoCreate = .T.
    AutoCenter = .T.
    Caption = "DBLclick to switch opaque- transparent form"
    KeyPreview = .T.
    BackColor = RGB(0,0,0)
    yclick = 0
    Name = "Form1"

    ADD OBJECT grid1 AS grid WITH ;
        GridLines = 0, ;
        Height = 397, ;
        Left = 24, ;
        Top = 12, ;
        Width = 684, ;
        Name = "Grid1"

    PROCEDURE ytransp
        #DEFINE LWA_COLORKEY 1
        #DEFINE LWA_ALPHA 2
        #DEFINE GWL_EXSTYLE -20
        #DEFINE WS_EX_LAYERED 0x80000
            LOCAL nExStyle, nRgb, nAlpha, nFlags
            nExStyle = GetWindowLong(THISform.HWnd, GWL_EXSTYLE)
            nExStyle = BITOR(nExStyle, WS_EX_LAYERED)
            = SetWindowLong(THISform.HWnd, GWL_EXSTYLE, nExStyle)

           = SetLayeredWindowAttributes(THISform.HWnd, rgb(0,255,0), 190,LWA_COLORKEY+LWA_ALPHA)
           
    ENDPROC

    PROCEDURE yopaque
        #DEFINE LWA_COLORKEY 1
        #DEFINE LWA_ALPHA 2
        #DEFINE GWL_EXSTYLE -20
        #DEFINE WS_EX_LAYERED 0x80000
        
            LOCAL nExStyle
            nExStyle = GetWindowLong(THISform.HWnd, GWL_EXSTYLE)
            nExStyle = BITXOR(nExStyle, WS_EX_LAYERED)
            = SetWindowLong(THISform.HWnd, GWL_EXSTYLE, nExStyle)
            
         thisform.cls
        thisform.backcolor=thisform.backcolor   &&rgb(0,255,0)
         thisform.refresh
    ENDPROC

    PROCEDURE DblClick
        with this
        .yclick=.yclick+1
        if .yclick>1
        .yclick=0
        endi
        this.lockscreen=.t.
        do case
        case .yclick=0
        this.ytransp()

        case .yclick=1
        this.yopaque()
        endcase
        this.lockscreen=.f.
        endwith
    ENDPROC

    PROCEDURE Init
        local m.mypict
        text to m.mypict noshow
        424D76060000000000003600000028000000210000001000000001001800000000004006000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00FFFFFF303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000303030FFFFFF00FFFFFF303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030303030FFFFFF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00
        endtext

        this.addObject("img","image")
        with this.img
        .left=0
        .top=0
        .width=this.width
        .height=this.height
        .stretch=2
        *.picture="c:\fonds.bmp"
        .pictureVal=strconv(myPict,16)
        .anchor=15
        .zorder(1)
        .visible=.t.
        endwith
      
  bindevent(this.img,[dblclick],;
this,[DBLCLICK])

        this.ytransp()
        
         with this.grid1
          .recordsource="ycurs"
          .recordsourcetype=1
          .HeaderHeight=30
          .setall("fontbold",.t.,"header")
          .setall("fontname","script","header")
          .setall("fontsize",24,"header")
          .setall("forecolor",255,"header")
          .gridLines=0
          .deleteMark=.f.
          .autofit()
          .anchor=15
          .setall("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255), RGB(204,255,153))", "Column")
         endwith
    ENDPROC

    PROCEDURE Load
        DECLARE INTEGER GetWindowLong IN user32;
                INTEGER hWnd, INTEGER nIndex
        
            DECLARE INTEGER SetWindowLong IN user32;
                INTEGER hWnd, INTEGER nIndex, INTEGER dwNewLong
        
            DECLARE INTEGER SetLayeredWindowAttributes IN user32;
                INTEGER hwnd, INTEGER crKey,;
                SHORT bAlpha, INTEGER dwFlags
                
        close data all
        select * from (home(2)+"data\customer")    into cursor ycurs
        sele ycurs
    ENDPROC

    PROCEDURE Destroy
        clea events
    ENDPROC

ENDDEFINE
*

*End code

 


Transparencies in visual foxpro
can build a media player with this image and make the colorkey rgb(0,255,0) transparent.add transparent  clickable shapes...can the skin the form. with this way..as the mp3 player in image above...
can build a media player with this image and make the colorkey rgb(0,255,0) transparent.add transparent  clickable shapes...can the skin the form. with this way..as the mp3 player in image above...
can build a media player with this image and make the colorkey rgb(0,255,0) transparent.add transparent  clickable shapes...can the skin the form. with this way..as the mp3 player in image above...

can build a media player with this image and make the colorkey rgb(0,255,0) transparent.add transparent clickable shapes...can the skin the form. with this way..as the mp3 player in image above...



*4* this lightbox effect uses a shape but with some  transparency given by the
*!* vfp native drawMode property (here set to 9).

*:* can have many other  effects with varying the shape backcolor property.

*Begin Code

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Return

Define Class asup As Form
    Height = 422
    Width = 610
    ShowWindow = 2
    ShowTips = .T.
    AutoCenter = .T.
    Caption = "mutli color Lightbox on vfp form"
    Name = "Form1"

    Add Object shape1 As Shape With ;
        Top = 0, ;
        Left = 0, ;
        Height = 423, ;
        Width = 611, ;
        Anchor = 15, ;
        DrawMode = 9, ;
        Visible = .F., ;
        SpecialEffect = 0, ;
        BackColor = Rgb(45,45,45), ;
        Name = "Shape1"

    Add Object command1 As CommandButton With ;
        Top = 393, ;
        Left = 283, ;
        Height = 27, ;
        Width = 84, ;
        FontSize = 11, ;
        Anchor = 768, ;
        Caption = "Click me !", ;
        MousePointer = 15, ;
        ForeColor = Rgb(255,0,0), ;
        BackColor = Rgb(0,255,0), ;
        Name = "Command1"

    Add Object grid1 As Grid With ;
        Anchor = 15, ;
        DeleteMark = .F., ;
        GridLines = 0, ;
        Height = 294, ;
        Left = 34, ;
        Top = 81, ;
        Width = 539, ;
        Name = "Grid1"

    Add Object image1 As Image With ;
        Picture =Home()+"graphics\icons\elements\earth.ico", ;
        Stretch = 2, ;
        BackStyle = 0, ;
        Height = 62, ;
        Left = 481, ;
        Top = 5, ;
        Width = 69, ;
        Name = "Image1"

    Add Object optiongroup1 As OptionGroup With ;
        AutoSize = .T., ;
        ButtonCount = 5, ;
        Anchor = 768, ;
        BackStyle = 0, ;
        BorderStyle = 0, ;
        Value = 1, ;
        Height = 28, ;
        Left = 16, ;
        MousePointer = 15, ;
        Top = 11, ;
        Width = 110, ;
        BackColor = Rgb(45,45,45), ;
        ToolTipText = "Change lightbox colors here", ;
        Name = "Optiongroup1", ;
        Option1.Caption = "", ;
        Option1.Value = 1, ;
        Option1.Height = 17, ;
        Option1.Left = 5, ;
        Option1.Top = 6, ;
        Option1.Width = 18, ;
        Option1.AutoSize = .T., ;
        Option1.Name = "Option1", ;
        Option2.Caption = "", ;
        Option2.Height = 17, ;
        Option2.Left = 26, ;
        Option2.Top = 6, ;
        Option2.Width = 18, ;
        Option2.AutoSize = .T., ;
        Option2.Name = "Option2", ;
        Option3.Caption = "", ;
        Option3.Height = 17, ;
        Option3.Left = 47, ;
        Option3.Top = 6, ;
        Option3.Width = 18, ;
        Option3.AutoSize = .T., ;
        Option3.Name = "Option3", ;
        Option4.Caption = "", ;
        Option4.Height = 17, ;
        Option4.Left = 67, ;
        Option4.Top = 6, ;
        Option4.Width = 18, ;
        Option4.AutoSize = .T., ;
        Option4.Name = "Option4", ;
        Option5.Caption = "", ;
        Option5.Height = 17, ;
        Option5.Left = 87, ;
        Option5.Top = 6, ;
        Option5.Width = 18, ;
        Option5.AutoSize = .T., ;
        Option5.Name = "Option5"

    Add Object label1 As Label With ;
        AutoSize = .T., ;
        FontSize = 10, ;
        BackStyle = 0, ;
        Caption = "Lightbox colors", ;
        Height = 18, ;
        Left = 30, ;
        Top = 54, ;
        Width = 90, ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Label1"

    Add Object shape2 As Shape With ;
        Top = 15, ;
        Left = 138, ;
        Height = 25, ;
        Width = 33, ;
        Anchor = 768, ;
        BorderWidth = 2, ;
        BackColor = Rgb(45,45,45), ;
        BorderColor = Rgb(255,0,0), ;
        Name = "Shape2"

    Procedure Destroy
    Clea Events
    Endproc

    Procedure Load
    Sele * From Home()+"samples\data\customer" Into Cursor ycurs
    Endproc

    Procedure Init
    With This.grid1
        .RecordSource="ycurs"
        .AutoFit()
        .SetAll("DynamicBackColor", ;
            "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255)    , RGB(128,200,190))", "Column")
    Endwith
    Endproc

    Procedure command1.Click
    With Thisform.shape1
        .BackColor=Thisform.shape2.BackColor
        .ZOrder(0)
        .Visible=.T.
        Messagebox("Run the form you want here",0+32+4096,"")
        .Visible=.F.
    Endwith
    Endproc

    Procedure optiongroup1.InteractiveChange
    Do Case
    Case This.Value=1
        Thisform.shape2.BackColor=Rgb(45,45,45)
    Case This.Value=2
        Thisform.shape2.BackColor=Rgb(74,0,0)
    Case This.Value=3
        Thisform.shape2.BackColor=Rgb(0,85,0)
    Case This.Value=4
        Thisform.shape2.BackColor=Rgb(0,0,180)
    Case This.Value=5
        Local xcolor
        xcolor=Getcolor()
        If xcolor#-1
            Thisform.shape2.BackColor=m.xcolor
        Endi

    Endcase
    Endproc

Enddefine

*Endcode


Native shape drawmode property applies coored filters  on the background(here the form)
Native shape drawmode property applies coored filters  on the background(here the form)
Native shape drawmode property applies coored filters  on the background(here the form)

Native shape drawmode property applies coored filters on the background(here the form)


*5*Making a form fading can produced with APIs setLayeredWindow
*Simply increase or decrease the opacity (transparency) from 0-255 or 255 to 0 with timeout.

*Begin code
Publi oform
oform=Newobject("yfade")
oform.Show
Read Events
Retu
*
Define Class yfade  As Form
    Height = 368
    Width = 566
    ShowWindow=0   &&or 1 but mandatory desktop=.t.-Works also on showWindow=2
    Desktop = .T.
    AutoCenter = .T.
    Caption = "Fade effect on form"
    BackColor = Rgb(0,0,0)
    Name = "Form1"

    Procedure Load
    Declare Integer SetWindowLong In Win32Api ;
        INTEGER HWnd, Integer Index, Integer NewVal
    Declare Integer SetLayeredWindowAttributes In Win32Api ;
        INTEGER HWnd, String ColorKey, ;
        INTEGER Opacity, Integer Flags
    Declare Sleep In WIN32API Integer Duration
    Endproc

    Procedure Init
* Start by making the form fully transparent
    SetWindowLong(Thisform.HWnd, -20, 0x00080000)
    SetLayeredWindowAttributes(Thisform.HWnd, 0, 0, 2)
    Thisform.Show
* Increase the opacity from 0 to 255 all 80ms to make the fade effect.
    i=0
    Do While .T.
        SetLayeredWindowAttributes(Thisform.HWnd, 0, i, 2)
        i = i + 10
        If i > 255
            Exit
        Endif
        Sleep(80)
    Enddo
    Endproc

    Procedure QueryUnload
* Start by opaque form and decrease the tranparency from 255 to 0
    SetWindowLong(Thisform.HWnd, -20, 0x00080000)
    SetLayeredWindowAttributes(Thisform.HWnd, 0, 0, 2)
    i=255
    Do While .T.
        SetLayeredWindowAttributes(Thisform.HWnd, 0, i, 2)
        i = i - 10
        If i<=0
            Exit
        Endif
        Sleep(80)
    Enddo
     Endproc

Procedure destroy
clea events
endproc
Enddefine
*

*End code

 


In previous posts we have made many form transparencies as glass forms,xor transparent regions ,grid with image,....search by engine  in the blog you can reach many  similar resources.


*6)*

This code can make any shape as form,using the color transparency.
Chose any color , here the green rgb(0,255,0).The form is top level , xitout titlebar and borderstyle=0
the color green is made transparent and the form looks like a round form.
can make with this artifact any irregular form.This is the best and easy way to work with irregular shapes on form
the form is movable any irregular png (with color to make transparent rgb(255,0,128)....

 updated on mardi 17 mars 2015; 12:36:13


*Begin code

set defa to addbs(justpath(sys(16,1)))
*
build the working picture round.png (encoded here)
local m.myvar
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAAMAAAAC0CAIAAABNDbSHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAfhSURBVHhe7dJLjiNJDgTQOsgs5/43mzPUODoIIftlVSIYXw/JDG9jC0l0Ur9+/Y7YwR7RYo9osUe02CNa7BEt9ogWe0SLPaLFHtFij2ixR7TYI1rsES32iBZ7RIs9osUe0WKPaLFHtNg/2//+898WPv6J7J+B/8Hh+Ll3Zn9f3PgyjPFu7O+FW96O8d6B/S1wtgkx8IPZn4wjbfC7GT6+AU94HvszcZU16i9wQvihNXjOk9ifhkv8rC58YRjgZzztGewPwep/UJecIAz2Ax47NfsTsO4/qqNNGUb9I548L/vc2PJ3daKHhOG/4/kzss+KzX5XN3lgeMh3rGIu9vmwze/qDg8Pj/qOtczCPhmWiNr9G4UHguVMwT4Ndofa95uGx4JF3cw+B1b2Ve34A8LDv2Jdd7JPgGW91F4/LCzhhaXdxn4rdvRVrfMjwyq+YoE3sN+H1bzUFj8+rOWFNV7NfhOW8lLLS/4Jy3lhmZey34F1vNTakn+HLS1Y6XXsl2MRi1pV8pewrgWLvYj9WqxgUUtKfgxLW7DeK9gvxOMXtZ5kRVjdgiWfzn4Vnr2oxSSrwwIXrPpc9kvw4EWtJGmGNS5Y+Ins5+Opi1pGsiksc8Haz2I/GY9c1BqSHWGlC5Z/CvuZeN6iFpDsDotdcILj2U/Dwxb19OSgsN4FhziY/TS8aqhHJ4eGJQ8c4mD2c/CkoZ6bnBBWPXCOI9lPwGMW9dbknLDtgaMcxn4CXjLUK5PTwsIHjnIY+9F4xlBPTE4Oax84zTHsh+IBQz0uuSQsf+BAB7AfiumHellySVj+wIEOYD8Oow/1rOTCcIKBM+1lPw5z14OSy8MhBi61i/0gTDzUa5LLwyEGjrWL/QiMO9RTkpvCOQZOtp39CMw61DuSm8I5Bk62nX03Bh3qEcmt4SgDh9vIvhtTDvWC5O5wFw63kX03pqzZkwnCaQZut4V9H+YbavZkjnAdzreFfR/mq6mTacKBON8W9h0Ybqipk2nCgQaO2Gbfgclq5GSycCaO2Gbfgclq3mSycKaBO/bYt2KmoeZN5guX4pQ99q2YqSZNpgzH4pQ99q2YqSZNpgzH4pQ99k0YaKhJkynDsQYO2mDfhGlqzGTicDIO2mDfhGlqxmTicDIO2mDfhGlqxmTicLKBm65l72OOGjCZPhyOs65l72OOmi6ZPhyOs65l72OOmi6ZPhyOs65l72OOmi6ZPhyOs65l72OOmi6ZPhyOs65l72OOmi6ZPhxu4LKr2JuYoEZLHhLOx3FXsTcxQc2VPCScj+OuYm9igporeUg4H8ddxd7EBDVX8pBwPo67ir2JCWqu5CHhfBx3FXsTE9RcyUPC+TjuKvYmJqi5koeE83HcVexNTFBzJQ8J5+O4q9ibmKDmSh4SzsdxV7E3MUHNlTwknI/jrmJvYoKaK3lIOB/HXcXexAQ1V/KQcD6Ou4q9iQlqruQh4XwcdxV7ExPUXMlDwvk47ir2JiaouZKHhPNx3FXsfQxRoyXTh8Nx1rXsfcxR0yXTh8Nx1rXsfcxR0yXTh8Nx1rXsfcxR0yXTh8Nx1rXsfcxR0yXTh8Nx1rXsfcxR0yXTh8Nx1rXsmzBKDZhMHE42cNO17JswSs2YTBxOxkEb7JswTc2YTBxOxkEb7JswzVBjJlOGYw0ctMG+FQPVpMmU4Vicsse+FTPVpMmU4Vicsse+FTPVpMmU4Vicsse+A2PVsMlk4UwDd+yx78BYNW8yWTgTR2yz78BkQ42cTBMONHDENvs+DFdTJ9OEA3G+Lez7MF9NnUwTDsT5trDvxog1eDJBOM3A7baw78aINXsyQTgNh9vIvhtTDjV+cms4ysDhNrIfgUGHekRyX7gIJ9vOfgRmHeoRyU3hHAMn285+EMYd6inJ5eEQA8faxX4QJh7qNcnl4RADx9rFfhyGHupByYXhBANn2st+KEYf6lnJVWH/Azfay34oRh/qWcklYfkDBzqA/Wg8YKjHJSeHtQ+c5hj2E/CMoZ6YnBYWvuAux7CfgGcs6qHJOWHbA0c5jP0cPGaohyYnhFUPnONI9tPwpKGemxwaljxwiIPZT8OrFvXo5KCw3gWHOJj9TDxsUU9PdofFLjjB8ewn43mLWkCyI6x0wfJPYT8fj1zUGpJNYZkL1n4W+yV46qKWkTTDGhcs/ET2q/DgRa0kWR0WuGDV57JfiGcvajHJirC6BUs+nf1aPH5R60l+DEtbsN4r2C/HCha1pOQvYV0LFnsR+x1YxEttK/l32NKClV7HfhPW8VI7S/4Jy3lhmZey34elvNTyPj6s5YU1Xs1+K1bzVW3xI8MqvmKBN7BPgB291Do/LCzhK/Z2D/sc2NRXtdcPCA//inXdyT4NVoba8ZuGx4JF3cw+GXaH2vd7hTd+xXKmYJ8PS/yuFv/88C6wllnYZ8U2v6sjPDA85DtWMRf73Njsd3WTh4Thv+P5M7I/AVv+ozrRlGHUv+HVk7I/BLv+QR1tgjDYD3js1OxPw+p/UGe8PIzxM173APZn4gxr1HlPCD+0Bs95EvuTcZWuun8zfEkXT3ge+1vgSBNi4AezvxfOdjvGewf298UtL8MY78b+Gbjx4fi5d2b/YPwJVuJLPo49osUe0WKPaLFHtNgjWuwRLfaIFntEiz2ixR7RYo9osUe02CNa7BEt9ogWe0SLPaLFHtFij1jv96//Ay91QPjWCZBbAAAAAElFTkSuQmCC
endtext
strtofile(strconv(m.myvar,14),"round.png")

Publi yform
yform=Newobject("yround")
yform.Show
Read Events
Return
*
Define Class yround As Form
    BorderStyle = 0
    Top = 5
    Left = 112
    Height = 356
    Width = 378
    ShowWindow = 2
    Caption = "Form1"
    TitleBar = 1
    Name = "Form1"

    Add Object image1 As Image With ;
        Picture = "round.png", ;
        BackStyle = 0, ;
        Height = 358, ;
        stretch=2,;
        Left = 0, ;
        Top = 0, ;
        Width = 381, ;
        Name = "Image1"

    Add Object command1 As CommandButton With ;
        Top = 84, ;
        Left = 231, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontSize = 10, ;
        Caption = "X", ;
        MousePointer = 15, ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command1"

    Add Object label1 As Label With ;
        FontSize = 12, ;
        WordWrap = .T., ;
        Alignment = 2, ;
        Caption = "This is a round top level form made with transparency form(color green).The form is movable by mouse", ;
        Height = 109, ;
        Left = 96, ;
        Top = 131, ;
        Width = 192, ;
        ForeColor = Rgb(0,0,255), ;
        BackColor = Rgb(255,255,0), ;
        Name = "Label1"

    Add Object command2 As CommandButton With ;
        Top = 85, ;
        Left = 205, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontSize = 10, ;
        Caption = "--", ;
        MousePointer = 15, ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command2"

    Add Object image2 As Image With ;
        Stretch = 2, ;
        Height = 49, ;
        Left = 119, ;
        Top = 76, ;
        Width = 60, ;
        Name = "Image2"

    Procedure Init
        Thisform.TitleBar=0
        #Define LWA_COLORKEY 1
        #Define LWA_ALPHA 2
        #Define GWL_EXSTYLE -20
        #Define WS_EX_LAYERED 0x80000

        Local nExStyle, nRgb, nAlpha, nFlags
        nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
        nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
        = SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
        Local ytranspa,nRgb
        ytranspa=255
        nRgb=Rgb(0,255,0)
        = SetLayeredWindowAttributes(Thisform.HWnd, nRgb, ytranspa,LWA_COLORKEY+LWA_ALPHA)
    Endproc

    Procedure Load
        Declare Integer GetWindowLong In user32;
            INTEGER HWnd, Integer nIndex
        Declare Integer SetWindowLong In user32;
            INTEGER HWnd, Integer nIndex, Integer dwNewLong
        Declare Integer SetLayeredWindowAttributes In user32;
            INTEGER HWnd, Integer crKey,;
            SHORT bAlpha, Integer dwFlags
    Endproc

    Procedure image1.MouseDown
        Lparameters nButton, nShift, nXCoord, nYCoord
        This.MousePointer=15
        lnHandle = Thisform.HWnd    
        param1 = 274
        param2 = 0xF012
        Declare Integer ReleaseCapture In WIN32API
        Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
        bb=ReleaseCapture()
        bb=SendMessage(lnHandle, param1, param2,0)
    Endproc

    Procedure command1.Click
        Thisform.Release
    Endproc

    Procedure command2.Click
        Thisform.WindowState=1
    Endproc

    Procedure image2.Init
        This.Picture=Home(1)+"graphics\gifs\morphfox.gif"
    Endproc

    Procedure Destroy
        Clea Events
    Endproc

Enddefine
*

*End code

 


can make any irregular shape as form (with setting  transparency for one color)
can make any irregular shape as form (with setting  transparency for one color)
can make any irregular shape as form (with setting  transparency for one color)

can make any irregular shape as form (with setting transparency for one color)

To be informed of the latest articles, subscribe:
Comment on this post