Graphics32 : Exemple pratique

Version imprimable

Bonjour à tous

On va faire un exemple généralisé d'affichage des images (BMP, JPEG et PNG) avec Graphics32.

Ces images sont classifiées et placées dans des dossiers différents. Dans notre cas on a quatre dossiers nommés : Dattes, Oranges, Poires et Pommes.

On va ajouter sur une fiche les composants suivants: Image32_1(ScaleMode:smOptimal), Bitmap32List1, 5 boutons (chargement, suivante, precedente, ImageNum, Echelle), Label1, Edit1, Edit2, CheckBox (EffacerAncien State : cbChecked), ProgressBar1, Combobox1 (Items : Dattes, Oranges, Poires, Pommes).

On implémente maintenant les codes :

1-Déclaration des variables :

Code:

1
2
3
var
  Form1: TForm1;
 indexp,indexv,indexr:integer;

2-Initialisation des données :

Code:

1
2
3
4
5
6
7
procedure TForm1.FormCreate(Sender: TObject);
  begin
  Edit1.Text := 'C:/images/Dattes';
  suivante.Enabled:=false  ;
  precedente.Enabled :=false ;
  imageNum.Enabled :=false ;
  end;

3-Chargement des images :

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
procedure TForm1.chargementClick(Sender: TObject);
  var
    list: TStringList;
    i: integer;
  begin
    indexv:=0;
    indexr:=0;
  Progressbar1.Position:=0 ; 
 
  if EffacerAncien.Checked=true then
  Bitmap32List1.Bitmaps.Clear ;
 
    list := FindAllFiles(Edit1.Text, '*.bmp;*.jpg;*.png', FALSE);
    Label1.Caption := Format('%d images trouvées', [list.Count]);
    for i := 0 to list.Count - 1 do
      Begin
      Bitmap32List1.Bitmaps.Add.Bitmap.LoadFromFile(list.Strings[i]);
      Progressbar1.Position:=integer(i*100 DIV (list.count-1)) ;
      End;
    list.Free;
  suivante.Enabled :=true  ;
  precedente.Enabled :=true ;
  imageNum.Enabled :=true;
  end;

4-Formulation des chemins/Dossiers :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  Case Combobox1.ItemIndex of
  0: Edit1.Text:='C:/images/Dattes';
  1: Edit1.Text:='C:/images/Oranges';
  2: Edit1.Text:='C:/images/Poires';
  3: Edit1.Text:='C:/images/Pommes';
  end;
  suivante.Enabled :=false  ;
  precedente.Enabled :=false ;
  imageNum.Enabled:=false ;
end;

5-Avancer d'une image :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.suivanteClick(Sender: TObject);
begin
  Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexv]);
  indexv := (indexv + 1) mod Bitmap32List1.Bitmaps.Count;
  if indexv=0 then
  edit2.Text:=IntToStr(Bitmap32List1.Bitmaps.Count-1)
  else
  edit2.Text:=IntToStr(indexv-1) ;
  indexr:=indexv-2;
  if indexr<0 then
   indexr:=0;
end;

6-Reculer d'une image :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.precedenteClick(Sender: TObject);
begin
  try
  Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[Indexr]);
   Indexr := (Indexr - 1) mod Bitmap32List1.Bitmaps.Count;
  Except
  Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[Bitmap32List1.Bitmaps.Count-1]);
  Indexr:=Bitmap32List1.Bitmaps.Count-2
  end;
  edit2.Text:=IntToStr(indexr+1) ;
  indexv:=indexr+2
end;

7-Atteindre l'image Num :

Code:

1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.ImageNumClick(Sender: TObject);
begin
  indexp:=StrToInt(Edit2.Text) ;
  if indexp<0 then
   Begin indexp:=0; Edit2.Text:='0' end;
  if indexp>=Bitmap32List1.Bitmaps.Count then
   Begin indexp:=Bitmap32List1.Bitmaps.Count-1; Edit2.Text:=inttostr(Bitmap32List1.Bitmaps.Count-1) end ;
  Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexp])  ;
  indexv:=indexp+1;
  indexr:=indexp-1;
end;

8-Echelle:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.EchelleClick(Sender: TObject);
begin
  if image32_1.ScaleMode=smOptimal then
   begin
  image32_1.ScaleMode:=smStretch;
  Echelle.Caption:='Minimiser' ;
   end
  else
  begin
  image32_1.ScaleMode:=smOptimal;
  Echelle.Caption:='Agrandir' ;
  end;
end;

Merci à tous. 8-)

Bonjour à tous

On va ameliorer l'exemple d'affichage des images (BMP,JPEG,et PNG) fait avec Graphic32.
Ces images sont classifiées et placées dans des dossiers differents. Dans notre cas,
on a quatre dossiers initiaux nommés: Dattes, Oranges, Poires et Pommes placés tous,
avec un fichier text(confg) contenant les noms de ces dossiers, dans un dossier appelé images.

Après avoir ajouter deux nouveaux dossiers: cerises et fraises 'confg' doit avoir ce contenu:

Cerises
Dattes
Fraises
Oranges
Poires
Pommes

On va ajouter sur une fiche les composants suivants:
Image32_1,Bitmap32List1, 5boutons:chargement,suivante,precedente,ImageNum et Echelle.
Label1, label2(affiche le nom de chaque img), Edit1, CheckBox (Toutes State:cbUnchecked), ProgressBar1.
Combobox1(Text:Familles images) qui implémentera ces items au démarrage de logiciel.

On insert ensuite les codes suivants:

1-Déclaration des variables:

Code:

1
2
3
var
  Form1: TForm1;
 indexp,indexv,indexr:integer;Str:string; list: TStringList;

2-Chargement des Items:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
procedure TForm1.FormCreate(Sender: TObject);
   var f:TextFile; i:integer;s:string;
begin
   Combobox1.Items.Clear ;
   Try
  AssignFile(f,ExtractFilePath(Application.ExeName)+'Images\Confg.txt');
    Reset(f);
    for i:=1 to 30 do // 30 classes d'images
    begin
    readln(f,s);
    if Trim(s)<>''then
    Combobox1.Items.Add(s)  ;
    end;
    CloseFile(f);
    Except
   Showmessage('Fichier confg déplacé !')
   end;
  suivante.Enabled:=false  ;
  precedente.Enabled :=false ;
  imageNum.Enabled :=false ;
  end;

3-Une/Toutes Familles d'images

Code:

1
2
3
4
5
6
7
8
9
10
11
 
procedure TForm1.ToutesClick(Sender: TObject);
begin
   if toutes.Checked=True then
   Combobox1.Enabled:=False
   else
   Combobox1.Enabled:=True;
   suivante.Enabled :=false  ;
   precedente.Enabled :=false ;
   imageNum.Enabled:=false ;
end;

4-Choix d'une Famille d'images:

Code:

1
2
3
4
5
6
7
8
 
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
 str:=Combobox1.Items[Combobox1.ItemIndex] ;
  suivante.Enabled :=false  ;
  precedente.Enabled :=false ;
  imageNum.Enabled:=false ;
end;

5-Chargement des images:

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
 
procedure TForm1.chargementClick(Sender: TObject);
  var
    i: integer;
  begin
    list.Free ;
    indexv:=0;
    indexr:=0;
    Progressbar1.Position:=0 ;
   Bitmap32List1.Bitmaps.Clear ;
 
    if toutes.Checked=True then
    list := FindAllFiles(ExtractFilePath(Application.ExeName)+'Images', '*.bmp;*.jpg;*.png',True) // tous les dossiers images.
    else
    list := FindAllFiles(ExtractFilePath(Application.ExeName)+'Images\'+Str, '*.bmp;*.jpg;*.png',false); // un seul dossier images.
 
    Label1.Caption := Format('%d images trouvées', [list.Count]);
    for i :=0 to list.Count - 1 do
      begin
      Bitmap32List1.Bitmaps.Add.Bitmap.LoadFromFile(list.Strings[i]);
      Progressbar1.Position:=integer(i*100 DIV (list.count-1)) ;
      end;
  suivante.Enabled :=true  ;
  precedente.Enabled :=true ;
  imageNum.Enabled :=true;
  end;

6-Image suivante:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
procedure TForm1.suivanteClick(Sender: TObject);
begin
  try
  Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexv]);
  edit1.Text:=IntToStr(indexv) ;
  Label2.Caption:=list.Strings[indexv]  ;
  indexv := (indexv + 1) mod Bitmap32List1.Bitmaps.Count;
  except
   indexv:=0;
   Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexv]);
   edit1.Text:=IntToStr(indexv) ;
   Label2.Caption:=list.Strings[indexv]  ;
  end;
  indexr:=indexv-2;
  if indexr<0 then
   indexr:=0;
end;

7-Image precédente:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
procedure TForm1.precedenteClick(Sender: TObject);
begin
  try
   edit1.Text:=IntToStr(indexr) ;
   Label2.Caption:=list.Strings[indexr] ;
   Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[Indexr]);
   Indexr := (Indexr - 1) mod Bitmap32List1.Bitmaps.Count;
   except
   indexr:=Bitmap32List1.Bitmaps.Count-1;
   Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexr]);
   edit1.Text:=IntToStr(indexr) ;
   Label2.Caption:=list.Strings[indexr]  ;
   end;
  indexv:=indexr+2
end;

8-Image quelconque:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
procedure TForm1.ImageNumClick(Sender: TObject);
begin
  indexp:=StrToInt(Edit1.Text) ;
  if indexp<0 then
   Begin indexp:=0; Edit1.Text:='0' end;
  if indexp>=Bitmap32List1.Bitmaps.Count then
   Begin indexp:=Bitmap32List1.Bitmaps.Count-1; Edit1.Text:=inttostr(Bitmap32List1.Bitmaps.Count-1) end ;
  Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexp]);
  Label2.Caption:=list.Strings[indexr]  ;
  indexv:=indexp+1;
  indexr:=indexp-1;
end;

9- Echelle d'image:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
procedure TForm1.EchelleClick(Sender: TObject);
begin
  if image32_1.ScaleMode=smOptimal then
   begin
  image32_1.ScaleMode:=smStretch;
  Echelle.Caption:='Minimiser' ;
   end
  else
  begin
  image32_1.ScaleMode:=smOptimal;
  Echelle.Caption:='Agrandir' ;
  end;
end;

10-Apparence du formulaire:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TForm1.FormPaint(Sender: TObject);
  var x,y: integer;
    p: PBGRAPixel;
    image: TBGRABitmap;
begin
  image := TBGRABitmap.Create(ClientWidth,ClientHeight);
 
  for y := 0 to image.Height-2 do
  begin
    p := image.Scanline[y];
    for x := 0 to image.Width-2 do
    begin
      p^.blue:= x*250 div image.Width;
      p^.green:= y*250 div image.Height;
      p^.red := 20;
      p^.alpha := 250;
      inc(p);
    end;
  end;
  image.InvalidateBitmap; // changé par accès direct
  image.Draw(Canvas,0,0,True);
  image.free;
end;

Ne pas oublier d'ajouter BGRABitmap et BGRABitmapTypes à uses

merci à tous.8-)

Perfectionnement de programme

Bonsoir à tous :P

vue de perfectionnement de ce programme, j'ai modifié les codes suivants ainsi:

5-Chargement des images:

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
procedure TFimages.chargementClick(Sender: TObject);
    var
    i: integer;
  begin
    list.Free ;
    indexv:=0;
    indexr:=0;
    Progressbar1.Position:=0 ;
   Bitmap32List1.Bitmaps.Clear ;
   Image32_1.Bitmap.Clear ;
    if toutes.Checked=True then
    list := FindAllFiles(ExtractFilePath(Application.ExeName)+'Images', '*.bmp;*.jpg;*.png',True) // tous les dossiers images.
    else
    list := FindAllFiles(ExtractFilePath(Application.ExeName)+'Images\'+Str, '*.bmp;*.jpg;*.png',false); // un seul dossier images.
 
    Label1.Caption := Format('%d images trouvées', [list.Count]);
    for i :=0 to list.Count - 1 do
      begin
      Bitmap32List1.Bitmaps.Add.Bitmap.LoadFromFile(list.Strings[i]);
      if list.Count>1 then
      Progressbar1.Position:=integer(i*100 DIV (list.count-1))
      else if list.Count=1 then
      Progressbar1.Position:=100;
      end;
  suivante.Enabled :=true  ;
  precedente.Enabled :=true ;
  imageNum.Enabled :=true;
 
   if Bitmap32List1.Bitmaps.Count=0 then
   begin
   Edit1.Text:='' ;
   Abort
   end;
   Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[0]);
   edit1.Text:=IntToStr(0) ;
   Label2.Caption:=list.Strings[0]  ;
   indexr:=0;
   indexv:=0
  end;

6-Image suivante:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TFimages.SuivanteClick(Sender: TObject);
begin
  if Bitmap32List1.Bitmaps.Count=0 then
  Abort;
  if indexv<Bitmap32List1.Bitmaps.Count then
  indexv := (indexv + 1) mod Bitmap32List1.Bitmaps.Count
  else
  indexv:=0;
   Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexv]);
   edit1.Text:=IntToStr(indexv) ;
   Label2.Caption:=list.Strings[indexv]  ;
  indexr:=indexv;
  if indexr<0 then
   indexr:=0;
end;

7-Image precédente:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TFimages.PrecedenteClick(Sender: TObject);
begin
   if Bitmap32List1.Bitmaps.Count=0 then
  Abort;
   if Indexr>0 then
   Indexr := (Indexr - 1) mod Bitmap32List1.Bitmaps.Count
    else
   indexr:=Bitmap32List1.Bitmaps.Count-1;
   Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexr]);
   edit1.Text:=IntToStr(indexr) ;
   Label2.Caption:=list.Strings[indexr]  ;
  indexv:=indexr
end;

8-Image quelconque:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
procedure TFimages.ImageNumClick(Sender: TObject);
begin
   indexp:=StrToInt(Edit1.Text) ;
  if indexp<0 then
   Begin indexp:=0; Edit1.Text:='0' end;
  if indexp>=Bitmap32List1.Bitmaps.Count then
   Begin indexp:=Bitmap32List1.Bitmaps.Count-1; Edit1.Text:=inttostr(Bitmap32List1.Bitmaps.Count-1) end ;
  Image32_1.Bitmap.Assign(Bitmap32List1.Bitmap[indexp]);
  Label2.Caption:=list.Strings[indexr]  ;
  indexv:=indexp;
  indexr:=indexp;
end;

merci à tous. 8-)

11/10/2015, 22h48
Alcatîz

Merci pour cette contribution !

La bibliothèque Graphics32 mériterait un article de présentation. Si tu te sens d'attaque... ;)
17/10/2015, 14h10
FOCUS77

Bonjour chef ;)

Excuse moi de ne pas répondre à temps car j'étais et je suis encore préoccupé par le développement d'un certain panneau publicitaire du paquet industriel.
Concernant certaines de mes contributions (les plus importantes), je souhaiterais quelles soient intégrées dans la FAQ par 'l'équipe Laz' car moi je suis un mauvais rédacteur.

Merci pour ta visite et j'espère qu'elle ne sera pas la dernière. ;)
17/10/2015, 18h18
Alcatîz

Citation:

Envoyé par FOCUS77

Concernant certaines de mes contributions (les plus importantes), je souhaiterais quelles soient intégrées dans la FAQ par 'l'équipe Laz' car moi je suis un mauvais rédacteur.

"FAQ" sous-entend une question et une réponse ; je verrais plutôt tes contributions intégrées à l'application de téléchargement de codes sources : http://lazarus.developpez.com/telech...rie/79/Lazarus.

Citation:

Envoyé par FOCUS77

Merci pour ta visite et j'espère qu'elle ne sera pas la dernière. ;)

Ce n'est ni la première, ni la dernière, loin de là. ;)
18/10/2015, 12h44
FOCUS77

Salut Alcatîz

Je trouve cette idée géniale :plusser:
je ne tarderai pas à entamer cette tâche :P

merci.
15/11/2015, 13h49
FOCUS77

''Toutes mes condoléances aux familles des victimes'' :cry:

Bonjour à tous

je tiens simplement de faire une petite amélioration:
Afin d'éviter la réduction du form durant le chargement, FormStyle doit être: fsStayOnTop.

merci beaucoup.