Précédent   Forum du club des développeurs et IT Pro > Autres langages > Pascal > Flash Pascal
Flash Pascal Forum d'entraide sur la création de fichiers Flash en Object Pascal
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse
 
Outils de la discussion
Publicité
'
Vieux 28/06/2012, 17h19   #1
Archimède
Membre émérite
 
Avatar de Archimède
 
Homme anthony
Enseignant
Inscription : avril 2005
Messages : 1 026
Détails du profil
Informations personnelles :
Nom : Homme anthony
Localisation : France, Charente Maritime (Poitou Charente)

Informations professionnelles :
Activité : Enseignant
Secteur : Enseignement

Informations forums :
Inscription : avril 2005
Messages : 1 026
Points : 975
Points : 975
Par défaut Une unité uTrackbar

Ci-joint, si ça peut être utile...

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
 
unit UTrackbar;
 
interface
uses Flash8;
 
 
type
 
   TTrackcur=class(MovieClip)
    xmouse,trackmin,trackmax:number;
    xcur,ycur:Integer;
    downcur:Boolean;
    Procedure circle(Cx,Cy,Radius:number);
    constructor Create(AOWNER:Movieclip;trmin,trmax:number);
    procedure onPress;
    procedure onEnterFrame;
    procedure onMouseUp;
   end;
 
   TTrackbar=class(MovieClip)
    w,h,position:number;
    cur: TTrackcur;
    procedure Roundrect(x,y,w,h,radius:number);
    procedure DrawTrackbar(Width,Height:number);
    constructor Create(AOWNER:Movieclip;FWidth,trmin,trmax,posi:number);
   end;
 
implementation
 
 
constructor TTrackcur.create(AOWNER:Movieclip;trmin,trmax:number);
 var matrix: Flash8.Matrix;
begin
  inherited Create(AOWNER,'cur',AOWNER.getNextHighestDepth);
  matrix := Flash8.Matrix.Create();
  matrix.createBox(1,1,0,10,14);
  linestyle(1,$87B6B7);
  beginGradientFill('radial',[$008080,clwhite],[100,100],[0,14],matrix);
  Circle(6,6,15);
  downcur:=false;
  xmouse:=0;
  trackmin:=trmin;
  trackmax:=trmax;
end;
 
constructor TTrackbar.Create(AOWNER:Movieclip;Fwidth,trmin,trmax,posi:number);
begin
 inherited Create(AOWNER,'trackbar',AOWNER.getNextHighestDepth);
 w:=FWidth;
 DrawTrackBar(w,12);
 cur:=TTrackcur.Create(self,trmin,trmax);
 cur._x:=(posi-trmin)*w/(trmax-trmin);
 cur._y:=0;
 position:=posi;
end;
 
procedure TTrackbar.DrawTrackbar(Width, Height: number);
var matrix: Flash8.Matrix;
begin
 matrix := Flash8.Matrix.Create();
 matrix.createGradientBox(width, height, Math.PI/2, 0, 0);
    beginGradientFill('linear',
      [$deedf6,$c4e5f6,$98d1ef,$66afd7],
      [100,100,100,100],
      [8,64,127,255],
      matrix
    );
 linestyle(2,$98d1ef);
 RoundRect(0,0,width,height,height/2);
end;
 
procedure  TTrackcur.onPress;
begin
 downcur:=true;
 xmouse:=_xmouse;
end;
 
procedure  TTrackcur.onEnterFrame;
var tr:TTrackbar;
begin
     tr:= TTrackbar(_parent);
     if downcur then
     begin
      _x:= _x + _xmouse -xmouse;
      if _x<0 then _x:=0;
      if _x>tr.w then _x:=tr.w;
      tr.position:=_x*(trackmax-trackmin)/tr.w+trackmin;
     end;
end;
 
 
 
procedure  TTrackcur.onMouseUp;
begin
 downcur:=false;
end;
 
procedure TTrackbar.Roundrect(x,y,w,h,radius:number);
var
 ra,b:number;
begin
  ra := x + w;
  b := y + h;
  moveTo(x+radius, y);
  lineTo(ra-radius, y);
  CurveTo(ra,y, ra, y+radius);
  lineTo(ra, y+h-radius);
  CurveTo(ra, b, ra-radius, b);
  lineTo(x+radius, b);
  CurveTo(x, b,x, b-radius);
  lineTo(x, y+radius);
  CurveTo(x, y, x+radius,y);
end;
 
Procedure TTrackcur.circle(Cx,Cy,Radius:number);
var a,b,R: number;
begin
  R:=Radius;
  a:= R * 0.414213562;
  b:= R * 0.707106781;
  moveTo(Cx+R,Cy);
  CurveTo(Cx+ R, Cy+-a, Cx+b,Cy -b);
  CurveTo(Cx+ a,Cy-R,Cx,Cy -r);
  CurveTo(Cx-a,Cy -R,Cx-b,Cy -b);
  CurveTo(Cx-R, Cy-a,Cx-R,Cy);
  CurveTo(Cx-R,Cy+a,Cx-b,Cy+b);
  CurveTo(Cx-a,Cy +R,Cx,Cy+r);
  CurveTo(Cx+a,Cy +R,Cx+b,Cy+b);
  CurveTo(Cx+R,Cy+a,Cx+R,Cy);
end;
 
end.
mise en situation :

Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
program Project1;
 
{$FRAME_WIDTH 1000}
{$FRAME_HEIGHT 400}
{$FRAME_RATE 32}
{$BACKGROUND $FFFFFF}
 
uses
  Flash8,UTrackbar;
 
  type
   Essai=class(movieClip)
    Track,Track2:TTrackbar;
    mc:movieclip;
    Constructor Create;
    procedure onEnterFrame;
   end;
 
 
Constructor Essai.Create;
begin
 inherited create(nil,'essai',0);
 mc:=movieclip.create(self,'aiguille',0);
 with mc do
 begin
  linestyle(4,clred);
  moveto(0,0);
  lineto(0,-150);
  _x:=500;
  _y:=200;
 end;
  track:=TTrackbar.Create(self,175,0,30,5);
  with track do
  begin
   _x:=50;
   _y:=50;
  end;
 
  track2:=TTrackbar.create(self,175,0,50,25);
  with track2 do
  begin
   _x:=50;
   _y:=150;
  end;
end;
 
 
 
procedure essai.onEnterFrame;
begin
 mc._rotation:=mc._rotation+track.position;
 mc._x:=500+track2.position;
end;
 
begin
  Essai.create;
end.
__________________
Citation:
tout développeur plongé dans son code subit une poussée d'urticaire de bas en haut égale au poids du volume d'unités qu'il ajoute.
Archimède est déconnecté   Envoyer un message privé Réponse avec citation 20
Vieux 29/06/2012, 08h17   #2
Paul TOTH
Expert Confirmé Sénior
 
Avatar de Paul TOTH
 
Homme Paul TOTH
Freelance
Inscription : novembre 2002
Messages : 4 404
Détails du profil
Informations personnelles :
Nom : Homme Paul TOTH
Âge : 43
Localisation : Réunion

Informations professionnelles :
Activité : Freelance
Secteur : High Tech - Éditeur de logiciels

Informations forums :
Inscription : novembre 2002
Messages : 4 404
Points : 10 757
Points : 10 757
excellent
__________________
Developpez.com: Mes articles, forum FlashPascal
Entreprise: Execute SARL
Produits : UPnP, RemoteOffice, FlashPascal
Embarcadero : Ile de la Réunion, Dephi, C++Builder, RADPHP...TVA à 8,5%
Paul TOTH est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 29/06/2012, 09h09   #3
Archimède
Membre émérite
 
Avatar de Archimède
 
Homme anthony
Enseignant
Inscription : avril 2005
Messages : 1 026
Détails du profil
Informations personnelles :
Nom : Homme anthony
Localisation : France, Charente Maritime (Poitou Charente)

Informations professionnelles :
Activité : Enseignant
Secteur : Enseignement

Informations forums :
Inscription : avril 2005
Messages : 1 026
Points : 975
Points : 975
merci, c'est gentil...mais avec toi, on prend de la graine
__________________
Citation:
tout développeur plongé dans son code subit une poussée d'urticaire de bas en haut égale au poids du volume d'unités qu'il ajoute.
Archimède est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse
Outils de la discussion

Navigation rapide


Fuseau horaire GMT +2. Il est actuellement 19h45.


 
 
 
 
Partenaires

Hébergement Web