Einzelnen Beitrag anzeigen

Benutzerbild von barese
barese

Registriert seit: 27. Nov 2009
Ort: Berlin
35 Beiträge
 
Delphi 11 Alexandria
 
#1

Bitmap schärfen

  Alt 24. Apr 2011, 11:17
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;
Vergessen
  Mit Zitat antworten Zitat