Aero glass effect

Published on by Yousfi Benameur

 
This code creates a custom simulation of the known windows aero glass effect.
2 top level forms are used to get this effect.One is always onBottom=.t. and have variable transparency (80-255).The backcolor of this form.can be set also interactively on the second form.
Note that a child form with showWindow=0,1 dont work because the transparency is set to these forms simultaneously with the parent form.
i set a second top level form glowed on the first and raise it always on top.this can be used to do the common asks of a any vfp form.
From this form can command the dimensions of the 2 forms,backcokor,transparency of the first form, reduce,maximize or restore ....can also move the form with mousedown event by mouse.

Tested on windows8.1 & windows10.

Suggestions and Bug Reports are always  Welcome.


Click on code to select [then copy] -click outside to deselect

 
*Begin code
Publi ymain
Set Defa To Addbs(Justpath(Sys(16,1)))
ymain=Newobject("ymaster")
ymain.Show
Read Events
Retu
*
Define Class ymaster As Form
    BorderStyle = 0
    Height = 550
    Width = 800
    ShowWindow = 2
    AutoCenter = .T.
    Caption = "Form1"
    TitleBar = 1
    AlwaysOnBottom = .T.
    BackColor = Rgb(0,0,0)
    ytour = 0
    Name = "YMASTER"
    Dimension aforms[1]

    Procedure ytranspa
        Lparameters ytranspa
        #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(255,255,255), ytranspa,LWA_COLORKEY+LWA_ALPHA)
    Endproc

    Procedure KeyPress
        Lparameters nKeyCode, nShiftAltCtrl
        If nKeyCode=27
            Try
                yslave.Release
            Catch
            Endtry
            Thisform.Release
        Endi
    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 Init
        Publi ymaster,yslave
        _Screen.WindowState=1
        ymaster=Thisform
        Thisform.TitleBar=0
        Thisform.ytour=0

        Thisform.ytranspa(170)
    Endproc

    Procedure Activate
        If Thisform.ytour=0
            Thisform.ytour=1
            yslave=Newobject("yslave")
            yslave.Show
        Endi
    Endproc

    Procedure Resize
        Do Case
            Case  Thisform.WindowState=0 Or Thisform.WindowState=2
                Try
                    yslave.Show
                    yslave.yresize
                Catch
                Endtry

            Case Thisform.WindowState=1
                yslave.Hide
            Otherwise
                yslave.yresize

        Endcase
    Endproc

    Procedure Move
        Lparameters nLeft, nTop, nWidth, nHeight
        Try
            yslave.yresize
        Catch
        Endtry
    Endproc

    Procedure Destroy
        Try
            yslave.Release
        Catch
        Endtry
        Clea Events
    Endproc

    Procedure Click
        This.Resize()
    Endproc

    Procedure ychild
    Endproc

Enddefine
*
*-- EndDefine: ymain


Define Class yslave As Form
    BorderStyle = 3   &&0
    Top = 13
    Left = 23
    Height = 450
    Width = 748
    ShowWindow = 2
    ShowInTaskbar = .F.
    ShowTips = .T.
    Caption = "Form1"
    Movable = .F.
    TitleBar = 1
    BackColor = Rgb(215,255,174)   &&getcolor()
    delta = 30
    xleft = 0
    xtop = 0
    xwidth = 0
    xheight = 0
    Name = "YSLAVE"

    Add Object image1 As Image With ;
        Picture = Home(1)+"GRAPHICS\GIFS\MORPHFOX.GIF", ;
        Stretch = 2, ;
        backstyle=0  ,;
        Height = 84, ;
        Left = 588, ;
        Top = 7, ;
        Width = 132, ;
        Name = "Image1"

    Add Object grid1 As Grid With ;
        Height = 324, ;
        Left = 48, ;
        Top = 96, ;
        Width = 661, ;
        Name = "Grid1"

    Add Object label1 As Label With ;
        AutoSize = .T., ;
        FontBold = .T., ;
        FontName = "BATAVIA", ;
        FontSize = 28, ;
        BackStyle = 0, ;
        Caption = "Aero Effect", ;
        Height = 53, ;
        Left = 12, ;
        Top = 12, ;
        Width = 260, ;
        ForeColor = Rgb(0,0,0), ;
        Name = "Label1"

    Add Object label2 As Label With ;
        AutoSize = .T., ;
        FontBold = .T., ;
        FontName = "BATAVIA", ;
        FontSize = 28, ;
        BackStyle = 0, ;
        Caption = "Aero Effect", ;
        Height = 53, ;
        Left = 16, ;
        Top = 15, ;
        Width = 260, ;
        ForeColor = Rgb(255,128,0), ;
        Name = "Label2"

    Add Object command1 As CommandButton With ;
        Top = 12, ;
        Left = 350, ;
        Height = 25, ;
        Width = 25, ;
        FontName = "Webdings", ;
        Caption = "5", ;
        ToolTipText = "Top", ;
        Name = "Command1"


    Add Object command2 As CommandButton With ;
        Top = 38, ;
        Left = 376, ;
        Height = 25, ;
        Width = 25, ;
        FontName = "Webdings", ;
        Caption = "4", ;
        ToolTipText = "Width", ;
        Name = "Command2"

    Add Object command3 As CommandButton With ;
        Top = 37, ;
        Left = 326, ;
        Height = 25, ;
        Width = 25, ;
        FontName = "Webdings", ;
        Caption = "3", ;
        ToolTipText = "Left", ;
        Name = "Command3"

    Add Object command4 As CommandButton With ;
        Top = 62, ;
        Left = 351, ;
        Height = 25, ;
        Width = 25, ;
        FontName = "Webdings", ;
        Caption = "6", ;
        ToolTipText = "Height", ;
        Name = "Command4"

    Add Object command5 As CommandButton With ;
        Top = 36, ;
        Left = 351, ;
        Height = 25, ;
        Width = 25, ;
        FontName = "Webdings", ;
        Caption = "1", ;
        ToolTipText = "Autocenter", ;
        Name = "Command5"

    Add Object command6 As CommandButton With ;
        Top = 12, ;
        Left = 420, ;
        Height = 25, ;
        Width = 25, ;
        FontName = "Webdings", ;
        Caption = "1", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command6"

    Add Object command7 As CommandButton With ;
        Top = 11, ;
        Left = 447, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        Caption = "-", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command7"

    Add Object command8 As CommandButton With ;
        Top = 10, ;
        Left = 475, ;
        Height = 25, ;
        Width = 25, ;
        Caption = "X", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command8"

    Add Object spinner2 As Spinner With ;
        Height = 24, ;
        KeyboardHighValue = 100, ;
        KeyboardLowValue = 10, ;
        Left = 411, ;
        MousePointer = 15, ;
        SpinnerHighValue = 100.00, ;
        SpinnerLowValue =  10.00, ;
        ToolTipText = "offset", ;
        Top = 40, ;
        Width = 60, ;
        Value = 35, ;
        enabled=.F.,;
        Name = "Spinner2"

    Add Object spinner1 As Spinner With ;
        Height = 25, ;
        KeyboardHighValue = 255, ;
        KeyboardLowValue = 80, ;
        Left = 473, ;
        MousePointer = 15, ;
        SpinnerHighValue = 255.00, ;
        SpinnerLowValue =  80.00, ;
        ToolTipText = "transparency 80-255", ;
        Top = 42, ;
        Width = 61, ;
        Value = 170, ;
        Name = "Spinner1"

    Add Object command9 As CommandButton With ;
        Top = 66, ;
        Left = 410, ;
        Height = 25, ;
        Width = 85, ;
        Caption = "Color Aero", ;
        MousePointer = 15, ;
        BackColor = Rgb(255,128,0), ;
        Name = "Command9"

    Add Object command10 As CommandButton With ;
        Top = 66, ;
        Left = 496, ;
        Height = 25, ;
        Width = 25, ;
        Caption = "?", ;
        fontsize=12,;
        fontbold=.T.,;
        forecolor=255,;
        MousePointer = 15, ;
        BackColor = Rgb(255,128,0), ;
        Name = "command10"

    Add Object check1 As Checkbox With ;
        left=274,;
        top=66,;
        tooltiptext="borderstyle 3 or 0",;
        value=1,;
        visible=.T.,;
        caption="",;
        backstyle=0,;
        autosize=.T.,;
        name="check1"


    Add Object ycom1 As ycom With ;
        visible=.T.
    Name="ycom1"

    Procedure yresize
        With Thisform
            .Top   =ymaster.Top+Thisform.delta
            .Left  =ymaster.Left+Thisform.delta
            .Width =ymaster.Width-2*Thisform.delta
            .Height=ymaster.Height-2*Thisform.delta
        Endwith
        =BringWindowToTop(Thisform.HWnd)
    Endproc

    Procedure KeyPress
        Lparameters nKeyCode, nShiftAltCtrl
        If nKeyCode=27
            Try
                ymaster.Release
            Catch
            Endtry
            Thisform.Release
        Endi
    Endproc

    Procedure check1.InteractiveChange
        Thisform.BorderStyle=Iif(This.Value=1,3,0)
        If This.Value=1
            Thisform.spinner2.Enabled=.F.
        Else
            Thisform.spinner2.Enabled=.T.
        Endi
    Endproc

    Procedure Load
        Declare Integer BringWindowToTop In user32   Integer
        Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
    Endproc

    Procedure Init
        Thisform.TitleBar=0
        Local ok
        ok=.F.
        With _Screen
            For i=1 To .FormCount
                If Lower(.Forms(i).Name)=="ymaster"
                    ok=.T.
                    Exit
                Endi
            Endfor
        Endwith

        If ok=.F.
            Return .F.
        Endi

        With Thisform.grid1
            .RecordSource="ycurs"
            .RecordSourceType=1
            .Anchor=15
            .GridLines=0
            .DeleteMark=.F.
            .SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255), RGB(188,181,225))", "Column")
        Endwith
        Thisform.delta=35
        Thisform.SetAll("mousepointer",15,"commandbutton")
        Thisform.yresize()
    Endproc

    Procedure Click
        Thisform.yresize()
    Endproc

    Procedure command1.Click
        If ymaster.Top>4
            ymaster.Top=ymaster.Top-4
            Thisform.yresize()
        Endi
    Endproc

    Procedure command2.Click
        ymaster.Width=ymaster.Width+4
        Thisform.yresize()
    Endproc

    Procedure command3.Click
        If ymaster.Left>4
            ymaster.Left=ymaster.Left-4
            Thisform.yresize()
        Endi
    Endproc

    Procedure command4.Click
        ymaster.Height=ymaster.Height+4
        Thisform.yresize()
    Endproc


    Procedure command5.Click
        ymaster.AutoCenter=.T.
        Thisform.yresize()
    Endproc

    Procedure command6.Click
        With Thisform
            .xleft=.Left
            .xtop=.Top
            .xwidth=.Width
            .xheight=.Height
        Endwith


        Do Case
            Case ymaster.WindowState=0
                ymaster.WindowState=2
                This.Caption="2"

            Case ymaster.WindowState=2
                ymaster.WindowState=0
                This.Caption="1"
                With Thisform
                    .Left=.xleft
                    .Top=.xtop
                    .Width=.xwidth
                    .Height=.xheight
                Endwith
        Endcase
        Thisform.yresize()
    Endproc

    Procedure command7.Click
        ymaster.WindowState=1
        Thisform.Hide
    Endproc

    Procedure command8.Click
        ymaster.Release
    Endproc

    Procedure spinner2.InteractiveChange
        Thisform.delta=This.Value
        Thisform.yresize()
    Endproc

    Procedure spinner1.InteractiveChange
        ymaster.ytranspa(This.Value)
    Endproc

    Procedure command9.Click
        Local m.xcolor
        m.xcolor=Getcolor()
        If ! m.xcolor=-1
            ymaster.BackColor=m.xcolor
        Endi
    Endproc

    Procedure MouseDown
        Lparameters nButton, nShift, nXCoord, nYCoord

        ymaster.Hide
        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)
        Thisform.zresize()
    Endproc

    Procedure zresize
        With ymaster
            .Top   =This.Top-Thisform.delta
            .Left  =This.Left-Thisform.delta
            .Width =This.Width+2*Thisform.delta+Iif(Thisform.BorderStyle=3,2*Sysmetric(3),0)
            .Height=This.Height+2*Thisform.delta+Iif(Thisform.BorderStyle=3,Sysmetric(4)+Sysmetric(3),0)
            .Show
        Endwith
        =BringWindowToTop(Thisform.HWnd)
    Endproc

    Procedure Resize
        Thisform.zresize()
    Endproc

    Procedure command10.Click
        Local m.myvar
        TEXT to m.myvar noshow
this code create a simulation  of the known windows aero glass effect.
2 top level forms  are used to get this effect.One is always onBottom=.t. and have variable
transparency (80-255).The backcolor of this form.can be set also interactively on the second form.
Note that a form with showWindow=0,1 dont work because the transparency is set to these forms simultaneously
with the parent form.
i set a second top level form glowed on the first and raise it always on top.this can be used to do the common
tasks of a vfp form.
from this form can command the dimensions of the 2 forms,backcokor,transparency of the first form,reduce,
maximize or restore ....can also move the form with mousedown event by mouse.
        ENDTEXT
        Messagebox(m.myvar,0+32+4096,"Summary help")
    Endproc

Enddefine
*-- EndDefine: yslave

*
Define Class ycom As OptionGroup
    AutoSize = .T.
    ButtonCount = 1
    Anchor = 0
    BackStyle = 0
    BorderStyle = 0
    Value = 1
    Height = 27
    Left = 274
    Top = 40
    Width = 28
    Name = "Optiongroup1"
    Option1.Anchor = 0
    Option1.BackStyle = 0
    Option1.Caption = ""
    Option1.Value = 1
    Option1.Height = 17
    Option1.Left = 5
    Option1.MousePointer = 15
    Option1.ToolTipText = "Show/hide commands"
    Option1.Top = 5
    Option1.Width = 18
    Option1.AutoSize = .T.
    Option1.Name = "Option1"

    Procedure InteractiveChange
        Do Case
            Case This.Value=1
                For i=1 To 10
                    m.x="thisform.command"+Trans(i)+".visible"
                    &x=.T.
                Endfor
                Thisform.spinner1.Visible=.T.
                Thisform.spinner2.Visible=.T.

            Case This.Value=0
                For i=1 To 10
                    m.x="thisform.command"+Trans(i)+".visible"
                    &x=.F.
                Endfor
                Thisform.spinner1.Visible=.F.
                Thisform.spinner2.Visible=.F.
        Endcase
    Endproc
Enddefine

*-- EndDefine: ycom

*End code


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