Bu çalışma boyunca bulduğum ve/veya yazdığım kodları burada paylaşacağım.
Şimdilik klasik bir kaç kullanım örneği yazacağım.
Genellikle resim üzerinde işlemler yapılırken pixel pixel tarama kullanılıryor (ki ben de onlardan birisiyim)
ancak pixel tarama ile ilgili yaptığınız işleri Scanline ile tekrar elden geçirin ve aradaki muazzam süre farkını görün.
1. Örneğimiz resmi siyah beyaz yapma
Aşağıdaki örnekle ilgili iki şey belirtmek istiyorum.
birincisi her ne kadar resimdeki renkleri siyah ve beyaz yapıyor ise de oluşturduğu resim 24 bitlik bir resimdir. Yani diğer renkler kullanılabilir.
ikincisi TColor olarak verdiğimiz Referans, bazı resimlerdeki açık renkleri atlamayı sağlama içindir.
Şöyleki krem rengi veya bazı nesnelere verilen hafif arkaplan rennkleri de beyaza yakın bir renktir ama resimde görülmez veya dikkat çekmezken siyah beyazda çirkin görüntülere sebep olabilir burada ReferenceColor deyimi üst limit olarak belirlenebilir.
Kod: Tümünü seç
Procedure ToMono(Bm: TBitmap; ReferenceColor : TColor = clWhite);
CONST
PixelCountMax = 32768;
TYPE
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = ARRAY [0 .. PixelCountMax - 1] OF TRGBTriple;
VAR
Bmp: TBitmap;
i: Integer;
j: Integer;
RowIn: pRGBTripleArray; // pByteArray;
RowOut: pRGBTripleArray; // pByteArray;
Cl: TColor;
gr: Byte;
begin
Bmp := TBitmap.Create;
Bm.PixelFormat := pf24bit;
try
Bmp.Width := Bm.Width;
Bmp.Height := Bm.Height;
Bmp.PixelFormat := Bm.PixelFormat;
FOR j := 0 TO Bmp.Height - 1 DO
Begin
RowOut := Bmp.Scanline[j];
RowIn := Bm.Scanline[j];
i := 0;
while i <= Bmp.Width - (1) do
Begin
Cl := RGB(RowIn[i].rgbtRed, RowIn[i].rgbtGreen, RowIn[i].rgbtBlue);
if cl < ReferenceColor then gr := 0 else gr := 255;
RowOut[i].rgbtRed := gr;
RowOut[i].rgbtGreen := gr;
RowOut[i].rgbtBlue := gr;
inc(i, 1);
End;
end;
Bm.Assign(Bmp);
finally
Bmp.Free;
End;
End;
Kod: Tümünü seç
ToMono(xResim.Picture.Bitmap, RGB(255,255,255){clWhite});
ToMono(xResim.Picture.Bitmap, clWhite);
ToMono(xResim.Picture.Bitmap);
ToMono(xResim.Picture.Bitmap, RGB(200,200,200)); // daha temiz bir resim çıkar
gri dediğimiz olay aslında RGB biçimindeki renklerin Red Green Blue tonlarının birbirine eşit veya çok yakın ollması olayıdır.
öyle ise
Kod: Tümünü seç
Function ColorToGrayTone(Color: TColor): Byte;
var
l: LongInt;
r, g, b: Byte;
Begin
l := ColorToRGB(Color);
r := Byte(l);
g := Byte(l shr 8);
b := Byte(l shr 16);
Result := Round(r * 0.299 + g * 0.587 + b * 0.114)
End;
Kod: Tümünü seç
Function ColorToGrayScale(Color: TColor): TColor;
Var
GT: Byte;
Begin
GT := ColorToGrayTone(Color);
Result := RGB(GT, GT, GT);
End;
son olarak Mono resim örneğimizi biraz değiştirerek gri bir resim elde edebiliriz.
Kod: Tümünü seç
Procedure ToGrayScale(Bm: TBitmap);
CONST
PixelCountMax = 32768;
TYPE
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = ARRAY [0 .. PixelCountMax - 1] OF TRGBTriple;
VAR
Bmp: TBitmap;
i: Integer;
j: Integer;
RowIn: pRGBTripleArray; // pByteArray;
RowOut: pRGBTripleArray; // pByteArray;
Cl: TColor;
gr: Byte;
begin
Bmp := TBitmap.Create;
Bm.PixelFormat := pf24bit;
try
Bmp.Width := Bm.Width;
Bmp.Height := Bm.Height;
Bmp.PixelFormat := Bm.PixelFormat;
FOR j := 0 TO Bmp.Height - 1 DO
Begin
RowOut := Bmp.Scanline[j];
RowIn := Bm.Scanline[j];
i := 0;
while i <= Bmp.Width - (1) do
Begin
Cl := RGB(RowIn[i].rgbtRed, RowIn[i].rgbtGreen, RowIn[i].rgbtBlue);
gr := ColorToGrayTone(Cl);
RowOut[i].rgbtRed := gr;
RowOut[i].rgbtGreen := gr;
RowOut[i].rgbtBlue := gr;
inc(i, 1);
End;
end;
Bm.Assign(Bmp);
finally
Bmp.Free;
End;
End;
aşağıdaki örneğin orjinalinde real tipi kulllanılmaktaydı ancak daha hassas işlemler için extended olarak değiştirdim.
sebebine gelince
Kod: Tümünü seç
var
a : extended;
b : real;
begin
a:= 1/6;
b:= 1/6;
Showmessage('Extended a :['+VarTostr(a) + '] = 1/6[' + VarToStr(1/6) + '] ? ' + VarToStr(a=1/6) + #13#10 +
'Real b :['+VarTostr(b) + '] = 1/6[' + VarToStr(1/6) + '] ? ' + VarToStr(b=1/6));
end;
Kod: Tümünü seç
Extended a :[0,166666666666667] = 1/6[0,166666666666667] ? True
Real b :[0,166666666666667] = 1/6[0,166666666666667] ? False
Kod: Tümünü seç
Procedure GetDPI(Image: TBitmap; var DPIX, DPIY: Extended);
Var
Temp, DPMX, DPMY: integer;
Stream: TMemoryStream;
Begin
Stream := TMemoryStream.Create;
Image.SaveToStream(Stream);
Stream.Seek($0E, soFromBeginning);
Stream.Read(Temp, 4);
If Temp = $28 then
Begin
Stream.Seek($26, soFromBeginning);
Stream.Read(DPMX, 4);
Stream.Read(DPMY, 4)
End
else
Begin
DPMX := 0;
DPMY := 0
End;
Stream.Free;
DPIX := DPMX / 100 * 2.54;
DPIY := DPMY / 100 * 2.54
End;
peki DPI öğrendim de boyum mu uzadı?
Cevap evet. Şöyle ki DPI

Kod: Tümünü seç
CONST
INCH_CM = 2.54;
INCH_MM = 25.4;
CM_INCH = 1/2.54;
MM_INCH = 1 /25.4;
Kod: Tümünü seç
Function toDPMM(DPI : Extended) : Extended;
Begin
Result := DPI / INCH_MM;
End;
Function toDPCM(DPI:Extended): Extended;
Begin
Result := DPI / INCH_CM;
End;
Function toMMRect(aRect: TRect;VerticalDPI,HorizontalDPI : Extended): TRect;
Begin
With Result do
Begin
Top := Round(toDPMM(VerticalDPI) *aRect.Top );
Bottom := Round(toDPMM(VerticalDPI) *aRect.Bottom );
Left := Round(toDPMM(HorizontalDPI) *aRect.Left );
Right := Round(toDPMM(HorizontalDPI) *aRect.Right );
End;
End;
Function toCMRect(aRect: TRect;VerticalDPI,HorizontalDPI : Extended): TRect;
Begin
With Result do
Begin
Top := Round(toDPCM(VerticalDPI) *aRect.Top );
Bottom := Round(toDPCM(VerticalDPI) *aRect.Bottom );
Left := Round(toDPCM(HorizontalDPI) *aRect.Left );
Right := Round(toDPCM(HorizontalDPI) *aRect.Right );
End;
End;
ile ekrana 1 cm x 1 cm lik bir rectangle çizdireceğim zaman
Kod: Tümünü seç
var
x,y: Extended;
GetDPI(xResim.Picture.Bitmap,x,y);
xResim.Picture.Bitmap.Canvas.Rectangle(toMMRect( Rect(10,10,20,20),x,y));
şimdilik bu kadar sevgi ve saygıılarımla.