| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как обрезать белые края изображения [D6]

flincs ©   (2011-04-26 14:27:00) 

Добый день, подскажите как можно обрезать белые края изображения?

Картинка с белым фоном, на ней присутствует черное изображение, нужно обрезать все лишние белые края.

procedure CropImg(bmp:TBitmap);
var
 i,j,x,y,h: Integer;
 tBmp: TBitmap;
 b:Boolean;
begin
 tBmp:=TBitmap.Create;

 // Íàõîäèì x
 b := False;
 for i:=0 to bmp.Width-1 do
 begin
   for j:=0 to bmp.Height-1 do
     if Bmp.Canvas.Pixels[i,j]$FFFFFF then
     begin
       x := i;
       b:=True;
       Break;
     end;
   if b then Break;
 end;

 // Íàõîäèì y
 b:=False;
 for j:=0 to bmp.Height-1 do
 begin
   for i:=0 to bmp.Width-1 do
     if Bmp.Canvas.Pixels[i,j]$FFFFFF then
     begin
       y := j;
       b:=True;
       Break;
     end;
   if b then Break;
 end;

 tBmp.Width := bmp.Width-x;
 tBmp.Height := bmp.Height-y;
 BitBlt(tBmp.Canvas.Handle,0,0,tBmp.Width,tBmp.Height,bmp.Canvas.Handle,x,y,SRCCO PY);

 Form1.Image2.Picture.Bitmap:=tBmp;

 //ShowMessage(IntToStr(x)+' '+IntToStr(y));

 tBmp.Free;
end;

Поэксперементировал, нашел ху, вырезаю верхний белую полосу и левую, а нижнию и правую не могу понять, как будет лучше найти.

Подскажите как можно решить задачу? :)

---

KilkennyCat   (2011-04-27 01:52:00) [1]

> Пробовал пробовал, ничего так и не получилось с двумя циклами
> :(

не может не получится: просто проверка с двух краев сразу.

---

flincs   (2011-04-27 00:15:00) [2]

> зачем делать 4 цикла, если можно 2?a=1;b=10;for i:=a to
> b do begin  if m[i] then ...  if m[b-i] then ...end;

Пробовал пробовал, ничего так и не получилось с двумя циклами :(

...с массивами еще не разобрался, m[i] как я догадываюсь это он и есть.

---

oldman   (2011-04-26 17:11:00) [3]

зачем делать 4 цикла, если можно 2?

a=1;
b=10;
for i:=a to b do begin
 if m[i] then ...
 if m[b-i] then ...
end;

---

flincs   (2011-04-26 14:56:00) [4]

> oldman ©   (26.04.11 14:39) [5]
> for i:=bmp.Height-1 downto 0 do


Спасибо! Вотвроде бы сделал, работает.

procedure CropImg(bmp:TBitmap);
var
 i,j,x,y,h,w: Integer;
 tBmp: TBitmap;
 b:Boolean;
begin
 tBmp:=TBitmap.Create;

 // находим x
 b := False;
 for i:=0 to bmp.Width-1 do
 begin
   for j:=0 to bmp.Height-1 do
     if Bmp.Canvas.Pixels[i,j]<>$FFFFFF then
     begin
       x := i;
       b:=True;
       Break;
     end;
   if b then Break;
 end;

 // находим y
 b:=False;
 for j:=0 to bmp.Height-1 do
 begin
   for i:=0 to bmp.Width-1 do
     if Bmp.Canvas.Pixels[i,j]<>$FFFFFF then
     begin
       y := j;
       b:=True;
       Break;
     end;
   if b then Break;
 end;

 // находим w
 b := False;
 for i:=bmp.Width-1 downto 0 do
 begin
   for j:=bmp.Height-1 downto 0 do
     if Bmp.Canvas.Pixels[i,j]<>$FFFFFF then
     begin
       w := i;
       b:=True;
       Break;
     end;
   if b then Break;
 end;

 // находим h
 b := False;
 for j:=bmp.Height-1 downto 0 do
 begin
   for i:=bmp.Width-1 downto 0 do
     if Bmp.Canvas.Pixels[i,j]<>$FFFFFF then
     begin
       h := j;
       b:=True;
       Break;
     end;
   if b then Break;
 end;

 //ShowMessage(IntToStr(x)+' '+IntToStr(y)+' '+IntToStr(w)+' '+IntToStr(h));

 tBmp.Width := (bmp.Width-x)-(bmp.Width-w-1);
 tBmp.Height := (bmp.Height-y)-(bmp.Height-h-1);

 BitBlt(tBmp.Canvas.Handle,0,0,tBmp.Width,tBmp.Height,bmp.Canvas.Handle,x,y,SRCCO PY);

 Form1.Image2.Picture.Bitmap:=tBmp;

 tBmp.Free;
end;

Конечно не супер маленький код, но работает :)

---

Andy BitOff   (2011-04-26 14:55:00) [5]

Удалено модератором

---

oldman   (2011-04-26 14:47:00) [6]

Кроме Width и Height есть еще Top и Left

---

oldman   (2011-04-26 14:39:00) [7]

for i:=bmp.Height-1 downto 0 do

---

flincs   (2011-04-26 14:36:00) [8]

Удалено модератором

---

flincs   (2011-04-26 14:34:00) [9]

Ммм...

bmp.TransparentColor:=$FFFFFF;
 bmp.Transparent:=True;
 tBmp.Width := bmp.Width;
 tBmp.Height := bmp.Height;
 BitBlt(tBmp.Canvas.Handle,0,0,tBmp.Width,tBmp.Height,bmp.Canvas.Handle,0,0,SRCCO PY);
 Form1.Image2.Picture.Bitmap:=tBmp;

В итоге получается он не сужает оригинал изображения, даже не замечаю, что бы он его делал прозрачным. :(

---

oldman   (2011-04-26 14:33:00) [10]

> нашел ху


Ищи точно также, только цикл запусти в обратную сторону.

---

Ega23   (2011-04-26 14:28:00) [11]

Объяви белый в качестве TransparentColor

---

Наверх