Visual foxpro Grid with background image

Published on by Yousfi Benameur

*This code allows to make some cosmetics on a vfp grid and can set an image background by an artifact.
*it uses 2 top level forms "glowed" with coding events  and transparency with APIs.
*There is some flickers appearing when manipulate these objects but its a style exercice.

*see the summary help in the main prg.
*I applied same method with a treeview.
(i publish it later)

*Save this code as ymaster.prg.it calls the second code in yslave.prg (below after this)

*download 4 images below needed in code.

 

*Begin Code

*ymaster.prg
Publi yform
yform=Newobject("ygrid_image")
yform.Show
Read Events
Return
*
Define Class ygrid_image As Form
    Height = 529
    Width = 883
    ShowWindow = 2
    ShowTips = .T.
    AutoCenter = .T.
    Caption = "Grid with background image"
    BackColor = Rgb(0,0,0)
    yclick = 0
    Name = "YMASTER"

    Add Object grid1 As Grid With ;
        FontBold = .T., ;
        Anchor = 15, ;
        DeleteMark = .T., ;
        GridLines = 0, ;
        HeaderHeight = 25, ;
        Height = 468, ;
        Left = 0, ;
        Top = 0, ;
        Width = 889, ;
        HighlightStyle = 1, ;
        Name = "Grid1"

    Add Object spinner1 As Spinner With ;
        Anchor = 768, ;
        Height = 25, ;
        KeyboardHighValue = 255, ;
        KeyboardLowValue = 80, ;
        Left = 14, ;
        SelectOnEntry = .T., ;
        SpinnerHighValue = 255.00, ;
        SpinnerLowValue =  80.00, ;
        ToolTipText = "Adjust transparency", ;
        Top = 493, ;
        Width = 54, ;
        Value = 170, ;
        Name = "Spinner1"

    Add Object command1 As CommandButton With ;
        Top = 493, ;
        Left = 72, ;
        Height = 25, ;
        Width = 127, ;
        Anchor = 768, ;
        Caption = "Change bakckground", ;
        ToolTipText = "Any picture", ;
        Name = "Command1"


    Add Object label4 As Label With ;
        AutoSize = .T., ;
        Anchor = 768, ;
        Caption = "Change header colors", ;
        Height = 17, ;
        Left = 200, ;
        MousePointer = 15, ;
        Top = 497, ;
        Width = 125, ;
        BackColor = Rgb(255,196,196), ;
        ToolTipText = "Random headers colors", ;
        Name = "Label4"

    Add Object command3 As CommandButton With ;
        Top = 496, ;
        Left = 327, ;
        Height = 20, ;
        Width = 88, ;
        Anchor = 768, ;
        Caption = "L-Colors", ;
        ToolTipText = "Lines random lighten colors", ;
        BackColor = Rgb(0,255,0), ;
        Name = "Command3"

    Add Object command6 As CommandButton With ;
        Top = 496, ;
        Left = 417, ;
        Height = 20, ;
        Width = 60, ;
        Anchor = 768, ;
        Caption = "C-Colors", ;
        ToolTipText = "Columns random  lighten colors", ;
        BackColor = Rgb(255,255,0), ;
        Name = "Command6"

    Add Object command2 As CommandButton With ;
        Top = 493, ;
        Left = 553, ;
        Height = 25, ;
        Width = 51, ;
        FontSize = 8, ;
        Anchor = 768, ;
        Caption = "Refresh", ;
        BackColor = Rgb(128,0,64), ;
        Name = "Command2"

    Add Object command4 As CommandButton With ;
        Top = 493, ;
        Left = 606, ;
        Height = 25, ;
        Width = 41, ;
        FontSize = 8, ;
        Anchor = 768, ;
        Caption = "Center", ;
        BackColor = Rgb(128,0,64), ;
        Name = "Command4"

    Add Object command5 As CommandButton With ;
        Top = 493, ;
        Left = 651, ;
        Height = 25, ;
        Width = 95, ;
        Anchor = 768, ;
        Caption = "Grid Forecolor", ;
        ToolTipText = "Random lighten grid  forecolor", ;
        BackColor = Rgb(0,255,0), ;
        Name = "Command5"

    Add Object label1 As Label With ;
        AutoSize = .T., ;
        FontBold = .T., ;
        FontSize = 12, ;
        Anchor = 768, ;
        BackStyle = 0, ;
        Caption = "Bk", ;
        Height = 22, ;
        Left = 749, ;
        MousePointer = 15, ;
        Top = 496, ;
        Width = 23, ;
        ForeColor = Rgb(0,255,0), ;
        ToolTipText = "Headers with green/black colors", ;
        Name = "Label1"

    Add Object check1 As Checkbox With ;
        Top = 498, ;
        Left = 482, ;
        Height = 17, ;
        Width = 67, ;
        FontBold = .T., ;
        Anchor = 768, ;
        AutoSize = .T., ;
        Alignment = 0, ;
        BackStyle = 0, ;
        Caption = "Can Sort", ;
        ToolTipText = "Enable/disable headers sorting", ;
        ForeColor = Rgb(0,255,0), ;
        Name = "Check1"

    Add Object label2 As Label With ;
        AutoSize = .T., ;
        FontBold = .T., ;
        FontSize = 11, ;
        Anchor = 768, ;
        BackStyle = 0, ;
        Caption = "RF", ;
        Height = 20, ;
        Left = 779, ;
        MousePointer = 15, ;
        Top = 496, ;
        Width = 22, ;
        ForeColor = Rgb(0,255,255), ;
        ToolTipText = "Rotate flip background", ;
        Name = "Label2"

    Add Object label3 As Label With ;
        AutoSize = .T., ;
        FontBold = .T., ;
        FontSize = 16, ;
        Anchor = 768, ;
        BackStyle = 0, ;
        Caption = "?", ;
        Height = 27, ;
        Left = 812, ;
        MousePointer = 15, ;
        Top = 493, ;
        Width = 15, ;
        ForeColor = Rgb(0,255,255), ;
        ToolTipText = "Rotate flip background", ;
        Name = "Label3"

    Procedure my
        Lparameters nButton, nShift, nXCoord, nYCoord
        *--- aevent create an array laEvents
        Aevents( myArray, 0)
        *--- reference the calling object
        loObject = myArray[1]

        If Thisform.check1.Value=1
            With Thisform
                .yclick=.yclick+1
                If .yclick>1
                    .yclick=0
                Endi
                .grid1.SetAll("picture","","header")
                If .yclick=0
                    loObject.Picture="ascend.bmp"   &&home(1)+"graphics\icons\arrows\ARW05UP.ico"
                Else
                    loObject.Picture="descend.bmp"    &&home(1)+"graphics\icons\arrows\ARW05DN.ico"
                Endi
                Sele YCURS
                Locate
                If .yclick=0
                    Set Order To (loObject.Caption)  Ascending
                Else
                    Set Order To (loObject.Caption)  Descending
                Endi
                .grid1.Refresh
                *locate
                .grid1.SetFocus

            Endwith

        Endi
    Endproc

    Procedure Activate
        Thisform.command3.Click()
    Endproc

    Procedure Move
        Lparameters nLeft, nTop, nWidth, nHeight
        yslave.Resize()
    Endproc

    Procedure Moved
        yslave.Resize()
    Endproc

    Procedure Resize
        yslave.Resize()
    Endproc

    Procedure Init
        Publi ymaster,yslave,m.yrep
        m.yrep=Addbs(Justpath(Sys(16,1)))
        Set Defa To (yrep)

        ymaster=Thisform
        Do  yslave With This.Left,This.Top,This.Width,This.Height   &&Name yslave
        sleep(50)
        yslave.Resize()
        yslave.image1.Picture="gradient.bmp"  &&gradient.bmp must be in folder.
        Sele YCURS
        Locate
        With Thisform.grid1
            .RecordSource="ycurs"
            .Themes=.F.
            .DeleteMark=.F.
            .GridLines=0
            .HeaderHeight=28
            .RowHeight=18
            .SetAll("fontbold",.T.,"header")
            .SetAll("fontsize",14,"header")
            .Refresh
        Endwith

        _Sol_SetWindowLong(Thisform.HWnd, -20, 0x00080000)
        _Sol_SetLayeredWindowAttributes(Thisform.HWnd, 0,Thisform.spinner1.Value, 2)

        *init
        With Thisform.grid1
            For i=1 To .ColumnCount
                Bindevent(.Columns(i).header1,"mousedown",Thisform,"my")
            Endfor
            .column1.header1.Picture="descend.bmp"
        Endwith


        Bindevent(Thisform,"move",Thisform,"moved")
    Endproc

    Procedure Load
        Declare SetWindowLong In Win32Api As _Sol_SetWindowLong Integer, Integer, Integer
        Declare SetLayeredWindowAttributes In Win32Api As ;
            _Sol_SetLayeredWindowAttributes Integer, String, Integer, Integer
        Declare Integer Sleep In kernel32 Integer
        Declare Integer BringWindowToTop In user32 Integer

        Close Data All
        Sele * From home(1)+"samples\data\customer.Dbf"  Into Cursor YCURS
        Sele YCURS

        Local m.myvar
        For i=1 To Fcount()
            TEXT to m.myvar textmerge noshow
        index on <<field(i)>> tag <<field(i)>>
            ENDTEXT
            Execscript(m.myvar)
        Endfor
        Locate

    Endproc


    Procedure Destroy
        *With _Screen
        *    For i=1 To .FormCount
        *        If Lower(.Forms(i).Name)=="yslave"
        *            .Forms(i).Release
        *        Endi
        *    Endfor
        *Endwith
        Try
            yslave.Release
        Catch
        Endtry
        Close Data All
        Dele File customer.Cdx
        Clea Events
    Endproc

    Procedure spinner1.InteractiveChange

        _Sol_SetWindowLong(Thisform.HWnd, -20, 0x00080000)
        _Sol_SetLayeredWindowAttributes(Thisform.HWnd, 0,This.Value, 2)
    Endproc

    Procedure command1.Click
        Local m.xpict
        m.xpict=Getpict()
        If Empty(m.xpict)
            Return .F.
        Endi

        yslave.image1.Picture=m.xpict
    Endproc

    Procedure label4.Click
        With Thisform.grid1
            For i=1 To .ColumnCount
                .Columns(i).header1.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
                .Columns(i).header1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
            Endfor
            .Refresh
        Endwith
    Endproc

    Procedure command3.Click
        *random lines lighten colors level=65%

        Local lnRed,lnGreen,lnBlue,T,Level,x
        tnlevel=0.65
        lnRed    =Int(255*Rand())
        lnGreen    = Int(255*Rand())
        lnBlue    = Int(255*Rand())
        *m.x='rgb('+Trans(lnRed,'999')+','+Trans(lnGreen,'999')+','+Trans(lnBlue)+')'
        *lighten color
        m.x='RGB('+Trans( lnRed   + ((255 - lnRed  )   * tnlevel))+','+;
            trans( lnGreen + ((255 - lnGreen) * tnlevel))+ ','+ ;
            trans( lnBlue  + ((255 - lnBlue )  * tnlevel) )+')'

        With Thisform.grid1
            .SetAll("DynamicBackColor","IIF(MOD(recno(), 2)=0, RGB(255,255,255) ,"+m.x +")" , "Column")
            .Refresh
        Endwith
    Endproc

    Procedure command6.Click
        *random columns lighten colors
        With Thisform.grid1
            Local m.x,lnRed,lnGreen,lnBlue,tnlevel
            tnlevel=0.75

            For i=1 To .ColumnCount
                lnRed  =Int(255*Rand())
                lnGreen=Int(255*Rand())
                lnBlue =Int(255*Rand())

                m.x='RGB('+Trans( lnRed   + ((255 - lnRed  )   * tnlevel))+','+;
                    trans( lnGreen + ((255 - lnGreen) * tnlevel))+ ','+ ;
                    trans( lnBlue  + ((255 - lnBlue )  * tnlevel) )+')'

                .Columns(i).DynamicBackColor=Eval('"'+m.x+'"')

            Endfor
            .Refresh
        Endwith
        Retu
    Endproc

    Procedure command2.Click
        Thisform.grid1.Refresh
    Endproc

    Procedure command4.Click
        Thisform.AutoCenter=.T.
    Endproc

    Procedure command5.Click
        Local lnRed,lnGreen,lnBlue,T,Level,x
        tnlevel=-0.50  &&darken
        lnRed    = Int(255*Rand())
        lnGreen    = Int(255*Rand())
        lnBlue    = Int(255*Rand())

        *Darken color
        * m.x='RGB('+trans( lnRed   + ((255 - lnRed  )   * tnLevel))+','+;
        trans( lnGreen + ((255 - lnGreen) * tnLevel))+ ','+ ;
        trans( lnBlue  + ((255 - lnBlue )  * tnLevel) )+')'


        m.x='RGB('+Trans(Int(lnRed   + (lnRed   * tnlevel)))+','+ ;
            trans(Int(lnGreen + (lnGreen * tnlevel)))+','+ ;
            trans(Int(lnBlue  + (lnBlue  * tnlevel)) )+')'

        *messagebox( m.x,0x1000,'',500)
        With Thisform.grid1
            For i=1 To .ColumnCount
                If Vartype(.Columns(i).mycnt)="O"
                    .Columns(i).mycnt.SetAll("forecolor",Eval(m.x),"textbox")
                Else
                    .ForeColor=Eval(m.x)
                Endi
            Endfor
            .Refresh
        Endwith

        Retu
    Endproc


    Procedure label1.Click
        With Thisform.grid1
            For i=1 To .ColumnCount
                .Columns(i).header1.BackColor=0
                .Columns(i).header1.ForeColor=Rgb(0,255,0)
            Endfor
            .Refresh
        Endwith
    Endproc

    Procedure check1.InteractiveChange
        If This.Value=0
            Sele YCURS
            Set Order To
            Locat
            Thisform.grid1.Refresh
        Endi
    Endproc

    Procedure label2.Click
        With yslave.image1
            .RotateFlip=Iif(.RotateFlip=0,4,0)
        Endwith
    Endproc

    Procedure label3.Click
        Local m.myvar
        TEXT to m.myvar textmerge noshow
this uses an artifice to show a picture grid background.This is done
with 2 forms,transparency and some commands (bindevent...)
can :
-set any picture as background
-adjust transparency.
-rotateFlip the background image (horizontally).
-make lighten colors rows changing random at any click
-make header colors random
-make color  lighten columns random
-make lighten forecolor
-sort any column ascending or descending.

NB:
-the form with background image is always under the main form and the
transparency is applied to this last.see the relative codes to move,resize
reduce or maximize form.
-lighten colors are built to make some contrast for eyes.
-can fix colors as your taste and avoid random (demo only)
-transparency is set from 80 to 255.

    Author: Yousfi Benameur El Bayadh Algeria
                  15 January 2014

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

Enddefine
*

*End Code

*NB:after using sorting, uncheck the control to render well the dynamicBackcolors of the grid.

*this is the code to show the picture background. save it as yslave.prg


*Begin code

*yslave.prg

Parameters xleft,xtop,xwidth,xheight
If Pcount() #4
    Return .F.
Endi
Publi yslave
yslave=Newobject("yslave_class")
yslave.Show

Return
*
Define Class yslave_class As Form
    BorderStyle = 0
    Top = 38
    Left = 137
    Height = 349
    Width = 517
    ShowWindow = 2
    ShowInTaskbar = .F.
    Caption = ""
    ControlBox = .F.
    Movable = .F.
    KeyPreview = .T.
    AlwaysOnBottom = .T.
    Name = "FORM1"

    Add Object image1 As Image With ;
        Anchor = 15, ;
        Stretch = 2, ;
        Height = 348, ;
        Left = 0, ;
        Top = 0, ;
        Width = 528, ;
        Name = "Image1"

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

    Procedure Init

        With This
            .Left=xleft+10
            .Top =xtop+10
            .Width=xwidth-20
            .Height=xheight-20
            .AlwaysOnBottom=.T.
        Endwith
    Endproc

    Procedure Resize
        With _Screen
            For i=1 To .FormCount
                If Lower(.Forms(i).Name)=="ymaster"
                    ymaster=.Forms(i)
                Endi
            Endfor
        Endwith

        If ymaster.WindowState=1
            This.Hide()

        Else

            With This
                .Left=ymaster.Left+10
                .Top =ymaster.Top+10
                .Width=ymaster.Width-20
                .Height=ymaster.Height-20
                .AlwaysOnBottom=.T.
                .Show()
                sleep(5)
                ymaster.Activate
                bringWindowToTop(ymaster.HWnd)
            Endwith
        Endi
    Endproc


Enddefine
*

*End code

 

thse 4 images above work with the code and are needed.Download them and put in same folder as the code.
thse 4 images above work with the code and are needed.Download them and put in same folder as the code.
thse 4 images above work with the code and are needed.Download them and put in same folder as the code.
thse 4 images above work with the code and are needed.Download them and put in same folder as the code.

thse 4 images above work with the code and are needed.Download them and put in same folder as the code.

this some screenshots of the iamge on a vfp grid application studied.
this some screenshots of the iamge on a vfp grid application studied.
this some screenshots of the iamge on a vfp grid application studied.
this some screenshots of the iamge on a vfp grid application studied.
this some screenshots of the iamge on a vfp grid application studied.
this some screenshots of the iamge on a vfp grid application studied.

this some screenshots of the iamge on a vfp grid application studied.

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