Canvas.StretchDraw zeichnet immer transparent

[MitjaStachowiak]

Äm - in welcher Unit ist TCanvasOPBitmap?

[EDIT] Ah, hier: http://www.lazarusforum.de/viewtopic.php?t=392" onclick="window.open(this.href);return false;

[MitjaStachowiak]

Jetzt bräuchte ich nochmal Hilfe...
Also ich hab' jetzt erstmal nur ein TCanvasOPBitmap. Dann schreibe ich das Bild da rein und das TCanvasOPBitmap (ohne etwas verändert zu haben) in Result:

Code: Alles auswählen

Operating := true;
 Result := TBitmap.Create;
 Pic1 := TCanvasOPBitmap.Create;
 Pic1.Height := Bild.Height;
 Pic1.Width := Bild.Width;
 AssignOpBitmapToBitmap(Pic1,Bild);
 if (Pic1.PixelFormat <> pf32bit) then exit;
 
 Result.Height := Pic1.Height;
 Result.Width := Pic1.Width;
 AssignBitmapToOPBitmap(Result,Pic1);
 Pic1.Free;
 Operating := false;
 showmessage('done');

Das Programm zeigt mir zwar jetzt ein 'done', aber das Bild ist immer schwarz

Könnte sein, dass ich die falschen Header für OPBitmap verwende (Musste verschiedenes zusammensuchen). Also (@ theo) was mache ich falsch?

[theo]

Also erstmal: Die letzte Version ist hier: http://www.theo.ch/lazarus/opbitmap64.zip" onclick="window.open(this.href);return false;

Zu deinem Problem:

Ich weiss nicht genau was "Bild" ist, aber die Zuweisung von OPBitmap an Bild (AssignOpBitmapToBitmap) ist sicher nicht richtig, da OPBitmap ja leer ist nach dem createn. Also umgekehrt: AssignBitmapToOPBitmap und unten dann auch wieder umgekehrt.

[MitjaStachowiak]

Aha, dann hatte ich wohl das Assign genau falschrum. Jetzt geht's. Mit den richtigen Feineinstellungen braucht man auch Power nicht. Ich bekomme jetzt mit einer simplen Quadrierung gute Ergebnisse:

Code: Alles auswählen

type
 TRGBAColor = packed record
  B,G,R,A : byte;
 end;
 TPixCast = Array [0..1] of TRGBAColor;
 PPixCast = ^TPixCast;
 
 
function Blaufilter(Bild : TBitmap; Farbe,Filter : TRGBAColor; _Abweichung : Byte; Schaerfe : byte) : TBitmap;
var
 Pic1         : TCanvasOPBitmap;
 x,y          : integer;
 lines        : Array of PPixCast;
 a,b,c,d,e,f  : smallint;
 i            : word;
 s            : single;
 t            : single;
 Pix          : TRGBAColor;
 Bit,Mask     : HBitmap;
 Abweichung   : word;
 
procedure _IsPixInFilter;
begin
 if ((Pix.R - Filter.R) * (Pix.R - Filter.R) < Abweichung)
  and ((Pix.G - Filter.G) * (Pix.G - Filter.G) < Abweichung)
  and ((Pix.B - Filter.B) * (Pix.B - Filter.B) < Abweichung) then Pix := Farbe;
end;
 
begin
 Operating := true;
 if (Farbe.A > 254) then Farbe.A := 254;
 Result := TBitmap.Create;
 Abweichung := _Abweichung * _Abweichung;
 
 Pic1 := TCanvasOPBitmap.Create;
 Pic1.Height := Bild.Height;
 Pic1.Width := Bild.Width;
 AssignBitmapToOPBitmap(Bild,Pic1);
 if (Pic1.PixelFormat <> pf32bit) then exit;
 SetLength(Lines,Bild.Height);
 Form1.ProgressBar1.Position := 10;
 for y := 0 to Bild.Height - 1 do begin
  Lines[y] := Pic1.ScanLine[y];
  for x := 0 to Bild.Width - 1 do begin
   Pix := Lines[y]^[x];
   _IsPixInFilter;
   Lines[y]^[x] := 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; 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;
  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;
   i := 0;
   for e := a to b do for f := c to d do if (Lines[e]^[f].a <> 255)
    then inc(i);
   pix := Lines[y]^[x];
   s := i / (Schaerfe * Schaerfe * 4) * 1.9;
   if (s > 1) then s := 1;
   Pix.R := Round(Pix.R * (1-s) + Farbe.R * s);
   Pix.G := Round(Pix.G * (1-s) + Farbe.G * s);
   Pix.B := Round(Pix.B * (1-s) + Farbe.B * s);
   Lines[y]^[x] := 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; exit; end;
 end;
 Form1.ProgressBar1.Position := 190;
 Result.Height := Pic1.Height;
 Result.Width := Pic1.Width;
 AssignOPBitmapToBitmap(Pic1,Result);
 Pic1.Free;
 Form1.ProgressBar1.Position := 198;
 Operating := false;
end;

Könnte man sicher noch schneller machen... Aber so geht's jetzt auch.

[Euklid]

Also erstmal: Die letzte Version ist hier: http://www.theo.ch/lazarus/opbitmap64.zip" onclick="window.open(this.href);return false;

Die jeweils aktuellste Version Deines Projektes lässt sich in der Tat nur sehr schwer finden, Theo. Wollte die schon ein paar mal weiterempfehlen und war ziemlich verwirrt. Vielleicht möchtest Du bei LazForge eine Seite aufmachen oder hier im Forum über eigene Komponenten eine stets aktuelle Seite halten? Ne zentrale Seite, bei der man sicher gehen kann, dass es sich um die aktuelle Version handelt, wäre jedenfalls schön.


- Euklid

[theo]

Hier im ersten Beitrag ist das immer der Fall. Hier sind auch alle Versionen aufgelistet.
http://www.lazarusforum.de/viewtopic.php?f=29&t=434" onclick="window.open(this.href);return false;

[MitjaStachowiak]

Hm.. wenn man OPBitmap in Google sucht, ist dieser Beitrag zwar gleich an zweiter Stelle, aber da steht dann "Deutsches Lazarusforum • Thema anzeigen - OpBitmap mit Formaten...". Also ich hab' da fünf mal drübergelesen.
Vielleicht sollt man das mal umbenennen - wäre schade, wenn so ein sinnvolles Projekt nicht (noch mehr) genutzt wird.

[MAC]

wenn du das bild einmal laden tust und dann 700 mal filterst. Ist es empfehlenswert Das bild in einen

Code: Alles auswählen

MeinBild:array of array of TMyOwnColor;

zu schreiben.

Code: Alles auswählen

TMyOwnColor = record
c:array [0..2] of integer;
end;

// eventuell kannst du byte statt integer nehmen. Musst du mal versuchen.
Anmerkung [0..2] ist schneller als red,green,blue:integer; , weil man das in einer schleife bearbeiten kann und moderne CPU's schleifen besser verarbeiten...
Und beim beginn hast du dann en

Code: Alles auswählen

Image1.Pircture.LoadfromFile...;
setlength(MeinBild,Image1.Width,Image1.Height);
for x := 0 to Image1.Width do
begin
for y := 0 to Image1.Height do
begin
// buffer ist integer;
buffer := Image1.Canvas.Color
Meinbild[x,y].c[0] := red(buffer);
Meinbild[x,y].c[1] := green(buffer);
Meinbild[x,y].c[2] := blue(buffer);
end;
end;

beim bearbeiten entsprechen im Array bearbeiten, dann

Code: Alles auswählen

VBitmap := TBitmap.Create;
aBitmap.Width := length(Meinbild);
if length(Meinbild) > 0 then aBitmap.Height := length(Meinbild[0]);
For x.. breit , for y zu hoch do
VBitmap.Canvas.Pixels[x,y] := Meinbild[x,y].c[0] + Meinbild[x,y].c[1] *256 + Meinbild[x,y].c[0] * 256*256;
 
dann: Image1.Picture.Bimap := VBitmap;

Damit bekomme ich so ca.25 Bilder pro sekunde hin. Versteht sich mit 3D rotation, Antialaising und Sotierung von vorne nach hinten.
PS: auf nen 6 Jahre altem Systen, natürlich xD

[MitjaStachowiak]

Danke, solche Tipps mag ich. Bis man sich so was selber erarbeitet hat vergehen Jahre
Für dieses Programm werde ich es aber jetzt so lassen.

Was Performance angeht habe ich größere Schwierigkeiten, alle CPUs gleichzeitig auszulasten - wo es doch jetzt schon Hexa-Core im privaten Bereich gibt...

[MAC]

Hexa core mäßig kann man das mit multithearding (TThread) machen. Anleitungen gibt es genug auf google. Ist nen bisschen kompliziert. aber wenn mans mal verstanden hat sollte es machbar sein (anscheinent gibt es debugger probleme).

Dann spalltet man das folgene auf. Von

Code: Alles auswählen

For x := 0 to breit do for y := 0 to hoch do
VBitmap.Canvas.Pixels[x,y] := Meinbild[x,y].c[0] + Meinbild[x,y].c[1] *256 + Meinbild[x,y].c[0] * 256*256;

zu

Code: Alles auswählen

//TThread 1
x-tel := (breit)/4;   // 4 = 4 Threads
For x := 0 to x-tel do    for y := 0 to hoch do
VBitmap.Canvas.Pixels[x,y] := Meinbild[x,y].c[0] + Meinbild[x,y].c[1] *256 + Meinbild[x,y].c[0] * 256*256;
//TThread 2
For x := x-tel+1 to x-tel*2 do    for y := 0 to hoch do
VBitmap.Canvas.Pixels[x,y] := Meinbild[x,y].c[0] + Meinbild[x,y].c[1] *256 + Meinbild[x,y].c[0] * 256*256;
//TThread 3
For x := x-tel*2+1 to x-tel*3 do    for y := 0 to hoch do
VBitmap.Canvas.Pixels[x,y] := Meinbild[x,y].c[0] + Meinbild[x,y].c[1] *256 + Meinbild[x,y].c[0] * 256*256;
//TThread 4
For x := x-tel*3+1 to x-tel*4 do    for y := 0 to hoch do
VBitmap.Canvas.Pixels[x,y] := Meinbild[x,y].c[0] + Meinbild[x,y].c[1] *256 + Meinbild[x,y].c[0] * 256*256;

Das sollte das rechenanwendigste sein. + Die for schleife am anfang...
Und da das so einfach ist könnte man das auch in eine belibige anzahl von TThread aufspalten... Ach ja, selbst bei einem Quadcore lohnt es sich mehr als 4 Kerne zu machen (z.B. 8 oder 12). Da es manchmal passiert das einige schneller fertig sind...
Das Thema werd ich mir aber erst richtig angucken wenn ich meinen neuen Pc habe

[theo]

wenn du das bild einmal laden tust und dann 700 mal filterst. Ist es empfehlenswert Das bild in einen

Code: Alles auswählen

MeinBild:array of array of TMyOwnColor;

Da kannst du gleich OPBitmap nehmen, das funktioniert auch so, ist aber komfortabler.

Damit bekomme ich so ca.25 Bilder pro sekunde hin.

Das würde höchstens in Zusammenhang mit der Bildgrösse / Farbtiefe etwas aussagen.

[MitjaStachowiak]

Naja - ob jetzt Pointercasting oder Array schneller ist, liegt, denke ich, in erster Linie daran, was der Compiler daraus macht. Richtige Optotechniker machen das vermutlich dann alles mit Assembler.

[theo]

Naja - ob jetzt Pointercasting oder Array schneller ist, liegt, denke ich, in erster Linie daran, was der Compiler daraus macht.

Auf OPBitmap kann man auf unterschiedliche Weisen zugreifen. Komfortabler oder schneller. So geht z.B. auch:

Code: Alles auswählen

var Op:TCanvasOPBitmap;
  i,x,y:integer;
  Pix: PPixel32;
begin
  i:=1;
  x:=1;
  y:=1;
  Op.PixelFormat:=pf32bit;
  //So
  TBitmapData32(Op.Data).RawArray^[i].Blue:=255;
  //oder so
  pix:=@TBitmapData32(Op.Data).NativePixels[x,y];
  pix^.Alpha := $FF;
  pix^.Blue := $0A;
end;

Richtige Optotechniker machen das vermutlich dann alles mit Assembler.

Vielleicht ist da beim reinen Zugriff gar nicht mehr soo viel rauszuholen.

[MAC]

ich glaub dir das opbitmap kompfortabler ist. nur hat es bei mir nicht beim ersten mal geklappt und dann hab ich mir gedacht wieso nicht alles selber machen, dann versteht man auch mehr