Discussion :

[810mcu]

Bonjour à tous, et merci d'avance,
Voilà j ai fait ce bout de code dont je mets disponible sur ce même message,
le soucis et de faire tourner en boucle l'affichage et défilement des images du répertoire sélectionner et à la fin de l'affichage de la dernière image relancer à nouveau.
La je bloque qq peut m'aider de comment faire je n'est aucune idée, avec un bout de code c'est super.
Je l'est fait en Delphi6.

Merci a tous.

[810mcu]

C'est tj moi,

au fait choix du répertoire et récupération des images c'est fait
et puis il affiche et fait défiler les images genre un BANNER,
mon soucis est de faire répéter a nouveau ce même choix...
Faire tourner en BOUCLE.
c'est là que ça bloque, qq a une idée, merci d'avance.

Si vous charger le fichier en annexe, vs pouvez constater, et peut etre mieux comprendre.

[810mcu]

Oui,

donc répéter l'affichage et défilement de ces images...

Merci.

[ShaiLeTroll]

Je n'ai pas regarde ton code car j'ai pas le temps mais le mieux est d'utiliser une TPaintBox et un Timer

Dans le Paint, tu dessine l'image
Tu mémorises deux choses le numéro de l'image en cours et sa position Left
lorsque le Left atteind -Width (oui négatif), tu remets Left à Zéro et incrémente l'index de l'image en cours

Le Left augmente à chaque OnTimer, un Invalidate invoquera le OnPaint du TPaintBox

Evidemment, si le Width du TPaintBox est plus grand que le Width de l'image en cours, tu dessines l'image suivante (+1) et si c'est pas assez la suivante (+2) ... jusqu'à ce que la TPaintBox soit pleine

Lors de l'incrémentation de l'index de l'image en cours, si celui atteind le List.Count, tu remets à zéro cet index de l'image et tu continues le traitement

[810mcu]

Bonjour ShaiLeTroll, et merci,

au fait comme je l'est écrit
- la selection du repértoire et récuperation des images ok
- affichage et défilement sur toute la largeur du form avec un ScrollBox (avec la commande Random ) dont voici le code, ok

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
var
   x: word;
   Imagem: TImage;
   i, y: integer;
   espaco, TotImagens: integer;
begin
    // suppresion images précedantes du ScrollBox1
    for y := ScrollBox1.ControlCount -1 downto 0 do
      if Scrollbox1.Controls[y] is Timage then
        begin
          TImage(Scrollbox1.Controls[y]).Picture := nil;
          Timage(Scrollbox1.Controls[y]).Free;
        end;
 
    Timer4.Enabled := True;
 
     x := Random(FileListBox1.Count-1);
      espaco:=10;
      for i := 0 to FileListBox1.Items.Count-1 do
      begin
 
        Imagem := TImage.Create(Self);
        Imagem.Parent := Form1.ScrollBox1;
        //Imagem.Parent := Form1;  //isto é outra opcao que se pode usar
        Imagem.Width:=100;
        Imagem.Height:=100;
        Imagem.Stretch:=true;
        Imagem.Top := 10;
        Imagem.Left := espaco;
        Imagem.Picture.LoadFromFile(FileListBox1.Items[i]);
        espaco:=espaco+Imagem.Width+10;
      end;
 
end;

- un Timer pour réglage du temps et faire bouger la ScrollBox ok

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ScrollBox1.ScrollBy(-8, 0);

maintenant comment le faire touner en boucle (revenir à la 1er image et défiler)

comme vous le dites par les index OUI comment les récuperer avec RANDOM???

Merci

[chekkal]

Bonjour,

la méthode random donne une valeur aléoatoire sur la liste des images existante, qui veut dire que ton application peut facilement ne pas afficher une des image exitante.
La solution à mon avis et de les faire défiler par ordre.

[810mcu]

Bonjour chekkal,

Oui, et comment je peux procéder pcq la je n'est aucune idée,
si vous avez un bout de code je vous remercie.

[SergioMaster]

bonjour,

il suffit d'obtenir un index aléatoire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  ia:=Random(FilelistBow.Items.count-1)

et ensuite charger l'image

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  image.Picture.LoadFromFile(FilelistBow.Items[ia]);

ou encore , en une seule ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  image.Picture.LoadFromFile(FilelistBow.Items[Random(FilelistBow.Items.count-1)]);

[ZenZiTone]

Bonjour 810mcu,

Petit passage pour te demander de faire attention à l'orthographe et la grammaire. Je ne suis pas contre quelques petites erreurs, j'en fais moi-même.
Mais pour faciliter la lecture et la compréhension des personnes te répondant, une petite relecture serait sympa !

Bon aprèm,

ZenZiTone.

[810mcu]

Bonjour Sergio, et merci,

Ton code est bon est il marche,
mais je ne vois pas de comment et ou le mettre dans ma boucle...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
var
   x: word;
   Imagem: TImage;
   i, y: integer;
   espaco, TotImagens: integer;
 
x := Random(FileListBox1.Count-1);
      espaco:=10;
 
        for i := 0 to FileListBox1.Items.Count-1 do
          begin
 
            Imagem := TImage.Create(Self);
            Imagem.Parent := Form1.ScrollBox1;
            Imagem.Width:=100;
            Imagem.Height:=100;
            Imagem.Stretch:=true;
            Imagem.Top := 10;
            Imagem.Left := espaco;
            Imagem.Picture.LoadFromFile(FileListBox1.Items[i]);
 
            espaco:=espaco+Imagem.Width+10;
          end;

Et cet index_image comment le récupérer afin de connaitre la dernière image et redémarrer le défilement… pour faire tourner en boucle…

ZenZiTone,
Je prends bonne note, mes excuses.

[SergioMaster]

faudrait savoir ce que tu veux exactement ?
avoir un diaporama 'infini' avec une image aléatoire (utilisation de random)
ou avoir un diaporama avec les images dans l'ordre

dans les 2 cas ton problème se trouve dans ta boucle qui elle n'est pas 'infinie'
pour en avoir une , il va falloir par exemple poser un bouton pour arrêter le diaporama , et faire une boucle infinie

en variable privée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

   Arret : Boolean = False;

pour la boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
While not Arret do
   begin
    // traitement de l'image donc par exemple ici le random
    ProcessMessages; // pour traiter l'arrêt
   end;

pour le bouton Arret (event onclick)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
procedure TForm1.ArretClick(Sender : TObject) 
begin
Arret:=true; 
end;

[810mcu]

Bonsoir Sergio,

Effectivement avec le WHILE NOT Arret do

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
var
   x: word;
   Imagem: TImage;
   i, y: integer;
   espaco, TotImagens: integer;
begin
 
  for y := ScrollBox1.ControlCount -1 downto 0 do
  if Scrollbox1.Controls[y] is Timage then
    begin
      TImage(Scrollbox1.Controls[y]).Picture := nil;
      Timage(Scrollbox1.Controls[y]).Free;
    end;
 
  Arret := False;
 
  While not Arret do
   begin
 
     x := Random(FileListBox1.Count-1);
      espaco:=10;
 
        for i := 0 to FileListBox1.Items.Count-1 do
          begin
 
            Imagem := TImage.Create(Self);
            Imagem.Parent := Form1.ScrollBox1;
 
            Imagem.Width:=100;
            Imagem.Height:=100;
            Imagem.Stretch:=true;
            Imagem.Top := 10;
            Imagem.Left := espaco;
            Imagem.Picture.LoadFromFile(FileListBox1.Items[i]);
 
            espaco:=espaco+Imagem.Width+10;
          end;
 
       //ProcessMessages(); // pour traiter l'arrêt
   end;
end;

Ça marché, il a tourner 2, 3 fois puis rien ce passe…

- D’autre part je ne sais pas trop comment ou quoi faire avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ProcessMessages; // pour traiter l'arrêt

Vous pouvez m’aider svp

- D’autre part

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
procedure TForm1.ArretClick(Sender : TObject) 
begin
  Arret:=true; 
end;

je l’est fait comme suit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
procedure TForm1.Button9Click(Sender: TObject);
begin
  Arret := true;
end;

- et aussi déclarer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
private
    { Private declarations }
    Arret : Boolean;

Ou sont mes erreurs !!!
comme je l'est dit il a tourner 2, 3 fois puis plus rien...

merci de m'aider

[810mcu]

Bonjour a tous,

Oui l'idée est d'avoir un diaporama 'infini' , dans l’ordre ou pas, pas d’importance.

Voilà,
Avec ce code ça marche,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
var
   x: word;
   Imagem: TImage;
   i, y: integer;
   espaco, TotImagens: integer;
begin
  Arret := False;
 
  for y := ScrollBox1.ControlCount -1 downto 0 do
    if Scrollbox1.Controls[y] is Timage then
      begin
        TImage(Scrollbox1.Controls[y]).Picture := nil;
        Timage(Scrollbox1.Controls[y]).Free;
      end;
 
  Timer4.Enabled := True;
 
  While not Arret do
   begin
    // traitement de l'image donc par exemple ici le random
     x := Random(FileListBox1.Count-1);
     espaco:=10;
 
     for i := 0 to FileListBox1.Items.Count-1 do
       begin
         Imagem := TImage.Create(Self);
         Imagem.Parent := Form1.ScrollBox1;
         //Imagem.Parent := Form1;  //isto é outra opcao que se pode usar
         Imagem.Width:=100;
         Imagem.Height:=100;
         Imagem.Stretch:=true;
         Imagem.Top := 10;
         Imagem.Left := espaco;
         Imagem.Picture.LoadFromFile(FileListBox1.Items[i]);
 
         espaco:=espaco+Imagem.Width+10;
       end;
    Application.ProcessMessages();// pour traiter l'arrêt
 
   end;

Code du TTimer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ScrollBox1.ScrollBy(-8, 0);

Mais
- Il n’attend pas l'affichage de la dernière image qu’il récré à nouveau
- Les photos ne défile pas, elles restent statiques et AutoScroll est a TRUE,
Si je place un Timer, les images se superposent sans défiler dans le même écran
Le Timer oblige le Scrollbox à bouger vers la gauche

je bloque,
Merci de votre aide.

[ShaiLeTroll]

Faire une boucle avec du ProcessMessages rendra l'application inutilisable !

Voici un code défilant les images avec un TPaintBox + TTimer selon la méthode que j'ai décrite, vu que j'ai fait cela en 45 minutes, c'est pas tip top mais c'est un bon début

C'est en XE2, je te laisse trouver le code pour remplacer GetFiles par FindFirst ...

Evidemment le LoadFromFile est fait qu'une fois, j'ai utilisé la TStringList pour le cache, comme en D6, la TStringList ne gère pas OwnsObjects, je te laisse gérer une TObjectList ou un array of TBitmap pour gérer la mémoire de chaque TBitmap

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
unit Frm_SLTImageScrolling;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.Buttons,
  Vcl.ExtCtrls, Vcl.FileCtrl, System.IOUtils, System.Types, PngImage, Jpeg;
 
type
  TSLTImageScrollingForm = class(TForm)
    PaintBoxScrolling: TPaintBox;
    pnlTop: TPanel;
    TimerScrolling: TTimer;
    btnStart: TBitBtn;
    btnStop: TBitBtn;
    TrackBarTimerInterval: TTrackBar;
    TrackBarScrollingStep: TTrackBar;
    procedure TrackBarTimerIntervalChange(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure PaintBoxScrollingDblClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerScrollingTimer(Sender: TObject);
  private
    { Déclarations privées }
    FDirectory: string;
    FFileNames: TStringList;
    FImageIndex: Integer;
    FImageLeft: Integer;
 
    procedure FillFileNames();
  public
    { Déclarations publiques }
  end;
 
var
  SLTImageScrollingForm: TSLTImageScrollingForm;
 
implementation
 
{$R *.dfm}
 
procedure TSLTImageScrollingForm.btnStartClick(Sender: TObject);
begin
  TimerScrolling.Interval := TrackBarTimerInterval.Position;
  TimerScrolling.Enabled := True;
end;
 
procedure TSLTImageScrollingForm.btnStopClick(Sender: TObject);
begin
  TimerScrolling.Enabled := False;
end;
 
procedure TSLTImageScrollingForm.FillFileNames();
var
  FileNameArray: System.Types.TStringDynArray;
  I: Integer;
begin
  FileNameArray := System.IOUtils.TDirectory.GetFiles(FDirectory, '*.*', TSearchOption.soTopDirectoryOnly);
  if not Assigned(FFileNames) then
    FFileNames := TStringList.Create(True) // OwnsObjects dans la TStringList comme si c'était une TObjectList
  else
    FFileNames.Clear();
 
  for I := Low(FileNameArray) to High(FileNameArray) do
    FFileNames.Add(FileNameArray[I]);
end;
 
procedure TSLTImageScrollingForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFileNames);
end;
 
procedure TSLTImageScrollingForm.PaintBoxScrollingDblClick(Sender: TObject);
begin
  if Vcl.FileCtrl.SelectDirectory('Dossier des Images', '', FDirectory, [sdNewUI, sdShowFiles]) then
  begin
    TimerScrolling.Enabled := False;
    FillFileNames();
    TimerScrolling.Interval := TrackBarTimerInterval.Position;
    TimerScrolling.Enabled := True;
  end;
end;
 
procedure TSLTImageScrollingForm.TimerScrollingTimer(Sender: TObject);
 
  procedure DrawImage(const AIndex, ALeft: Integer; out AWidth: Integer);
  var
    Picture: TPicture;
    Bitmap: TBitmap;
    NextIndex: Integer;
    Dummy: Integer;
  begin
    AWidth := -1;
    if AIndex < FFileNames.Count then
    begin
      Bitmap := FFileNames.Objects[AIndex] as TBitmap;
      if Assigned(Bitmap) then
      begin
        PaintBoxScrolling.Canvas.Draw(ALeft, 0, Bitmap);
        AWidth := Bitmap.Width;
        NextIndex := AIndex + 1;
      end
      else
      begin
        Picture := TPicture.Create();
        try
          try
            Picture.LoadFromFile(FFileNames[AIndex]);
            AWidth := Picture.Width;
 
            Bitmap := TBitmap.Create();
            try
              Bitmap.Assign(Picture.Graphic);
              PaintBoxScrolling.Canvas.Draw(ALeft, 0, Bitmap);
              NextIndex := AIndex + 1;
              FFileNames.Objects[AIndex] := Bitmap;
            finally
              if FFileNames.Objects[AIndex] <> Bitmap then
                Bitmap.Free();
            end;
          except
            FFileNames.Delete(AIndex);
            NextIndex := AIndex;
            AWidth := 0;
          end;
        finally
          Picture.Free();
        end;
      end;
 
      // Image suivante
      if ALeft + AWidth < PaintBoxScrolling.Width then
      begin
        if NextIndex >= FFileNames.Count then
          NextIndex := 0;
 
        DrawImage(NextIndex, ALeft + AWidth, Dummy);
        if AWidth = 0 then
          AWidth := Dummy;
      end;
    end;
  end;
 
var
  Picture: TPicture;
  Bitmap: TBitmap;
  DrawWidth: Integer;
begin
  if Assigned(FFileNames) then
  begin
    if FImageIndex >= FFileNames.Count then
    begin
      FImageIndex := 0;
      FImageLeft := 0;
    end;
 
    DrawWidth := 0;
    DrawImage(FImageIndex, FImageLeft, DrawWidth);
 
    Dec(FImageLeft, TrackBarScrollingStep.Position);
    if (DrawWidth > 0) and (-FImageLeft >= DrawWidth) then
    begin
      Inc(FImageIndex);
      FImageLeft := 0;
    end;
  end;
end;
 
procedure TSLTImageScrollingForm.TrackBarTimerIntervalChange(Sender: TObject);
begin
  TimerScrolling.Enabled := False;
  TimerScrolling.Interval := TrackBarTimerInterval.Position;
  TimerScrolling.Enabled := True;
end;
 
end.

la DFM

Code DFM :

Sélectionner tout - Visualiser dans une fenêtre à part

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
object SLTImageScrollingForm: TSLTImageScrollingForm
  Left = 428
  Top = 392
  Caption = 'SLTImageScrollingForm'
  ClientHeight = 331
  ClientWidth = 1077
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBoxScrolling: TPaintBox
    Left = 0
    Top = 37
    Width = 1077
    Height = 294
    Align = alClient
    OnDblClick = PaintBoxScrollingDblClick
    ExplicitLeft = 104
    ExplicitTop = 59
    ExplicitWidth = 105
    ExplicitHeight = 105
  end
  object pnlTop: TPanel
    Left = 0
    Top = 0
    Width = 1077
    Height = 37
    Align = alTop
    TabOrder = 0
    DesignSize = (
      1077
      37)
    object btnStart: TBitBtn
      Left = 13
      Top = 6
      Width = 75
      Height = 25
      Caption = 'Start'
      TabOrder = 0
      OnClick = btnStartClick
    end
    object btnStop: TBitBtn
      Left = 94
      Top = 6
      Width = 75
      Height = 25
      Caption = 'Stop'
      TabOrder = 1
      OnClick = btnStopClick
    end
    object TrackBarTimerInterval: TTrackBar
      Left = 175
      Top = 6
      Width = 150
      Height = 30
      Max = 100
      Min = 1
      Frequency = 10
      Position = 1
      ShowSelRange = False
      TabOrder = 2
      OnChange = TrackBarTimerIntervalChange
    end
    object TrackBarScrollingStep: TTrackBar
      Left = 331
      Top = 6
      Width = 746
      Height = 30
      Anchors = [akLeft, akTop, akRight]
      Max = 100
      Min = 1
      Frequency = 5
      Position = 1
      ShowSelRange = False
      TabOrder = 3
    end
  end
  object TimerScrolling: TTimer
    Enabled = False
    OnTimer = TimerScrollingTimer
    Left = 88
    Top = 88
  end
end

[SergioMaster]

Bonjour,

Shai, c'est D6 qu'il utilise

ceci étant , j'ai proposé un ProcessMessages sans trop savoir ce que cela donnerait au final

@810mcu je n'avais pas vu que les images étaient dans un scrollbox , j'imaginais un simple TPaintbox ou Timage

[810mcu]

Bonjour a tous,

Merci ShaiLeTroll, mais je voudrais rester en D6, si possible.

Slt SergioMaster, et avec la ScrollBox vous avez une idée pour corriger ça ?

Merci

[SergioMaster]

Déjà , j'ai fait un petit programme pour tester ça (jusque là , je ne m'étais attaché qu'a la théorie)

et voilà , c'est moche, certainement pas optimisé mais ça le fait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
unit scrollunit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, JvExMask, JvToolEdit, ExtCtrls;
 
type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    JvDirectoryEdit1: TJvDirectoryEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure JvDirectoryEdit1AfterDialog(Sender: TObject;
      var AName: String; var AAction: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Déclarations privées }
    arret : boolean;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.JvDirectoryEdit1AfterDialog(Sender: TObject;
  var AName: String; var AAction: Boolean);
var Image : TImage;    // image
    info : TSearchRec;  // récupération nom dans repertoire
    espace: integer;     // espace entre chaque image
 
begin
 espace:=10;
 If FindFirst(Aname+'\*.jpg',faAnyFile,Info)=0 Then   // première image du répertoire
  Begin
    Repeat
       If (Info.Attr And faDirectory)=0
        then begin
         Image:=TImage.Create(ScrollBox1);
         Image.Parent:=ScrollBox1;
         Image.Top:=10;
         Image.Left:=espace; 
         Image.Width:=100;
         Image.Height:=100;
         Image.Stretch:=True; 
         Image.Picture.LoadFromFile(Aname+'\'+info.Name);
         espace:=espace+Image.Width+10;  // position de la prochaine image
        end;
     Until FindNext(Info)<>0;  // recherche
    FindClose(Info);           // fin de recherche
  End;
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
var x : integer;
begin
x:=Random(ScrollBox1.ControlCount-1);
scrollbox1.ScrollInView(ScrollBox1.Controls[x]);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var x : integer;
begin
arret:=false;
while not arret do
  begin
    x:=Random(ScrollBox1.ControlCount-1);
    scrollbox1.ScrollInView(ScrollBox1.Controls[x]);
    sleep(1000);
    application.ProcessMessages;
  end;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
arret:=true;
end;

[ShaiLeTroll]

Bonjour,

Shai, c'est D6 qu'il utilise

Il n'y a pas grand chose à changer et j'ai même expliqué quoi !
Je fournis en fin de ce message, je pense une version qui compile en D6

Merci ShaiLeTroll, mais je voudrais rester en D6, si possible.

Oui, j'ai vu que la question était en D6, je l'ai même évoqué dans ma réponse en remplaçant GetFiles par FindFirst (voir code de SergioMaster et la FAQ) et le TStringList lui adjoindre une TObjectList

C'est en XE2, je te laisse trouver le code pour remplacer GetFiles par FindFirst ...

Evidemment le LoadFromFile est fait qu'une fois, j'ai utilisé la TStringList pour le cache, comme en D6, la TStringList ne gère pas OwnsObjects, je te laisse gérer une TObjectList ou un array of TBitmap pour gérer la mémoire de chaque TBitmap

Comme je n'ai pas D6 sous la main, difficile de me limiter à une VCL\RTL plus vieille de 10 ans que celle que j'utilise
Le code en XE2 n'était pas bien différent d'un code D6, juste un peu d'effort à fournir, j'ai fait je pense le plus gros, voir plus bas

Sinon, l'utilisation de Sleep et ProcessMessages bloquent complètement l'application, 810mcu ne pourra pas en faire grand chose


Voici le code en D6, pour la DFM déjà fourni suffit de supprimer les property qui ne sont pas reconnues lors du copier coller

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
unit Frm_SLTImageScrolling;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, ComCtrls, StdCtrls, Buttons,
  ExtCtrls, FileCtrl, Jpeg, Contnrs;
 
type
  TSLTImageScrollingForm = class(TForm)
    PaintBoxScrolling: TPaintBox;
    pnlTop: TPanel;
    TimerScrolling: TTimer;
    btnStart: TBitBtn;
    btnStop: TBitBtn;
    TrackBarTimerInterval: TTrackBar;
    TrackBarScrollingStep: TTrackBar;
    procedure TrackBarTimerIntervalChange(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure PaintBoxScrollingDblClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerScrollingTimer(Sender: TObject);
  private
    { Déclarations privées }
    FDirectory: string;
    FFileNames: TStringList;
    FBitmaps: TObjectList;
    FImageIndex: Integer;
    FImageLeft: Integer;
 
    procedure FillFileNames();
  public
    { Déclarations publiques }
  end;
 
var
  SLTImageScrollingForm: TSLTImageScrollingForm;
 
implementation
 
{$R *.dfm}
 
procedure TSLTImageScrollingForm.btnStartClick(Sender: TObject);
begin
  TimerScrolling.Interval := TrackBarTimerInterval.Position;
  TimerScrolling.Enabled := True;
end;
 
procedure TSLTImageScrollingForm.btnStopClick(Sender: TObject);
begin
  TimerScrolling.Enabled := False;
end;
 
procedure TSLTImageScrollingForm.FillFileNames();
var
  I: Integer;
  Path: String;
  SR: TSearchRec;
begin
  if not Assigned(FFileNames) then
  begin
    FFileNames := TStringList.Create();
    FBitmaps := TObjectList.Create(True); // OwnsObjects juste comme un GarbageCollector
  end
  else
  begin
    FBitmaps.Clear();
    FFileNames.Clear();
  end;
 
  if FindFirst(FDirectory + '\*.jpg*', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Attr And faDirectory) <> faDirectory then
      begin
        FFileNames.Add(FDirectory + '\' + SR.FindData.cFileName);
        FBitmaps.Add(nil);
      end;
 
    until FindNext(SR) <> 0;
 
    FindClose(SR);
  end;
end;
 
procedure TSLTImageScrollingForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FFileNames);
end;
 
procedure TSLTImageScrollingForm.PaintBoxScrollingDblClick(Sender: TObject);
begin
  if FileCtrl.SelectDirectory('Dossier des Images', '', FDirectory, [sdNewUI, sdShowFiles]) then
  begin
    TimerScrolling.Enabled := False;
    FillFileNames();
    TimerScrolling.Interval := TrackBarTimerInterval.Position;
    TimerScrolling.Enabled := True;
  end;
end;
 
procedure TSLTImageScrollingForm.TimerScrollingTimer(Sender: TObject);
 
  procedure DrawImage(const AIndex, ALeft: Integer; out AWidth: Integer);
  var
    Picture: TPicture;
    Bitmap: TBitmap;
    NextIndex: Integer;
    Dummy: Integer;
  begin
    AWidth := -1;
    if AIndex < FFileNames.Count then
    begin
      Bitmap := FFileNames.Objects[AIndex] as TBitmap;
      if Assigned(Bitmap) then
      begin
        PaintBoxScrolling.Canvas.Draw(ALeft, 0, Bitmap);
        AWidth := Bitmap.Width;
        NextIndex := AIndex + 1;
      end
      else
      begin
        Picture := TPicture.Create();
        try
          try
            Picture.LoadFromFile(FFileNames[AIndex]);
            AWidth := Picture.Width;
 
            Bitmap := TBitmap.Create();
            try
              Bitmap.Assign(Picture.Graphic);
              PaintBoxScrolling.Canvas.Draw(ALeft, 0, Bitmap);
              NextIndex := AIndex + 1;
              FFileNames.Objects[AIndex] := Bitmap;
              FBitmaps.Items[AIndex] := Bitmap;
            finally
              if FFileNames.Objects[AIndex] <> Bitmap then
                Bitmap.Free();
            end;
          except
            FFileNames.Delete(AIndex);
            NextIndex := AIndex;
            AWidth := 0;
          end;
        finally
          Picture.Free();
        end;
      end;
 
      // Image suivante
      if ALeft + AWidth < PaintBoxScrolling.Width then
      begin
        if NextIndex >= FFileNames.Count then
          NextIndex := 0;
 
        DrawImage(NextIndex, ALeft + AWidth, Dummy);
        if AWidth = 0 then
          AWidth := Dummy;
      end;
    end;
  end;
 
var
  Picture: TPicture;
  Bitmap: TBitmap;
  DrawWidth: Integer;
begin
  if Assigned(FFileNames) then
  begin
    if FImageIndex >= FFileNames.Count then
    begin
      FImageIndex := 0;
      FImageLeft := 0;
    end;
 
    DrawWidth := 0;
    DrawImage(FImageIndex, FImageLeft, DrawWidth);
 
    Dec(FImageLeft, TrackBarScrollingStep.Position);
    if (DrawWidth > 0) and (-FImageLeft >= DrawWidth) then
    begin
      Inc(FImageIndex);
      FImageLeft := 0;
    end;
  end;
end;
 
procedure TSLTImageScrollingForm.TrackBarTimerIntervalChange(Sender: TObject);
begin
  TimerScrolling.Enabled := False;
  TimerScrolling.Interval := TrackBarTimerInterval.Position;
  TimerScrolling.Enabled := True;
end;
 
end.

[810mcu]

en bidouillant ça, çà marche mais ça reste bidouillage quoi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
procedure TForm1.Button6Click(Sender: TObject);
var
   x: word;
   Imagem: TImage;
   i, y: integer;
   espaco, TotImagens: integer;
begin
  TotImagens := 0;
  TotImagens := FileListBox1.Items.Count;
  Button3.Caption := IntToStr(TotImagens);
 
  // RAZ images contenues ds ScrollBox1
    for y := ScrollBox1.ControlCount -1 downto 0 do
      if Scrollbox1.Controls[y] is Timage then
        begin
          TImage(Scrollbox1.Controls[y]).Picture := nil;
          Timage(Scrollbox1.Controls[y]).Free;
        end;
 
    Timer4.Enabled := True;
 
     x := Random(FileListBox1.Count-1);
      espaco:=10;
      for i := 0 to FileListBox1.Items.Count-1 do
          begin
 
            Imagem := TImage.Create(Self);
            Imagem.Parent := Form1.ScrollBox1;
            Imagem.Width:=100;
            Imagem.Height:=100;
            Imagem.Stretch:=true;
            Imagem.Top := 10;
            Imagem.Left := espaco;
            Imagem.Picture.LoadFromFile(FileListBox1.Items[i]);
 
            espaco:=espaco+Imagem.Width+10;
          end;
 
  Timer3.Interval := TotImagens * 905;
  Timer3.Enabled := True;
end;

le code Timer4

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
procedure TForm1.Timer4Timer(Sender: TObject);
begin
   ScrollBox1.ScrollBy(-8, 0);
end;

le code du Timer3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
procedure TForm1.Timer3Timer(Sender: TObject);
begin
   Button6Click(Sender);
end;

ce ci marche, mais reste du bidouillage...
merci pour vos critiques

[810mcu]

Bonjour a tous,

Je me suis fait aider par un internaute que je remercie,
et je laisse ici le code qui m’as été transmis,
pour ceux que cela peut aider
Merci a vous tous.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
procedure TForm1.Button11Click(Sender: TObject);  //Bouton charger fichier
var
    MyImage : TImage;
    I       : Integer;
    MemSP   : Integer;
begin
    for I := ScrollBox1.ControlCount -1 downto 0 do
        if ScrollBox1.Controls[I] is TImage then
            TImage(ScrollBox1.Controls[I]).Free;
 
    MemSP := Espace;
 
    for I := 0 to FileListBox1.Items.Count-1 do
    begin
        MyImage := TImage.Create(ScrollBox1);
        MyImage.Parent := ScrollBox1;
        MyImage.Width := 100;
        MyImage.Height := 100;
        MyImage.Stretch := True;
        MyImage.Top := Espace;
        MyImage.Left := MemSP;
        MyImage.Picture.LoadFromFile(FileListBox1.Items[I]);
        MemSP := MemSP + MyImage.Width + Espace;
    end;
    ScrollBox1.Height := MyImage.Width + (Espace * 2) + 20;
end;
 
 
procedure TForm1.Button12Click(Sender: TObject);
begin
  Timer7.Interval := StrToInt(Edit_Speed.Text);
  Timer7.Enabled := not (Timer7.Enabled);
end;
 
procedure TForm1.Timer7Timer(Sender: TObject);
var
    Value       : Integer;
    I           : Integer;
    ReloadImage : TImage;
begin
    if ScrollBox1.ControlCount < 2 then
        Exit;
    if not CheckBox1.Checked  then //Choix méthode
    begin
        //Méthode 1
        ScrollBox1.HorzScrollBar.Increment := ScrollBox1.Controls[ScrollBox1.Tag].Width +10;
        Value := ScrollBox1.HorzScrollBar.ScrollPos;
        SendMessage(ScrollBox1.Handle, WM_HSCROLL, SB_LINEDOWN, 0);
        ScrollBox1.Tag := ScrollBox1.Tag +1;
        if ScrollBox1.HorzScrollBar.ScrollPos = Value then
        begin
            SendMessage(ScrollBox1.Handle, WM_HSCROLL, SB_TOP, 0);
            ScrollBox1.Tag := 0;
        end;
    end
    else
    begin
        //Méthode 2
        ReloadImage := TImage.Create(ScrollBox1);
        ReloadImage.Parent := ScrollBox1;
        ReloadImage.Width := 100;
        ReloadImage.Height := 100;
        ReloadImage.Stretch := True;
        ReloadImage.Top := Espace;
        ReloadImage.Picture := TImage(ScrollBox1.Controls[0]).Picture;
        ScrollBox1.Components[0].Free;
        ScrollBox1.Controls[0].Left := Espace;
        for I := 1 to ScrollBox1.ControlCount -1 do
            ScrollBox1.Controls[I].Left := ScrollBox1.Controls[I-1].Left + ScrollBox1.Controls[I-1].Width + Espace;
    end;
end;