ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Forum AtoutFox : Re: toolbar personnalisée ?   

Sujet

rss Flux RSS des derniers messages

Vous devez vous identifier pour pouvoir poser une question ou répondre.

lun. 23 octobre 2017, 13h24
ybenam
Algérie Algérie

atoutfox.public.association

Re: toolbar personnalisée ?

Bonjour Eddy
Voila un code pour créer un toolbar avec une class toolbar cotenant une classe container.

*!*  this is a standard toolbar class using a container class.
*!*  In the container, can position objects as user wants (i used for demo 10 images but can be any control)
*!*  can code any action in the method "my" (recognizing the control clicked).
*!*  the container is large and the docking left or right can be not beautiful.
*!* Ybenam  lundi 23 octobre 2017; 12:19:55

*!*--Begin Code
_Screen.WindowState=1
Set Defa To Justpath(Sys(16,1))
Publi yform
yform = Newobject("yForm")
yform.Show

Local ytoolbar
ytoolbar = Newobject("asup")
ytoolbar.Show()
Read Events
Return

Define Class yform As Form
  ShowWindow = 2
  Width=800
  Height=600
  AutoCenter=.T.
  Caption="you can drag the toolbar and dock it (left),top,(right),bottom or free"
  Name="yform"

  Procedure Destroy
    Clea Events
  Endproc
Enddefine
*enddefine yform
***************************
Define Class asup As Toolbar
  Caption = "Toolbar1"
  Height = 82
  Left = 0
  Top = 0
  Width = 820
  ShowWindow = 1
  BackColor=Rgb(212,208,210)
  Name = "asup"

  Add Object container1 As ycont With ;
    Top = 3, ;
    Left = 5, ;
    Width = 800, ;
    Height = 76, ;
    borderwidth=0,;
    backstyle=0,;
    Name = "Container1"

  Procedure Init
    This.Dock(0)    &&0,1,2 docking positions (3,4 not beautiful)
Enddefine
*-- EndDefine: asup

Define Class ycont  As Container
  Top = 11
  Left = 12
  Width = 780
  Height = 76
  Name = "ycont"

  Add Object image1 As Image With ;
    Height = 60, ;
    Left = 4, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image1"

  Add Object image2 As Image With ;
    Height = 60, ;
    Left = 66, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image2"

  Add Object image3 As Image With ;
    Height = 60, ;
    Left = 127, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image3"

  Add Object image4 As Image With ;
    Height = 60, ;
    Left = 189, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image4"

  Add Object image5 As Image With ;
    Height = 60, ;
    Left = 251, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image5"

  Add Object image6 As Image With ;
    Height = 60, ;
    Left = 312, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image6"

  Add Object image7 As Image With ;
    Height = 60, ;
    Left = 373, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image7"

  Add Object image8 As Image With ;
    Height = 60, ;
    Left = 435, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image8"

  Add Object image9 As Image With ;
    Height = 60, ;
    Left = 496, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image9"

  Add Object image10 As Image With ;
    Height = 60, ;
    Left = 496, ;
    Top = 5, ;
    Width = 56, ;
    Name = "Image10"


  Procedure Init
    Local gnbre,m.delta
    m.delta=10
    gnbre=Adir(gabase,Home(1)+"graphics\bitmaps\tlbr_w95\*.bmp")

    With This
      .SetAll("stretch",2,"image")
      .SetAll("width",64,'image')
      .SetAll("height",64,"image")

      For i=1 To .ControlCount
        If Lower(.Controls(i).Class)=="image"
          .Controls(i).Picture=Home(1)+"graphics\bitmaps\tlbr_w95\"+gabase(i,1)
        Endi
        If i=1
          .Controls(i).Left=5
        Else
          .Controls(i).Left=.Controls(i-1).Left+.Controls(i-1).Width+m.delta
        Endi
        .Controls(i).Top=5
        Bindevent(.Controls(i),"mouseDown",This,"my")
        Bindevent(.Controls(i),"mouseEnter",This,"my1")
        Bindevent(.Controls(i),"mouseLeave",This,"my2")
      Endfor


      .SetAll("mousepointer",15,"image")
    Endwith

  Endproc



  Procedure my()
    Lparameters nButton, nShift, nXCoord, nYCoord
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    Messagebox("Control: "+loObject.Name+" clicked."+Chr(13)+"you can add some code to do some custom actions....",0+32)
  Endproc

  Procedure my1()
    Lparameters nButton, nShift, nXCoord, nYCoord
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    With loObject
      .Left=.Left-2
      .Top=.Top-2
    Endwith
  Endproc

  Procedure my2()
    Lparameters nButton, nShift, nXCoord, nYCoord
    *--- aevent create an array laEvents
    Aevents( myArray, 0)
    *--- reference the calling object
    loObject = myArray[1]
    With loObject
      .Left=.Left+2
      .Top=.Top+2
    Endwith


Enddefine
*
*-- EndDefine: ycont


Permalink : http://www.atoutfox.org/nntp.asp?ID=0000018539
18 546 messages dans le forum • Liste complète des messages

Publicité

Les pubs en cours :

www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2017.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0