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
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;