Zmiana kontrastu mapy bitowej

0

Witam.
Mam mape bitowa i chcialbym zwiekszyc jej kontrast o x%. Czy da sie zrobic cos takiego bez uzycia delphix i filtrow, jesli nie to w jaki sposob zrobic to w DX?

0

da sie zrobić - jest troche zabawy z pixelami - poczytaj troche o histogramie - bo troche za złożony problem żeby go tłumaczyć - jak znajdę jakiś kodzik to podrzucę

0

Znalazłem jakiś kodzik - wrzuć na formę 2 image, 2 buttony, 1 edit

Oto kodzik

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Image2: TImage;
    Edit1: TEdit;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure Sharpen(sbm, tbm: TBitmap; alpha: Single);
//to sharpen, alpha must be >1.
//pixelformat pf24bit
//sharpens sbm to tbm
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
  //sharpening is blending of the current pixel
  //with the average of the surrounding ones,
  //but with a negative weight for the average
  Assert((sbm.Width > 2) and (sbm.Height > 2), 'Bitmap must be at least 3x3');
  Assert((alpha > 1) and (alpha < 21), 'Alpha must be >1 and <6');
  beta := (alpha - 1) / 5; //we assume alpha>1 and beta<1
  intb := round(beta * $10000);
  inta := round(alpha * $10000); //integer scaled alpha and beta
  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]); //first row unchanged
  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); //top
    st[1] := pRGBTriple(sr[1]); //left
    st[2] := pRGBTriple(integer(sr[1]) + 3); //center
    st[3] := pRGBTriple(integer(sr[1]) + 6); //right
    st[4] := pRGBTriple(integer(sr[2]) + 3); //bottom
    tt^ := st[1]^; //1st col unchanged
    for j := 1 to bmw do
    begin
    //calcutate average weighted by -beta
      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;

    //add center pixel weighted by alpha
      p := pRGBTriple(st[1]); //after inc, st[1] is at center
      re := (inta * p^.rgbtRed + $7FFF) shr 16 - re;
      gr := (inta * p^.rgbtGreen + $7FFF) shr 16 - gr;
      bl := (inta * p^.rgbtBlue + $7FFF) shr 16 - bl;

    //clamp and move into target pixel
      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;
      //this looks stupid, but avoids function calls

      tt^.rgbtRed := re;
      tt^.rgbtGreen := gr;
      tt^.rgbtBlue := bl;
    end;
    inc(tt);
    inc(st[1]);
    tt^ := st[1]^; //Last col unchanged
    sr[0] := sr[1];
    sr[1] := sr[2];
    Dec(sr[2], BytesPerScanline);
  end;
  // copy last row
  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;

procedure TForm1.Button2Click(Sender: TObject);
begin
    Sharpen(Image1.Picture.Bitmap,image2.Picture.Bitmap, StrTofloat(Edit1.text));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Image1.Picture.LoadFromFile('aa.bmp');
end;

end.
0

czemu to sie nazywa sharpen?

0
procedure Contrast(var Bitmap:TBitmap; Amount: Integer);
var
ByteWsk:^Byte;
H,V:  Integer;
begin
  for V:=0 to Bitmap.Height-1 do
  begin
    ByteWsk:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width*3 -1  do
    begin
      if ByteWsk^>127 then
      ByteWsk^:=IntToByte(ByteWsk^+(Abs(127-ByteWsk^)*Amount)div 255)
      else ByteWsk^:=IntToByte(ByteWsk^-(Abs(127-ByteWsk^)*Amount)div 255);
      Inc(ByteWsk);
    end;
  end;
end;

1 użytkowników online, w tym zalogowanych: 0, gości: 1