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

Vignettes sur un form et agrandissements photos   


L'auteur

ybenam
Algérie Algérie
Membre Simple
# 0000002080
enregistré le 21/04/2008


Fiche personnelle

Note des membres
pas de note

Contributions > 02 - SCX : Formulaires

Vignettes sur un form et agrandissements photos
# 0000000577
ajouté le 20/05/2008 15:48:06 et modifié le 20/05/2008
consulté 7334 fois
Niveau initié

Version(s) Foxpro :
VFP 6.0
Description
Ce programme écrit en VFP6.0 affiche sur un form toutes les miniatures (vignettes) d'un répertoire donné (en photos bmp,jpg,gif). Un clic sur une photo l'agrandit un autre clic la réduit. Il permet le déroulement d'un diaporama simple avec temporisation inter images de 4 sec. Si le nombre de photos est important des appels de mémoire supplémentaire sont nécessaires et ralentissent le programme. benameuryousfi1@gmail.com
Code source :
&& miniatures de photos jpg,gif et bmp d'un répertoire donné sur form+visualisations photos+diaporama

mess="Ce programme crée les miniatures de photos jpg,gif et bmp d'un répertoire donné.Cliquer sur une miniature pour l'agrandir et clic sur photo pour la fermer."+chr(13)+;
     "Un diaporama (sans musique et sans transitions) est disponible et temporisé à 4s.Le programme demande de la mémoire système."+chr(13)+;
     "J'ai testé 100 photos sans problème à signaler! benameuryousfi1@gmail.com "
messagebox(mess,0,"Avertissement")

yrep0=sys(5)+sys(2003)+'\'
yrep=getdir()
if empty(yrep)
return
endi

yrep='"'+yrep+'"'
set defa to &yrep
gnbre1=adir(gabasedonnées1,'*.jpg')
gnbre2=adir(gabasedonnées2,'*.bmp')
gnbre3=adir(gabasedonnées3,'*.gif')

gnbre=gnbre1+gnbre2+gnbre3

create cursor ythumb (image c(100))
sele ythumb
for i=1 to gnbre1
appe blan
repl image with justpath(yrep)+"\"+gabasedonnées1(i,1)
endfor
for i=1 to gnbre2
appe blan
repl image with justpath(yrep)+"\"+gabasedonnées2(i,1)
endfor
for i=1 to gnbre3
appe blan
repl image with justpath(yrep)+"\"+gabasedonnées3(i,1)
endfor

*brow
go top
***********************
PUBLIC oform,xx
oform=CREATEOBJECT("yForm")
oform.Show()
read events
return

DEFINE CLASS yForm AS Form
showtips=.t.
scrollbars=3
showwindow=2
caption=" Création de miniatures (jpg,bmp,gif) sur un objet Form"
   width=sysmetric(1)
   height=sysmetric(2)

**************
 Procedure init
 publi clic,l0,t0,w0,h0
 clic=0
  xwidth=sysmetric(1)-40
  xheight=sysmetric(2)
  thumwidth=80   && default thumbnail dim
  thumheight=80  && ""
   delta=10   &&espace sur ligne et sur colonne
  marge=25   &&marge sup .pour titre
sele ythumb
 go top

 nhoriz=round(xwidth/(thumwidth+delta),0)
 nvert=round(xheight/(thumheight+delta),0)

thisform.AddObject('visio','vimage' )



thisform.addobject("titre","label")
with this.titre
.left=2
.top=2
.height=21
.width=this.width-100
.visible=.t.
.forecolor=255
.alignment=0
.fontname="Arial"
.fontsize=9
.fontbold=.t.
.caption="Répertoire "+allt(yrep)+"..."+allt(str(gnbre))+" images "
endwith



 k=1
 for j=1 to nvert
  for i=1 to nhoriz
  aa="bouton"+allt(str(k))
  k=k+1
sele ythumb
if not eof()
 thisform.addobject(aa,"Mybutton")
 with this.&aa
 if i=1
 .left=delta
 else
 .left=(i-1)*(thumwidth)+i*delta
   endi
 .top=(j-1)*(thumheight)+(2*j-1)*delta +marge
 .picture=image
endwith

 bb="label"+allt(str(k))
 thisform.addobject(bb,"Mylabel")
 with this.&bb
 if i=1
 .left=delta
 else
 tt="this."+aa+".left"
 .left=&tt
  endi

  tt="this."+aa+".top"
 rr="this."+aa+".height"
 .top=&tt+&rr+2     &&+marge
 .caption=juststem(image)+justext(image)
 endwith
endi

 sele ythumb
 if not eof()
 skip
 else
 exit
 endi
 endfor
 i=1
 if lastkey()=27
 exit
 endi
 endfor

thisform.AddObject('ydiap1','ydiap')
with thisform.ydiap1
.left=thisform.titre.left+thisform.titre.width+3
.top=thisform.titre.top
.height=20
.width=60
.caption="Diaporama"
.fontsize=7
.forecolor=rgb(0,255,0)
.visible=.t.
endwith

endproc

procedure destroy
clea events
endproc

ENDDEFINE
DEFINE CLASS Mybutton as image      &&commandbutton
width=thumwidth
height=thumheight
backstyle=1
visible=.t.
stretch=2
picture=""

procedure click
thisform.visio.picture=this.picture
thisform.visio.left=(thisform.width-thisform.visio.width)/2
thisform.visio.top=(thisform.height-thisform.visio.height)/2
thisform.visio.zorder(0)
for i=1 to gnbre+1
c1="thisform.bouton"+allt(str(i))
c2="thisform.label"+allt(str(i))
aa="thisform.bouton"+allt(str(i))+".visible=.f."
bb="thisform.label"+allt(str(i))+".visible=.f."
if vartype(&c1)="O"
&aa
endi
if vartype(&c2)="O"
&bb
endi
endfor
xx=thisform.backcolor
thisform.backcolor=rgb(0,0,0)
thisform.visio.visible=.t.
endproc
ENDDEFINE

DEFINE CLASS Mylabel as label
width=thumwidth
height=15
caption=""
visible=.t.
fontname="Arial"
fontsize=7
ENDDEFINE

Define class vimage as image
picture=""
stretch=0
backstyle=1
visible=.f.
name="visio"

procedure click
this.visible=.f.
thisform.backcolor=xx
for i=1 to gnbre+1
c1="thisform.bouton"+allt(str(i))
c2="thisform.label"+allt(str(i))
aa="thisform.bouton"+allt(str(i))+".visible=.t."
bb="thisform.label"+allt(str(i))+".visible=.t."
if vartype(&c1)="O"
&aa
endi
if vartype(&c2)="O"
&bb
endi
endfor
endproc
ENDDEFINE
****************
DEFINE CLASS ydiap AS COMMANDBUTTON
backstyle=1
tooltiptext="Faire ESC pour terminer ! "
procedure click
w=thisform.width
h=thisform.height
t0=thisform.top
l0=thisform.left
thisform.width=sysmetric(1)
thisform.height=sysmetric(2)
thisform.top=0
thisform.left=0
for i=1 to gnbre+1
c1="thisform.bouton"+allt(str(i))
c2="thisform.label"+allt(str(i))
aa="thisform.bouton"+allt(str(i))+".visible=.f."
bb="thisform.label"+allt(str(i))+".visible=.f."
if vartype(&c1)="O"
&aa
endi
if vartype(&c2)="O"
&bb
endi
endfor
sele ythumb
go top
thisform.visio.visible=.t.
thisform.visio.zorder(0)
xx=thisform.backcolor
thisform.backcolor=rgb(0,0,0)
do while not eof()
thisform.visio.picture=image
thisform.visio.left=(thisform.width-thisform.visio.width)/2
thisform.visio.top =(thisform.height-thisform.visio.height)/2

inkey(3)
if lastkey()=27
exit
endi
skip
enddo
thisform.backcolor=xx
for i=1 to gnbre+1
c1="thisform.bouton"+allt(str(i))
c2="thisform.label"+allt(str(i))
aa="thisform.bouton"+allt(str(i))+".visible=.t."
bb="thisform.label"+allt(str(i))+".visible=.t."
if vartype(&c1)="O"
&aa
endi
if vartype(&c2)="O"
&bb
endi
endfor
thisform.width=w
thisform.height=h
thisform.top=t0
thisform.left=l0

ENDDEFINE
Commentaires
Aucun commentaire enregistré ...
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3