Bitmap mit Milchglas-Effekt versehen?

[Wormid]

Moin,

ich versuche gerade mir eine Funktion zu erstellen, die mir einen Ausschnitt eines Bitmaps quasi mit einer Milchglasscheibe überdeckt. Also im Grunde möchte ich einfach eine Weiße Fläche halbtransparent auf ein Bitmap legen. Nur so recht komme ich da nicht weiter.

Das habe ich bisher:

Delphi-Quellcode:

function DrawFrostedGlass(const Bitmap: TBitmap; GlassRect: TRect; Milk: TColor): TBitmap;
var x, y: Integer;
    P: PByteArray;
begin
  Result := TBitmap.Create;
  Result := Bitmap;

  // Den weissen Rahmen malen
  with Result.Canvas do begin
    Pen.Color := Milk;
    Brush.Style := bsClear;
    Rectangle(GlassRect);
  end;

  // Zeilen einzeln auslesen und Pixel einzeln verwursten...
  for y := GlassRect.Top + 1 to GlassRect.Bottom - 1 do
  begin
    P := Result.ScanLine[y];
    for x := GlassRect.Left + 1 to GlassRect.Right - 1 do
    begin
      // Tja, was nun?
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile('splash_3.bmp');

  Image1.Picture.Bitmap := DrawFrostedGlass(Bitmap, Rect(16, 16, 301, 189), clWhite);

  Bitmap.Free;
end;

Im Screenshot kann man im linken Bitmap sehen, wie das Ergebnis aussieht. Im Bild rechts kann man sehen, wie das ganze mal aussehen soll (das ist mit nem Grafikproggie gemacht). Das Bild links ist im Urzustand auch ohne den weißen Rahmen, den will ich auch mitzeichnen...

Ich hoffe, jemand hat ne coole Idee, wie das so gehen kann! :stupid:

Gruß

Wormid

[Wormid]

:roll: Pöh, wenn man hier nicht alles selber macht... :zwinker:

Die "heavy inspiration" habe ich mir hier geholt...

Delphi-Quellcode:

// Alphablending... Heavily inspired by janjan & DerKrasseHans @ DP(rulez)
//      Source => Farbe des Quellpunktes
//      Back   => Farbe des Hintergrundes
//      Alpha  => Transparentheitsgrad in Werten zwischen 0..255
function CalcBlendingColor(const Source, Back: TColor; Alpha: Byte): TColor;
var r, g, b: Byte;
begin
  r :=  ColorToRGB(Back) and $0000FF;
  g := (ColorToRGB(Back) and $00FF00) shr  8;
  b := (ColorToRGB(Back) and $FF0000) shr 16;
  Result := TColor((r + ((((ColorToRGB(Source) and $0000FF)       ) - r) * Alpha) div 255) +
                  ((g + ((((ColorToRGB(Source) and $00FF00) shr  8) - g) * Alpha) div 255) shl 8) +
                  ((b + ((((ColorToRGB(Source) and $FF0000) shr 16) - b) * Alpha) div 255) shl 16));
end;

// "Milchglasscheibe" mit einem 1-Pixel-Rahmen auf ein Bitmap zeichnen...
procedure DrawFrostedGlass(var Bitmap: TBitmap; const GlassRect: TRect; Milk: TColor = clWhite; Alpha: Byte = 128);
var x, y: Integer;
begin
  // Den Rahmen malen
  with Bitmap.Canvas do begin
    Pen.Color := Milk;
    Brush.Style := bsClear;
    Rectangle(GlassRect);
  end;
  // Zeilen einzeln auslesen und Pixel einzeln verwursten...
  for y := GlassRect.Top + 1 to GlassRect.Bottom - 1 do
    for x := GlassRect.Left + 1 to GlassRect.Right - 1 do
      Bitmap.Canvas.Pixels[x, y] := CalcBlendingColor(Bitmap.Canvas.Pixels[x, y], Milk, Alpha);
end;

procedure TForm1.Button1Click(Sender: TObject);
var Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile('splash_3.bmp');

  DrawFrostedGlass(Bitmap, Rect(16, 16, 301, 189), clWhite, 175);
  Image1.Picture.Bitmap := Bitmap;

  Bitmap.Free;
end;

Funzen tut das ganze jetzt zwar... aber die Routine scheint sehr langsam zu sein. Hat jemand ne Idee, wie das vielleicht besser geht? Die Nummer mit "Scanline" habe ich nicht hinbekommen, da kam immer nur Farbensalat bei rum... :wall:


Gruß

Wormid

[Sanchez]

hallo,
der Zugriff auf die Pixels ist sehr langsam, am Besten du löst das mit Scanlines

grüße, daniel

[EDIT]Sorry, hab grad erst gesehen, dass du die Scanlines schon probiert hast
Hast du auch dran gedacht das Pixelformat festzulegen, z.B:

Delphi-Quellcode:

  MyBitmap.PixelFormat:= pf24Bit;

[Wormid]

Tja... die Sache mit den Pixelformaten war mir irgendwie noch neu... :oops: Thx für den Tip.

Raus kam dabei jetzt folgendes:

Delphi-Quellcode:

// Einen TColor-Wert in die einzelnen RGB-Anteile umrechnen
procedure SplitColorToRGB(const Color: TColor; var r, g, b: Byte);
begin
  r :=  ColorToRGB(Color) and $0000FF;
  g := (ColorToRGB(Color) and $00FF00) shr  8;
  b := (ColorToRGB(Color) and $FF0000) shr 16;
end;

// Einzelne RGB-Anteile in einen TColor-Wert umrechnen
function RGBToColor(const r, g, b: Byte): TColor;
begin
  Result := TColor(r + (g shl 8) + (b shl 16));
end;

// Alphablending...
function CalcBlending(const Source, Back, Alpha: Byte): Byte;
begin
  Result := Back + ((Source - Back) * Alpha div 255);
end;

// "Milchglasscheibe" mit einem 1-Pixel-Rahmen auf ein Bitmap zeichnen...
procedure DrawFrostedGlass(var Bitmap: TBitmap; GlassRect: TRect; const Milk: TColor = clWhite; Alpha: Byte = 128);
var r, g, b: Byte;
    x, y: Integer;
    P: PByteArray;
begin
  // Den Rahmen malen
  with Bitmap.Canvas, Bitmap.Canvas.Pen do begin
    Color := Milk;
    Style := psSolid;
    Width := 1;
    Brush.Style := bsClear;
    Rectangle(GlassRect);
  end;

  // Vorbereitungen für das AlphaBlending
  Bitmap.PixelFormat := pf24Bit;
  GlassRect.Left  := (GlassRect.Left  * 3) + 3;
  GlassRect.Right := (GlassRect.Right * 3) - 3;
  SplitColorToRGB(Milk, r, g, b);

  // Zeilen einzeln auslesen und Pixel einzeln verwursten...
  for y := GlassRect.Top + 1 to GlassRect.Bottom - 1 do
  begin
    P := Bitmap.ScanLine[y];
    x := GlassRect.Left;
    repeat
      P[x+0] := CalcBlending(P[x+0], r, Alpha);
      P[x+1] := CalcBlending(P[x+1], g, Alpha);
      P[x+2] := CalcBlending(P[x+2], b, Alpha);
      Inc(x, 3);
    until x >= GlassRect.Right;
  end;
end;

Die Routine ist jetzt zwar etwas länger (und das repeat ... until passt mir auch nicht), aber sie ist spürbar schneller, als die erste Variante!

Gruß

Wormid

[Tonic1024]

Moin...

Ich mix mich hier mal rein, obwohl ich nichts sinnvolles beizusteuern habe... Aber dieser Milchlas-Effekt interessiert mich jetzt grade mal...

Ich habe mit Pixel und Bildbearbeitung praktisch keinerlei Erfahrung, habe aber eine (privates) Projekt in Vorbereitung, wo ich das gut gebrauchen kann...

Gleich mal vorweg... Ich weiss schon was ein RGB-Wert ist, was der macht und wie man damit umgeht. Zahlen sind mir durchaus Sympathisch und auch "Binär-Tricksereien" mag ich sehr... :lol:

Ich habe mir den Source mal genauer angeschaut... Habe hier leider keine Möglichkeit zu testen (wenn mein chef das sieht...:roll:) und zu Haus (noch) kein Delphi. Spare lieber auf ein Original statt Esel-Ware.

Was ist/macht alphablending im allgemeinen? Wie es geht steht ja oben...

Wormit schrieb, es dauerte sehr lange. Wie lange ist Lange? Gar mehrere Sekunden oder doch weniger? Und bei welchem Umfang (Bildgröße)?

bis denne...

[Sanchez]

Alphablending bringt Transparenz bzw. Überblendeffekte.
Sehr langsam ist allerdings nur die erste Version mit den pixels, mit den Scanlines gehts ungleich schneller.

[Wormid]

Zitat:

Zitat von Tonic1024

Wormit schrieb, es dauerte sehr lange. Wie lange ist Lange? Gar mehrere Sekunden oder doch weniger? Und bei welchem Umfang (Bildgröße)?

bis denne...

Die Bilder mit denen ich jetzt getestet habe waren 320 * 240 Pixel groß... als Bitmap so um die 230kb. Bei der ersten Version war eine kurze Verzögerung beim Aufbau des Bildes zu spüren (~ 1 Sekunde auf nem AMD XP2600), bei der zweiten Version erscheint das Bild scheinbar sofort.

Gruß

Wormid

[Gandalfus]

http://www.tutorials.delphi-source.d.../file007.shtml
und
http://www.sokratez.de/alphablending.htm

[static_cast]

Hi Wormid,

ich hab einen kleinen Fehler gefunden, in deinem Code steht:

Delphi-Quellcode:

P[x+0] := CalcBlending(P[x+0], r, Alpha);
P[x+1] := CalcBlending(P[x+1], g, Alpha);
P[x+2] := CalcBlending(P[x+2], b, Alpha);

aber es müsste so sein:

Delphi-Quellcode:

P[x+0] := CalcBlending(P[x+0], b, Alpha);
P[x+1] := CalcBlending(P[x+1], g, Alpha);
P[x+2] := CalcBlending(P[x+2], r, Alpha);

da sonst alle Farben invertiert sind, bei weiß fällt es ja nicht auf aber als ich es mit skyblue versucht habe wunderte ich mich warum er immer so ein k* braun bei rauskommt ;)


Gruß,
Daniel