Entwickler-Ecke

Multimedia / Grafik - Animation von Übergang von Bild1 zu Bild2 zu langsam


Der_Neue - Mo 20.11.06 23:50
Titel: Animation von Übergang von Bild1 zu Bild2 zu langsam
Ich habe grad mein Programm fertig geschrieben. Es sollte eigentlich eine Animation des Übergangs von Bild zu Bild werden. Der praktische Wert des Programms ist ja unwichtig :roll: .
Das Programm funktioniert an sich, aber es dauert ca. 5-10 Sekunden um einen Schritt weiter zu kommmen. Kann man das irgendwie beschleunigen?
Der Code für einen Schritt (Die komplette Source hänge ich auch als Datei an):


Delphi-Quelltext 
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:
 
procedure TForm1.Button1Click(Sender: TObject);
var i, i2 : integer;
begin
for i := 0 to image1.Width do       // X
    for i2 := 0 to image1.Height do // Y
begin
// RGB-Werte von Image1 in Schritten an Image2 angleichen
//----------------------------------------------------- ROT
if (GetRValue(image1.canvas.Pixels[i,i2])) < (GetRValue(image2.canvas.Pixels[i,i2])) then
begin
R := GetRValue(image1.canvas.Pixels[i,i2]);
G := GetGValue(image1.canvas.Pixels[i,i2]);
B := GetBValue(image1.canvas.Pixels[i,i2]);
R := R + Schritte;
image1.Canvas.Pixels[i,i2] := rgb(r,g,b);
end
else
begin
 R := GetRValue(image1.canvas.Pixels[i,i2]);
G := GetGValue(image1.canvas.Pixels[i,i2]);
B := GetBValue(image1.canvas.Pixels[i,i2]);
R := R - Schritte;
image1.Canvas.Pixels[i,i2] := rgb(r,g,b);
end;
//------------------------------------------------------- GRÜN
if (GetGValue(image1.canvas.Pixels[i,i2])) < (GetGValue(image2.canvas.Pixels[i,i2])) then
begin
R := GetRValue(image1.canvas.Pixels[i,i2]);
G := GetGValue(image1.canvas.Pixels[i,i2]);
B := GetBValue(image1.canvas.Pixels[i,i2]);
G := G + Schritte;
image1.Canvas.Pixels[i,i2] := rgb(r,g,b);
end
else
begin
 R := GetRValue(image1.canvas.Pixels[i,i2]);
G := GetGValue(image1.canvas.Pixels[i,i2]);
B := GetBValue(image1.canvas.Pixels[i,i2]);
G := G - Schritte;
image1.Canvas.Pixels[i,i2] := rgb(r,g,b);
end;
//--------------------------------------------------------  BLAU
if (GetBValue(image1.canvas.Pixels[i,i2])) < (GetBValue(image2.canvas.Pixels[i,i2])) then
begin
R := GetRValue(image1.canvas.Pixels[i,i2]);
G := GetGValue(image1.canvas.Pixels[i,i2]);
B := GetBValue(image1.canvas.Pixels[i,i2]);
B := B + Schritte;
image1.Canvas.Pixels[i,i2] := rgb(r,g,b);
end
else
begin
 R := GetRValue(image1.canvas.Pixels[i,i2]);
G := GetGValue(image1.canvas.Pixels[i,i2]);
B := GetBValue(image1.canvas.Pixels[i,i2]);
B := B - Schritte;
image1.Canvas.Pixels[i,i2] := rgb(r,g,b);
end;
end;
end;


EDIT: Schritte ist eine Konstante, die bei mir meistens den Wert 10 hat.


Coder - Di 21.11.06 00:07
Hi
Es dauert so lange weil die jeden Pixel einzelln färbst.
Benutz mal die Methode Canvas.FloodFill.
Damit kannst du eine einfarbige Fläche umfärben.
Das sollte dann schneller gehen.

MfG


Der_Neue - Di 21.11.06 00:11
@Coder
Ja, ich weiß. Das ist auch so beabsichtigt. Die Bilder sind nur simple Beispiele. Eigentlich wollte ich das mit Fotos usw. machen.


wulfskin - Di 21.11.06 00:22
Hallo,

schneller gehts mit (Bitmap.)Scanline. Mit Pixels kannst du das total vergessen, dass steht glaub auch in der Hilfe, dass das zu langsam ist!

Gruß Hape!


Horst_H - Di 21.11.06 10:10
Hallo,

Du berechnest den Übergang etwas seltsam, naemlich degressiv und nicht linear, da Du das Ausgangsbild ständig veränderst.
Aber egal, ich hab es mal in ein neues image hineingerechnet.

Delphi-Quelltext 
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:
 
procedure TForm1.Button1Click(Sender: TObject);
var
  y,x,step : integer;
  Anteil : double;
  R0,G0,B0 : integer;
  dR,dG,dB : integer;
  Farbpunkt : TCOlor;

begin
//Kopieren Image1
image4.Picture.Assign(image1.picture);
For step := 1 to Schritte-1 do
  begin
  Anteil := step/schritte;
  image4.update;
  form1.update;
  Form1.Label1.Caption:= IntToStr(sizeOf(Image4.canvas.Pixels[0,0]));
  for y := 0 to image1.Height do
    for x := 0 to image1.Width do
      begin
      // RGB-Werte von Image1 in Schritten an Image2 angleichen
      FarbPunkt :=image1.canvas.Pixels[x,y];
      R0 := GetRValue(FarbPunkt);
      G0 := GetGValue(FarbPunkt);
      B0 := GetBValue(FarbPunkt);

      FarbPunkt :=image2.canvas.Pixels[x,y];
      R := Round((GetRValue(FarbPunkt)-R0)*Anteil)+R0;
      G := Round((GetGValue(FarbPunkt)-G0)*Anteil)+G0;
      B := Round((GetBValue(FarbPunkt)-B0)*Anteil)+B0;

      image4.Canvas.Pixels[x,y] := rgb(r,g,b);
      end;
  end;
//Kopieren Image2
image4.Picture.Assign(image2.picture);
end;


Wie Du siehst berechnet man in dieser Version jedes Pixel von image1 und image2 Schritte-fach.
Ein leichterer Zugriff wäre also das Speichern der RGB Werte von Image1 und der Differenzwerte in seperaten Feld.
Statt round kann man mit integer werten und shift arbeiten.(1/3 = *(round(1/3*1024) shr 10)

Gruss Horst

Moderiert von user profile iconGausi: Code- durch Delphi-Tags ersetzt


Popov - Di 21.11.06 11:35
@Der_Neue

So wie du das machst macht es keiner. Das ist zwar theoretisch möglich und vor allem ist es leicht, aber es dauert extrem lange. Um ein Pixel mal zu ändern ist es ok, aber nicht um ein Bild zu bearbeiten. Besser, aber etwas komplizierter ist TBitmap.ScanLine. Hier wird eine ganze Zeile einem Zeiger zugewiesen. Du kannst dann innerhalb der Zeile direkt auf die Werte zugreifen. Das ist schnell.

Hier ein Beispiel aus der Hilfedatei:


Delphi-Quelltext 
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.Button1Click(Sender: TObject);

// Zeichnung direkt in das BitMap-Objekt ausgeben
var
  x,y : integer;
  BitMap : TBitMap;
  P : PByteArray;
begin
  BitMap := TBitMap.create;
  try
    BitMap.LoadFromFile('C:\Programme\Borland\Delphi 3\Images\Splash\256color\factory.bmp');
    for y := 0 to BitMap.height -1 do
    begin
      P := BitMap.ScanLine[y];
      for x := 0 to BitMap.width -1 do
        P[x] := Random(65000);
    end;

  canvas.draw(0,0,BitMap);
  finally
    BitMap.free;
  end;
end;


Auf y kannst du nicht direkt zugreifen. Das mußt du erst zuweisen. Auf x kannst du dann direkt zuweisen.

Das ist eine einfache Variante um mit ScanLine zu arbeiten. Wenn du willst, dann kannst du auch direkt auf einzelne RGB Farben zugreifen. Das muß man dan etwas anders machen, geht aber genauso einfach.


Horst_H - Di 21.11.06 22:38
Hallo,

es ging um einen linearen Übergang.
Ich habe ein Image4 hinzugefügt und herumexperimentiert aber scanline funktioniert beim schreiben irgendwie nicht so richtig. Es wird überhaupt nichts geändert, wenn ich byteweise wegschreibe, was beim einlesen ja funktioniert ???

Delphi-Quelltext 
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:
 
unit farbani;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    Image4: TImage;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  tLinInt = packed record
               R0,G0,B0,alpha0 :byte;
               dR,dG,dB,dA     :smallint;
            end;

var
  Form1: TForm1;
  test : TColor;
 R,G,B : byte;
const
 Schritte = 33;
implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var
  DummyFeld : array of tLinINt;
  P :pByte;
  pa : pBytearray;
  i,y,x,step : integer;
  Anteil   : integer;
  Farbpunkt : TCOlor;

begin
setlength(DummyFeld,image1.Width*image1.height);
//Startwerte einlesen
i := 0;
for y := image1.Height-1 downto 0 do
  begin
  p := image1.Picture.Bitmap.ScanLine[y];
  for x := 0 to image1.Width-1 do
    with DummyFeld[i] do
      begin
      B0 := p^;inc(p);
      G0 := p^;inc(p);
      R0 := p^;inc(p);
//      Alpha0 := p^;inc(p);

      inc(i)
      end;
  end;
//Differenzwerte einlesen
i := 0;
for y := image1.Height-1 downto 0 do
  begin
  p := image2.Picture.Bitmap.ScanLine[y];
  for x := 0 to image1.Width-1 do
    with DummyFeld[i] do
      begin
      dB := p^-B0;inc(p);
      dG := p^-G0;inc(p);
      dR := p^-R0;inc(p);
//      dA := p^-Alpha0;inc(p);
      inc(i)
      end;
  end;
//Startzustand kopieren
image4.Picture.Assign(image1.picture);

For step := 1 to Schritte-1 do
  begin
  image4.update;

  Anteil := round((1 shl 16)/schritte * step);
  i := 0;
  for y := image1.Height-1 downto 0 do
    begin
    p := image4.Picture.Bitmap.ScanLine[y];
    for x := 0 to image1.Width-1 do
      begin
      With DummyFeld[i] do
        begin
        B := dB*Anteil shr 16+B0;
        G := dG*Anteil shr 16+G0;
        R := dR*Anteil shr 16+R0;
        end;
      {//dass will nicht funktionieren, obwohl es beim Einlesen offensichtlich funktioniert
      p^:=B;inc(p);
      p^:=G;inc(p);
      p^:=R;inc(p);
      //inc(p);
      }
      image4.Canvas.Pixels[x,y]:=r +g shl 8+b shl 16;
      inc(i);
      end;
    end;
  end;

//Endzustand kopieren
image4.Picture.Assign(image2.picture);

setlength(DummyFeld,0);
end;

end.


Gruss Horst

Moderiert von user profile iconraziel: Code- durch Delphi-Tags ersetzt


Horst_H - Mi 22.11.06 19:24
Hallo,

ich habe mich extremn gewundert, wie es sein kann, das Programm so lahm ist.
Scheinbar ist scanline bei Timage etwas merkwürdig gestaltet.
Anbei eine geänderte Version, in der zuerst in ein Bitmap gerechnet wird und dieses dann anschliessend komplett in das image4 kopiert wird. Bei mir ca. 6 sec für 1000 Schritte also 130 fps, das müsste auch für verwöhnte Ansprüche genügen.
Es funktioniert nur bei 32-Bit Farbauflösung.

Gruss Horst
P.S. Keine Monsterdatei ;-)


DaKirsche - Mi 22.11.06 20:44
Hey....
wenn du jetzt noch in die FormCreate doublebuffered:=True; setzt, dann flackert es auch nicht mehr^^


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!