Canvas.StretchDraw zeichnet immer transparent

[MitjaStachowiak]

Also: Ich habe in meinem Programm ein Bild (Pic). Dieses wird dann aus einer Datei geladen und mit Canvas.StretchDraw in eine PaintBox gezeichnet:

Code: Alles auswählen

var Pic : TPicture;
 
[...]
 
 Pic := TPicture.Create;
 Pic.LoadFromFile('C:\blabla\bild.jpg');
 
[...]
 
 PaintBox.Canvas.StretchDraw(Pos,Pic.Graphic);

Das funktioniert auch ganz gut - nur habe ich auf dem Bild ein Objekt (In meinem Fall einen Apfel) das in einer Blue-Box fotografiert wurde. Zum Anschauen soll das Blau der Box deswegen durch eine andere Farbe ersetzt werden. Das sieht dann so aus:

Code: Alles auswählen

Pic.Bitmap.Canvas.Pixels[x,y] := clGreen;

Wenn ich auf diese Weise alle Pixel im Bild grün mache, sehe ich ein grünes Viereck. Wenn ich aber nur die blauen Pixel grün mache, so wird an diesen Stellen komischer Weise kein Grün, sondern Transparent gezeichnet. Das ist dann die Hintergrundfarbe von der PaintBox und wenn man das Bild verschiebt, gibt es so einen Nachzieh-Effekt, also da wo es grün sein solle, wird das alte Bild einfach nicht übermahlt.
Ich habe schon Pic.Graphic.Transparent oder Pic.Bitmap.Transparent oder auch Pic.Jpeg.Transparent auf false gesetzt, hat aber nicht geholfen
Weiß jemand, woran das liegen kann?

Und außerdem ist Canvas.Pixels[x,y] sehr langsam. Gibt es noch eine schnellere Methode, um auf die Pixel zuzugreifen?

[Euklid]

Hallo,

Wenn ich aber nur die blauen Pixel grün mache, so wird an diesen Stellen komischer Weise kein Grün, sondern Transparent gezeichnet.

Vielleicht kannst Du uns die betreffenden Ausschnitte Deines Codes mal zeigen?

Und außerdem ist Canvas.Pixels[x,y] sehr langsam. Gibt es noch eine schnellere Methode, um auf die Pixel zuzugreifen?

Canvas.Pixels[x,y] ist nur langsam, wenn Du direkt auf ein für den Benutzer sichtbares Objekt malst. Deutlich schneller geht es, wenn man auf eine virtuelle Bitmap zeichnet. (D.h. man erstellt eine Variable vom Typ TBitmap, zeichnet darauf und überträgt z.B. mit Stretchdraw das Bild dann auf eine für den Nutzer sichtbare TImage oder TPicture)

Sag Bescheid, wenn die Schilderung zu grob ist.

Viele Grüße, Euklid

[MitjaStachowiak]

Die Funktion um das Blau wegzufiltern sieht im Moment so aus:

Code: Alles auswählen

type
 TColor = packed record
  R,G,B,A : Byte;
 end;
 
 
 
function Blaufilter(Bild : TPicture; Farbe,Filter : TColor; Abweichung : Word) : TPicture;
var
 x,y  : integer;
 Pix  : TColor;
 IsPixInFilter : Boolean;
 
procedure _IsPixInFilter;
begin
 IsPixInFilter := true;
 if (Power(abs(Pix.R - Filter.R),1.4) > Abweichung) then IsPixInFilter := false;
 if (Power(abs(Pix.G - Filter.G),1.4) > Abweichung) then IsPixInFilter := false;
 if (Power(abs(Pix.B - Filter.B),1.4) > Abweichung) then IsPixInFilter := false;
end;
 
begin
 Result := TPicture.Create;
 Result.Assign(Bild);
 Form1.ProgressBar1.Position := 10;
 for x := 0 to Bild.Width - 1 do begin
  for y := 0 to Bild.Height - 1 do begin
   Cardinal(Pix) := Result.Bitmap.Canvas.Pixels[x,y];
   _IsPixInFilter;
   if (IsPixInFilter) then Result.Bitmap.Canvas.Pixels[x,y] := clGreen;           // Hier werden blaue Pixel grün
 
  end;
  if (Bild.Width > 2) then Form1.ProgressBar1.Position :=
   Round((x + 1) / (Bild.Width) * 190 + 10);
 end;
end;

Bild ist das ungefilterte Foto. Farbe ist die Farbe, die später mal statt dem Grün über die Pixel gemalt werden soll (Hab' da im Moment clGreen, um auszuschließen dass der Fehler hier liegt). Filter ist der Blauton, der weg soll.
Mit einem Wert von 600 für Abweichung bekomme ich das Bild im Anhang. Da habe ich das noch hin- und hergeschoben, damit man sieht, dass es transparent ist.
Wenn ich erst ein Rectangle hinter das Bild zeichne, flackert es beim verschieben

Zugegeben: Der Filter mit Power() ist sicher nicht der beste... Für ein 6 Megapixel-Bild braucht er so über 10 Sekunden (Power geht aber verhältnismäßig schnell - ich werde das mal mit dem virtuellen Bitmap versuchen). Deswegen habe ich noch das Form1.ProgressBar1 dabei...

[Edit] Der Apfel ist übrigens eine Baumanns Renette

[Euklid]

Ja, es sollte deutlich schneller werden, wenn Du es direkt zeichnest.

Zu Deinem Problem:
Ich verstehe nicht, weshalb Du zur Nutzung von TColor den Typ neu definierst und nicht den in der Unit graphics vordefinierten Typ verwendest. Um die Werte für Rot, Grün oder Blau zu erhalten erscheint es mir einfacher, auf die Funktionen Red, Green und Blue zurück zu greifen: http://lazarus-ccr.sourceforge.net/docs ... s/red.html" onclick="window.open(this.href);return false;
Kenne mich hier aber auch nicht genau genug aus, um eine qualifizierte Aussage über die Kompatibilität zwischen dem von Dir definierten Typ und der in Lazarus vordefinierten Farbe clgreen machen zu können.

In Deiner Definition ist ein Alpha-Wert definiert. Ist es möglich, dass dieser durch clgreen auf transparent gesetzt wird? Könntest Du ja mal prüfen.

Viele Grüße, Euklid

[MitjaStachowiak]

Nunja - die neue Typendefinition habe ich gemacht, damit ich leichter auf die Farbwerte zugreifen kann - das Original-TColor müsste genau das selbe sein, nur, dass man da nicht auf die Farbanteile zugreifen kann. Ich wollte hier keine externen Funktionen verwenden, weil das die Sache noch langsamer machen würde. Der Alphawert sollte keine Rolle spielen, da ja die Pixel im Bild nie auf einen von meinen TColor-Werten gesetzt werden, sondern direkt auf clGreen. Außerdem unterstützt das Canvas glaub' ich kein Alphablending.
Ich dachte, vielleicht ist der Compiler durch meine Deklaration von TColor verwirrt... Aber es hilft auch nicht, wenn ich es TRGBColor, oder so, nenne

[MAC]

PaintBox
gibt es dafür ein besonderen Grund oder kann ich dir auch ein TImage empfehlen.
Das hat den Vorteil das kein nachzieheffekt auftaucht.
Du kannst mit ner anderen Form darüber wichen, und nachher wird das bild (ohne flackern) neugezeichnet...

[MitjaStachowiak]

Hm... Mit TImage bekommt man also kein Flackern? Jetzt konnte ich das nicht ausprobieren, weil es beim malen in TImage irgendwie hängen bleibt. Aber allein dadurch, dass ich ein TImage in meiner Form eingefügt habe, ist die Transparenz verschwunden

[EDIT] Liegt doch nicht an TImage (Siehe übernächster Beitrag)

Anscheinend wird dadurch irgend eine Einstellung verändert... Ich werde es jetzt erstmal so lassen.
Aber um es schneller zu machen: Ich mache Bit := TBitmap.Create, schreibe dann da das veränderte Bild rein und setze Picture.Bitmap := Bit? Nur wie kann ich denn die Breite und Höhe des neuen Bildes einstellen, damit es die selbe Abmessung hat, wie das alte - ?

[Euklid]

Nur wie kann ich denn die Breite und Höhe des neuen Bildes einstellen, damit es die selbe Abmessung hat, wie das alte - ?

Du übernimmst einfach Heigh und width des "alten Bitmaps", wählst also die Größe des virtuellen Bitmaps entsprechend.

- Euklid

[MitjaStachowiak]

Also erstmal: Dass die Transparenz jetzt weg ist, liegt doch nicht an dem TImage. Ich hatte hinter dem Befehl, der die blauen Pixel grün macht noch das hier eingefügt:

Code: Alles auswählen

Cardinal(Pix) := Result.Bitmap.Canvas.Pixels[x,y];
   _IsPixInFilter;
   if (IsPixInFilter) then Result.Bitmap.Canvas.Pixels[x,y] := clGreen           // Hier werden blaue Pixel grün
   else Result.Bitmap.Canvas.Pixels[x,y] := Bild.Bitmap.Canvas.Pixels[x,y];    <-- Mit dieser Zeile ist die Transparenz weg!
  end;

Warum das etwas ändert ist mir aber schleierhaft.

Das mit den Bitmaps habe ich jetzt hinbekommen (Es ist TPicture, wo man die Breite und Höhe nicht ändern kann). Schneller ist es aber nicht geworden. Mein Code sieht jetzt so aus:

Code: Alles auswählen

function Blaufilter(Bild : TPicture; Farbe,Filter : TRGBColor; Abweichung :
 Word; Schaerfe : byte) : TPicture;
var
 x,y       : integer;
 a,b,c,d,e : smallint;
 i         : word;
 Pix       : TRGBColor;
 Bit1,Bit2 : TBitmap;
 IsPixInFilter : Boolean;
 
procedure _IsPixInFilter;
begin
 IsPixInFilter := true;
 if (Power(abs(Pix.R - Filter.R),1.4) > Abweichung) then IsPixInFilter := false;
 if (Power(abs(Pix.G - Filter.G),1.4) > Abweichung) then IsPixInFilter := false;
 if (Power(abs(Pix.B - Filter.B),1.4) > Abweichung) then IsPixInFilter := false;
end;
 
begin
 Result := TPicture.Create;
 Form1.ProgressBar1.Position := 10;
 
 Bit1 := TBitmap.Create;
 Bit1.Assign(Bild.Bitmap);
 
 Bit2 := TBitmap.Create;
 Bit2.Height := Bit1.Height;
 Bit2.Width := Bit1.Width;
 for x := 0 to Bit1.Width - 1 do begin
  for y := 0 to Bit1.Height - 1 do begin
   Cardinal(Pix) := Bit1.Canvas.Pixels[x,y];
   _IsPixInFilter;
   if (IsPixInFilter) then Bit2.Canvas.Pixels[x,y] := clGreen
   else Bit2.Canvas.Pixels[x,y] := Bit1.Canvas.Pixels[x,y];
  end;
  if (Bild.Width > 2) then Form1.ProgressBar1.Position :=
   Round((x + 1) / (Bild.Width) * 190 + 10);
 end;
 Result.Bitmap := Bit2;
end;

Der Rechenaufwand durch Power ist nicht das Problem. Wenn ich diese drei Zeilen herausnehme, ist es nichtmal eine Sekunde schneller. Vielleicht ist das Problem ja bei Assign...?

[MAC]

Rechenaufwand feststellen, rechteinfach

Code: Alles auswählen

var
  tada:array of real;
begin
setlength(tada,0);
 
setlength(tada,length(tada)+1);
tada[high(tada)] := now;
//rechnen
setlength(tada,length(tada)+1);
tada[high(tada)] := now;
//rechnen
setlength(tada,length(tada)+1);
tada[high(tada)] := now;
// rechnen
setlength(tada,length(tada)+1);
tada[high(tada)] := now;
// ...
for i := 1 to high(tada) do Memo1.Lines.Add(FloattoStr(tada[i]-tada[i-1])*86400));
end;

Du speicherst einfach nach jedem schritt, oder alle 7,3 schritte die zeit, und am ende berechnest du die differenz von 2 zeiten. *86400 weil *60 sec *60min * 24 stunden = 86400. Vorrausgesetzt natürlich i ist integer und du hast ne memo1


Aufjedenfall kannst du volgendes ändern, man beachte "else":

Code: Alles auswählen

procedure _IsPixInFilter;
begin
 IsPixInFilter := true;
 if (Power(abs(Pix.R - Filter.R),1.4) > Abweichung) then IsPixInFilter := false else
 if (Power(abs(Pix.G - Filter.G),1.4) > Abweichung) then IsPixInFilter := false else
 if (Power(abs(Pix.B - Filter.B),1.4) > Abweichung) then IsPixInFilter := false;
end;

Wenn ich schon dabei bin , der ganze Rest. Eigentlich reicht doch 1 image.

Code: Alles auswählen

begin
 Result := TPicture.Create;
 Form1.ProgressBar1.Position := 10;
 
 Bit1 := TBitmap.Create;
 Bit1.Assign(Bild.Bitmap);
 
 for x := 0 to Bit1.Width - 1 do begin
  for y := 0 to Bit1.Height - 1 do begin
   Cardinal(Pix) := Bit1.Canvas.Pixels[x,y];
   _IsPixInFilter;
   if (IsPixInFilter) then Bit1.Canvas.Pixels[x,y] := clGreen;
  end;
  if ((x mod 20) = 0) and (Bild.Width > 2) then Form1.ProgressBar1.Position :=
   Round((x + 1) / (Bild.Width) * 190 + 10);
 end;
 Result.Bitmap := Bit1;
end;

Ach ja, gerade fällt mir auf , ein problem ist die Prograssbar...
ich hab hier einfach in der ifschleife geaddet , wenn der x wert durch 20 den rest 0 hat ( mod = rest, der rest mit dem man in der grundschule rechnet... )

[MitjaStachowiak]

Hey, das mit dem Else in _IsPixInFilter ist 'ne gute Idee. Danke

Aber wie gesagt - auch wenn ich das komplett herausnehme, ist es kaum schneller. Das Problem ist Canvas.Pixels[]. Ich habe dazu das hier gefunden: http://wiki.delphigl.com/index.php/Pixe ... earbeitung" onclick="window.open(this.href);return false;

Werde ich mal ausprobieren.

[EDIT] Ochnö! Lazarus unterstützt ScanLine nicht (http://wiki.lazarus.freepascal.org/Deve ... raphics/de" onclick="window.open(this.href);return false;). Naja, ich werd's schon schaffen.

[MAC]

wollt ich dir auch gerade sagen, von wegen scanline.
Es gibt ne komponete mit der man scannline nutzen kann, aber welche das ist weis ich nicht mehr, mir was zu kompliziert...

[af0815]

ask theo - oder sucht mal im Forum

[theo]

ask theo - oder sucht mal im Forum

In diesem Thread sind einige Methoden gezeigt:

http://www.lazarusforum.de/viewtopic.php?p=21242#p21242" onclick="window.open(this.href);return false;
http://www.lazarusforum.de/viewtopic.php?p=21251#p21251" onclick="window.open(this.href);return false;

[MitjaStachowiak]

Hm, jetzt hab' ich das schon mit LazIntfImg gemacht. Dauert jetzt zum Filtern ca. 4 Sekunden und mit weichen Rändern ca. 10 Sekunden.
Jetzt sieht meine Funktion so aus:

Code: Alles auswählen

function Blaufilter(Bild : TBitmap; Farbe,Filter : TFPColor; _Abweichung : Byte; Schaerfe : byte) : TBitmap;
var
 Pic1,Pic2    : TLazIntFImage;
 x,y          : integer;
 a,b,c,d,e,f  : smallint;
 i            : word;
 s            : single;
 t            : single;
 Pix          : TFPColor;
 Bit,Mask     : HBitmap;
 Abweichung   : Cardinal;
 
procedure _IsPixInFilter;
begin
 if (Power(abs(Pix.Red - Filter.Red),1.4) < Abweichung)
  and (Power(abs(Pix.Green - Filter.Green),1.4) < Abweichung)
  and (Power(abs(Pix.Blue - Filter.Blue),1.4) < Abweichung) then Pix := Farbe;
end;
 
begin
 Operating := true;
 Abweichung := _Abweichung * 21703;
 if (Farbe.Alpha > 64770) then Farbe.Alpha := 64770;
 Result := TBitmap.Create;
 
 Pic1 := TLazIntFImage.Create(0,0);
 Pic1.LoadFromBitmap(Bild.Handle,Bild.MaskHandle);
 Pic2 := TLazIntFImage.Create(Bild.Width,Bild.Height);
 Pic2.LoadFromBitmap(Bild.Handle,Bild.MaskHandle);
 Form1.ProgressBar1.Position := 10;
 for y := 0 to Bild.Height - 1 do begin
  for x := 0 to Bild.Width - 1 do begin
   Pix := Pic1.Colors[x,y];
   _IsPixInFilter;
   Pic2.Colors[x,y] := Pix;
  end;
  if (Bild.Width > 2) then Form1.ProgressBar1.Position :=
   Round((y + 1) / (Bild.Height) * 60 + 10);
  Application.ProcessMessages;
  if (not Operating) then begin Pic1.Free; Pic2.Free; exit; end;
 end;
 if (Schaerfe > 0) then for y := 0 to Bild.Height - 1 do begin
  x := 0;
  a := y - Schaerfe;
  if (a < 0) then a := 0;
  b := y + Schaerfe;
  if (b >= Bild.Height) then b := Bild.Height - 1;
  c := x - Schaerfe;
  if (c < 0) then c := 0;
  d := x + Schaerfe;
  if (d >= Bild.Width) then d := Bild.Width - 1;
  i := 0;
  for e := a to b do for f := c to d do if (Pic2.Colors[f,e].alpha <> 65535)
   then inc(i);
  for x := 0 to Bild.Width - 1 do begin
   c := x - Schaerfe;
   if (c < 0) then c := 0;
   d := x + Schaerfe;
   if (d >= Bild.Width) then d := Bild.Width - 1;
   if (c > 0) then for e := a to b do if (Pic2.Colors[c - 1,e].Alpha <> 65535)
    then dec(i);
   if (x + Schaerfe < Bild.Width) then for e := a to b do if
    (Pic2.Colors[d,e].Alpha <> 65535) then inc(i);
   pix := Pic2.Colors[x,y];
   s := i / (Schaerfe * Schaerfe * 4);
   Pix.Red := Round(Pix.Red * (1-s) + Farbe.Red * s);
   Pix.Green := Round(Pix.Green * (1-s) + Farbe.Green * s);
   Pix.Blue := Round(Pix.Blue * (1-s) + Farbe.Blue * s);
   Pic2.Colors[x,y] := Pix;
  end;
  if (Bild.Width > 2) then Form1.ProgressBar1.Position :=
   Round((y + 1) / (Bild.Height) * 117 + 70);
  Application.ProcessMessages;
  if (not Operating) then begin Pic1.Free; Pic2.Free; exit; end;
 end;
 Pic2.CreateBitmaps(Bit,Mask,false);
 Form1.ProgressBar1.Position := 190;
 Result.Handle := Bit;
 Form1.ProgressBar1.Position := 193;
 Result.MaskHandle := Mask;
 Form1.ProgressBar1.Position := 196;
 Pic1.Free;
 Pic2.Free;
 Form1.ProgressBar1.Position := 198;
 Operating := false;
end;

Hier kann man jetzt auch den Alpha-Wert einstellen. Canvas kann also doch Alphablending. Der "übermahlte" Bereich ist jetzt immer leicht transparent (254), um einen weichen Übergang zu ermöglichen, ohne jedes Mahl _IsPixInFilter aufrufen zu müssen.

[EDIT] Wenn das Programm während dem Bearbeiten geschlossen wird, muss man in Form.OnClose noch die globale Variable Operating auf false setzten und danach noch ein Application.Processmessages einbauen, damit das Filtern ohne Fehler abgebrochen wird.

Ich denke, es lohnt sich, doch noch was mit Scanline zu machen. Ich schreib' dann nochmal, wenn's fertig ist.