Bitmap schärfen

[barese]

Hallo Coders.!
Ich tappe wieder im dunkel und such das Licht.

Möchte mit der Procedur ein Bitmap in einer TImage schärfen.
Lässt sich auch compilieren, aber ich hab es nicht geschaft es anzuwenden. Hoffe ihr habt da vieleicht ne idee..!

Delphi-Quellcode:

...

uses jpeg

...

procedure Sharpen(sbm, tbm: TBitmap; alpha: Single);
var
  i, j, k: integer;
  sr: array[0..2] of PByte;
  st: array[0..4] of pRGBTriple;
  tr: PByte;
  tt, p: pRGBTriple;
  beta: Single;
  inta, intb: integer;
  bmh, bmw: integer;
  re, gr, bl: integer;
  BytesPerScanline: integer;

begin
  Assert((sbm.Width > 2) and (sbm.Height > 2), 'Bitmap must be at least 3x3');
  Assert((alpha > 1) and (alpha < 6), 'Alpha must be >1 and <6');
  beta := (alpha - 1) / 5; 
  intb := round(beta * $10000);
  inta := round(alpha * $10000); 
  sbm.PixelFormat := pf24bit;
  tbm.PixelFormat := pf24bit;
  tbm.Width := sbm.Width;
  tbm.Height := sbm.Height;
  bmw := sbm.Width - 2;
  bmh := sbm.Height - 2;
  BytesPerScanline := (((bmw + 2) * 24 + 31) and not 31) div 8;

  tr := tbm.Scanline[0];
  tt := pRGBTriple(tr);

  sr[0] := sbm.Scanline[0];
  st[0] := pRGBTriple(sr[0]);
  for j := 0 to bmw + 1 do
  begin
    tt^ := st[0]^;
    inc(tt); inc(st[0]); 
  end;

  sr[1] := PByte(integer(sr[0]) - BytesPerScanline);
  sr[2] := PByte(integer(sr[1]) - BytesPerScanline);
  for i := 1 to bmh do
  begin
    Dec(tr, BytesPerScanline);
    tt := pRGBTriple(tr);
    st[0] := pRGBTriple(integer(sr[0]) + 3); 
    st[1] := pRGBTriple(sr[1]); //left
    st[2] := pRGBTriple(integer(sr[1]) + 3);
    st[3] := pRGBTriple(integer(sr[1]) + 6); 
    st[4] := pRGBTriple(integer(sr[2]) + 3); 
    tt^ := st[1]^; //1st col unchanged
    for j := 1 to bmw do
    begin
      re := 0; gr := 0; bl := 0;
      for k := 0 to 4 do
      begin
        re := re + st[k]^.rgbtRed;
        gr := gr + st[k]^.rgbtGreen;
        bl := bl + st[k]^.rgbtBlue;
        inc(st[k]);
      end;
      re := (intb * re + $7FFF) shr 16;
      gr := (intb * gr + $7FFF) shr 16;
      bl := (intb * bl + $7FFF) shr 16;
      p := pRGBTriple(st[1]); 
      re := (inta * p^.rgbtRed + $7FFF) shr 16 - re;
      gr := (inta * p^.rgbtGreen + $7FFF) shr 16 - gr;
      bl := (inta * p^.rgbtBlue + $7FFF) shr 16 - bl;
      inc(tt);
      if re < 0 then
        re := 0
      else
        if re > 255 then
          re := 255;
      if gr < 0 then
        gr := 0
      else
        if gr > 255 then
          gr := 255;
      if bl < 0 then
        bl := 0
      else
        if bl > 255 then
          bl := 255;
      tt^.rgbtRed := re;
      tt^.rgbtGreen := gr;
      tt^.rgbtBlue := bl;
    end;
    inc(tt);
    inc(st[1]);
    tt^ := st[1]^; 
    sr[0] := sr[1];
    sr[1] := sr[2];
    Dec(sr[2], BytesPerScanline);
  end;
  Dec(tr, BytesPerScanline);
  tt := pRGBTriple(tr);
  st[1] := pRGBTriple(sr[1]);
  for j := 0 to bmw + 1 do
  begin
    tt^ := st[1]^;
    inc(tt); inc(st[1]);
  end;
end;

[himitsu]

Zitat:

aber ich hab es nicht geschaft es anzuwenden.

Wie meinst'n das?

Man gibt der Prozedur zwei Bitmaps mit.
In Einem ist das gewünschte Bild und in das Andere wird nun das geschärfte Bild reinkopiert.

[barese]

@ himitsu

Ich weiss nicht wie ich die Procedur anwenden soll.
Natürlich zwei Bitmaps das weiss ich, aber ich brauch eine Befehlszeile
für die Procedur, hast du da ne idee...[?]

[mkinzler]

Sharpen( Bitmap1, Bitmap2, alpha);

[Sir Rufo]

Zitat von barese:

@ himitsu

Ich weiss nicht wie ich die Procedur anwenden soll.
Natürlich zwei Bitmaps das weiss ich, aber ich brauch eine Befehlszeile
für die Procedur, hast du da ne idee...[?]

Delphi-Quellcode:

var
  sbm, tbm : TBimap;
begin
  sbm := TBitmap.Create;
  tbm := TBitmap.Create;
  // sbm jetzt mit dem Bitmap füllen

  // Schärfen
  Sharpen( sbm, tbm, 20 );
  // tbm dahin packen, wo benötigt

  // Instanzen freigeben
  sbm.Free;
  tbm.Free;
end;

[Luckie]

Delphi-Quellcode:

Bitmap1 := TBitmap.Create;
Bitmap2 := TBitmap.Create;
foo(Bitmap1, Bitmap2, 0.75);

[barese]

@ Sir Rufo..

..ach gott Alpha Single ist ein Integer. man bin ich bl..!

Danke !

[mkinzler]

Nein ein Single ist der kleinste Fliesskomma-Typ

[barese]

Ja ...

..mein fehler war das ich anstatt ein Integer eine String für den alpha single benutzt habe.

Man drei tage verzweiflung..!

[Sir Rufo]

Und das obwohl der Code von mir und Luckie einen Fehler beim Aufruf produzieren
Assert((alpha > 1) and (alpha < 6), 'Alpha must be >1 and <6');