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.

mer. 01 novembre 2017, 18h27
eddymaue
atoutfox.public.association

Re: toolbar personnalisée ?

good je mets ca dans mes sources

a+ eddy

ybenam avait écrit le 2017-10-23 :
> Bonjour Eddy
> Voila un code pour créer un toolbar avec une class toolbar cotenant une
> classe container.

[vfp]
*!* 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
{/vfp]

--
a+ Eddy
Merci de partager avec moi votre immense savoir que je me ferai plaisir
d'absorber... il va de soi que je vais vous en laisser un peu
Politesse et savoir vivre oblige ;0)
Permalink : http://www.atoutfox.org/nntp.asp?ID=0000018558
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