Discussion :

[H2D]

Bonjour. Je cherche à transférer le Picture d'un TImage vers un autre TImage vide par pixels aléatoires.

D'avance, merci.

[noox]

kesketudi ?
par pixela leatoire ca veu dire quoi ?
tu transfere tout ?
une partie aleatoire ?

[H2D]

Bonjour.

En gros, je veux que l'image apparaisse pixels par pixels à l'aide d'une boucle for.



Tests :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TForm1.Button1Click(Sender: TObject);
begin
  AutoriseTranfert := True;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var i: integer;
    c: TColor;
begin
  c := rgb(random(i),random(i),random(i));
       if AutoriseTranfert then
          for i := 0 to 2550 do
              Image2.Canvas.Pixels[random(Image2.Width), random(Image2.Height)] := c;
end;

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm1.Button2Click(Sender: TObject);
var x,y,i,j: integer;
begin
x:=image1.picture.width ;
y:=image1.picture.height;
begin
for i := 0 to 2550 do
image2.canvas.pixels[random(x),random(y)]:= image1.canvas.pixels[x,Y]
end;
end;

merci

[Pierre Castelain]

Voici une procédure traduite de l'excellent bouquin "Graphics Gems" que je vous conseille vivement, c'est la bible!
Le code suivant n'est absolument pas optimisé et comporte 2 petits problèmes:
1 - les 2 images doivent avoir exactement la même taille
2- il faudra certainement insérer du code pour permettre au canevas de se dessiner à l'écran sous peine de ne voir que le résultat final. Par exemple, il est possible d'insérer un Application.ProcessMessages après chaque écriture de pixel. Malheureusement, cela ralentit fortement le code. A vous de voir...

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
unit Transitions;
 
interface
uses
  Graphics;
 
procedure Dissolve(ABitmap: TBitmap; ACanvas: TCanvas);
 
implementation
 
const
  RandMasks : array[2..32] of Cardinal =
  ($03, $06, $0C, $14, $30, $60, $B8,
  $0110, $0240, $0500, $0CA0, $1B00, $3500, $6000, $B400,
  $00012000, $00020400, $00072000, $00090000,
  $00140000, $00300000, $00400000, $00D80000,
  $01200000, $38800000, $07200000, $09000000,
  $14000000, $32800000, $48000000, $A3000000);
 
function BitWidth(N: Cardinal): Integer;
var
  width: Integer;
begin
  width:= 0;
  while N <> 0 do
  begin
    N:= N shr 1;
    Inc(width);
  end;
  result:= width;
end;
 
procedure Dissolve(ABitmap: TBitmap; ACanvas: TCanvas);
{ Procédure basée sur le chapitre 'A digital "dissolve" effect'
  de l'excellent livre Graphics Gems édité par Andrew S Glassner }
 
{ Il s'agit ici de la méthode "simple", c'est à dire non-optimisée. En effet
  le calcul des coordonnées du pixel est lent sans parler de l'utilisation
  de Canvas.Pixels qui est extrèmement lente. }
 
{ Cette procédure ne fonctionne que si l'image accessible par ACanvas
  est exactement de la même taille que ABitmap. }
var
  height, width: Integer;
  pixels, lastnum: Integer;
  regwidth: Integer;
  mask: LongInt;
  seq: Cardinal;
  row, column: Integer;
begin
  height:= ABitmap.Height;
  width:= ABitmap.Width;
 
  { Find the smallest "register" that produces enough pixel numbers }
  pixels:= height * width; // Compute # of pixels
  lastnum:= pixels - 1; // Last element (they go 0..lastnum)
  regwidth:= BitWidth(lastnum); // How wide must the register be?
  mask:= RandMasks[regwidth]; // Which mask produces that bitwidth?
 
  { Now cycle through all sequence elements }
  seq:= 1; // 1st element, could be any non-zero
  repeat
    row:= seq div width; // How many rows down in this pixel?
    column:= seq mod width; // How many columns across?
    if row < height then // Does seq element fall in the array?
      ACanvas.Pixels[column, row]:= ABitmap.Canvas.Pixels[column, row]; // Yes: copy the (r, c)'th pixel
 
    // Compute the next sequence element
    if (seq and 1) <> 0 then // Is the low bit set?
      seq:= (seq shr 1) xor mask // Yes: shit, XOR
    else
      seq:= seq shr 1; // No: just shift
  until seq = 1; // Loop till original element
  ACanvas.Pixels[0, 0]:= ABitmap.Canvas.Pixels[0, 0];// Kludge: loop doesn't produce (0, 0)
end;
 
end.

Pour le tester rapidement, mettez 2 TImage contenant 2 images différentes mais de même taille sur une fenêtre. Ajoutez un bouton et dans l'évènement OnClick de celui-ci ajoutez le code:

Code :

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

  Dissolve(Image1.Picture.Bitmap, Image2.Canvas);

[H2D]

Bonjour.

Merci pour votre réponse et votre exemple mais ce que je recherche à faire c'est à ce que le picture contenu dans Image1 puisse apparaître dans Image2 petit à petit par une transition de pixels.

J'ai fait plusieurs tests depuis hier mais celà ne fonctionne toujours pas.



Voici le dernier test :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
procedure TForm1.Button1Click(Sender: TObject);
begin
 AutoriseTranfert := True;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var i: integer;
begin
  if AutoriseTranfert then
     for i := 0 to 100 do
         Image2.Canvas.draw(Image2.Canvas.Pixels[Image2.Picture.Width,Image1.Picture.height], Image2.Canvas.Pixels[Image1.Picture.Width,Image1.Picture.height],Image1.Picture.Graphic);
end;

Merci.

[Pierre Castelain]

C'est bien ce que fait la procédure. Comme je l'ai indiqué, il faut éventuellement ajouter du code pour voir la transition car en l’état le code de la procédure est suffisamment intensif pour empêcher le rafraîchissement de la deuxième image. Une possibilité assez basique est de remplacer :

Code :

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

1
2
    if row < height then // Does seq element fall in the array? 
      ACanvas.Pixels[column, row]:= ABitmap.Canvas.Pixels[column, row]; // Yes: copy the (r, c)'th pixel

par:

Code :

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

1
2
3
4
5
    if row < height then // Does seq element fall in the array? 
    begin
      ACanvas.Pixels[column, row]:= ABitmap.Canvas.Pixels[column, row]; // Yes: copy the (r, c)'th pixel
      Application.ProcessMessages;
    end;

[H2D]

Je vous remercie, l'exemple fonctionne. En outre, je ne comprends pas pourquoi je ne peux pas récupérer le picture simplement en passant par:

Code :

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

Image2.Canvas.Pixels[Random(Image1.Width), Random(Image1.Height)] := Image1.Picture.Bitmap.Canvas.Pixels[X,Y];

Merci.

[Pierre Castelain]

L'utilisation de coordonnées aléatoires (Random) ne permet pas de traiter tous les pixels (en tous cas en un temps raisonnable). De plus certains pixels peuvent être traités de multiples fois, ce qui ne sert à rien. En clair, ce mécanisme n'est pas adapté du tout.

[Sub0]

Salut!

Histoire de mettre un tag "résolu" correcte à ce topic, je pense qu'il suffit d'utiliser un tableau de 2 dimensions de boolean, qui correspondrait pour chaque pixel, à une valeur False. Quand le pixel est affiché, l'élément correspondant passe à True. Cela permettrait d'éviter de retraîter les pixels déjà affichés, et pourrait aussi servir à diminuer le champs du générateur de nombre aléatoire... à+

[phenixauthor]

salut,

Essaie avec le composant harmfade ( version modifiée ) : il te permettra de faire un effet de transition blend / dissolve assez facilement
Le zip comprend deux versions : l'originale , et celle que j'ai modifiée ( newharmfade : utilisation du timer au lieu d'une boucle + application.processmessages )

Tu peux installer le compo, ou simplement recuperer ce qui t'interesse dans le harmfade.pas, il y a un exemple fourni compilé

http://www.phenix-mail.com/files/harmfade_pack.zip

bon courage