(21-01-2021, Saat: 22:06)woywod Adlı Kullanıcıdan Alıntı: Merhabalar. Ben '2.bmp 'icindeki kırımızı olan bolgeye '1.bmp' çizdirmek istiyorum yapamadım ? nasıl yapabılırım acaba ?
aşagıdakı gibi yaparsam hepsıne ciziyor?
procedure TForm1.Button1Click(Sender: TObject);
var
tarama,resim: TBitmap;
begin
tarama:= TBitmap.Create;
resim:= TBitmap.Create;
Image1.Picture.LoadFromFile('2.bmp');
try
tarama.LoadFromFile('1.bmp');
Image1.Canvas.Brush.Bitmap := tarama;
Image1.Canvas.FillRect(Rect(0, 0, Image1.Picture.Width,
Image1.Picture.Height));
finally
Image1.Picture.SaveToFile('son.bmp');
Image1.Canvas.Brush.Bitmap := nil;
tarama.Free;
end;
end;
//----
Ortadaki kırmızı dikdörtgenin sol üst ve sağ alt köşe koordinatlarını bulup o diğer resmi o dikdörtgenin içine kopyalamanız gerekiyor. Bunun için de
Image2.Canvas.StretchDraw(Rect(p1, p2), Image1.Picture.Graphic);
Şeklinde kopyalamalısınız. Burada p1 sol üst köşe, p2 sağ alt köşe.
Onların nasıl bulunabileceğine dair bir örnek var aşağıda. Ancak bu sıralı tarama olduğu için yavaş çalışır. Örneğin beşer beşer atlayarak tarama 5 kat daha hızlı yapar işi. Ya da onar onar yapılabilir. Renk değiştiği anda birer birer geri gidilerek tam koordinat bulunabilir.
procedure TForm1.Button1Click(Sender: TObject);
var firstColor, secColor : TColor;
aX: Integer;
aY: Integer;
found : integer;
p1, p2 : TPoint;
begin
found := -1;
p1 := Point(-1, -1);
p2 := Point(-1, -1);
firstColor := Image2.Canvas.Pixels[0, 0];
for aY := 1 to Image2.Picture.Height-1 do
begin
for aX := 1 to Image2.Picture.Width-1 do
if (found=-1) and (Image2.Canvas.Pixels[aX, aY]<>firstColor) then
begin
found := 0;
p1 := Point(aX, aY); // Kırmızı dikdörtgenin sol üst köşesini bulduk
secColor := Image2.Canvas.Pixels[aX, aY];
end
else
if (found=0) and (aX<Image2.Picture.Width-1) and (Image2.Canvas.Pixels[aX+1, aY]=firstColor) then
begin
p2.X := aX+1; // Kırmızı dikdörtgenin sağ üst köşesini bulduk.
found := 1;
break;
end;
if (found=1) then
break;
end;
//Sol alt köşenin Y koordinatını bulmak için... yani p2.Y'yi
for aY := p1.Y to Image2.Picture.Height-1 do
if (aY<Image2.Picture.Height-1) and (Image2.Canvas.Pixels[p1.X, aY+1]<>secColor) then
begin
p2.Y := aY+1;
break;
end;
if p2.X=-1 then
p2.X := Image2.Picture.Width-1;
if p2.Y=-1 then
p2.Y := Image2.Picture.Height-1;
Image2.Canvas.StretchDraw(Rect(p1, p2), Image1.Picture.Graphic);
end;
Bir sorun daha var, sizin Image2'niz 8 bitlik bir resim, bunun üzerine 24 bitlik bir resmi eklerseniz onu 8 bite dönüştürüyor ve resim bozuluyor. Haliyle onun 24 bitlik bir BMP sini oluşturup işlemleri onun üzerinde yapmanız daha doğru olacaktır.
Source