Форум: "Основная";
Текущий архив: 2005.01.02;
Скачать: [xml.tar.bz2];
ВнизНадо вырезать квадрат с буквой !!! Найти похожие ветки
← →
pika © (2004-12-19 01:21) [0]Представляю вам часть кода
{========================================================}
procedure updwn;
var i,j:integer;
look:byte;
begin
//**********************************************************
//**********************************************************
//nahozhu verhnuu beluu chast
up:=0;look:=0;i:=0;
while (look=0)and(i<=form1.pbbw.Picture.Bitmap.Height) do
begin
j:=0;
while (look=0)and(j<=form1.pbbw.Picture.Bitmap.Width) do
begin
if form1.pbbw.Picture.Bitmap.Canvas.Pixels[j,i]=0 then look:=1 else
j:=j+1;
end;
if look=0 then i:=i+1;
end;
up:=i;
showmessage(inttostr(up));
//**********************************************************
//**********************************************************
//nahozhu nizhnuu beluu chast
look:=0;i:=up+1;
while (look=0)and(i<=form1.pbbw.Picture.Bitmap.Height) do
begin
for j:=0 to form1.pbbw.Picture.Bitmap.Width do
if form1.pbbw.Picture.Bitmap.Canvas.Pixels[j,i]=65536*256-1 then look:=1
else look:=0;
if look=0 then inc(i);
end;
dwn:=i;
//**********************************************************
{for i:=up to dwn do
begin
for j:=lft to rght do
if form1.pbbw.Picture.Bitmap.Canvas.Pixels[j,i]=0 then write(fgh,"1")else
if form1.pbbw.Picture.Bitmap.Canvas.Pixels[j,i]=65536*256-1 then write(fgh,"0");
writeln(fgh);
end;}
//**********************************************************
end;
{========================================================}
procedure lftrght;
var i,j:integer;
look:byte;
begin
//**********************************************************
//**********************************************************
//nahozhu levuu beluu chast
lft:=0;look:=0;i:=0;
for j:=up to dwn do
while (look=0)and(i<=form1.pbbw.Picture.Bitmap.Width) do
begin
if form1.pbbw.Picture.Bitmap.Canvas.Pixels[j,i]=0 then look:=1;
if look=0 then inc(i);
end;
lft:=i;
//**********************************************************
//nahozhu pravuu beluu chast
rght:=lft+1;look:=0;i:=lft+1;
for j:=up to up do
for i:=0 to form1.pbbw.Picture.Bitmap.Width do
begin
if form1.pbbw.Picture.Bitmap.Canvas.Pixels[i,j]=65536*256-1 then
begin
look:=1;
rght:=i;
end
else look:=0;
end;
//**********************************************************
//zapisivau v fail 1 esli pixel cherniy inache zapisivau 0
for i:=up to dwn do
begin
for j:=lft to rght do
if form1.pbbw.Picture.Bitmap.Canvas.Pixels[j,i]=0 then
write(fgh,"1") else
write(fgh,"0");
end;
//**********************************************************
//**********************************************************
end;
мне нужно получить квадрат с буквой, которую я вырезаю из битмапа, но для этого мне нужно 4 параметра up down(dwn)
left(lft) и right(rght)
но что-то не получается , мучаюсь вроде бы все правильно но что-то не получается , верхнюю и левую граници находит вроде бы нормально но нижнюю и правую неправильно ! Помогите люди добрые:)
← →
KilkennyCat © (2004-12-19 02:20) [1]Все гораздо проще, если делать таким алгоритмом...
var
Bukva : TRect;
x, y : integer;
begin;
Bukva.Left := 0;
Bukva.Right := 0;
Bukva.Top := 0;
Bukva.Bottom := 0;
y := 0;
repeat
x := 0;
repeat
if Pixels[x, y] = BukvaColor then begin
if Bukva.Left < x then if Bukva.Right = 0 then bukva.Left := x else if Bukva.Right < x then Bukva.right := x;
if Bukva.Top < y then if Bukva.bottom = 0 then bukva.Top := y else if Bukva.Bottom < y then Bukva.right := y;
end;
until x < Canvas.Width - 1;
until y < Canvas.Height - 1;
end;
Возможно, ошибься где-нить, набирал прямо тут, но алгоритм должен быть ясен :)
← →
Fedia © (2004-12-19 03:01) [2]KilkennyCat © (19.12.04 02:20) [1]
>Возможно, ошибься где-нить, набирал прямо тут, но алгоритм должен быть ясен :)
Два на первый взгляд бесконечных цикла (на самом деле заканчивающихся на первом шаге), а так мелочь :)
var
Bukva : TRect;
x, y : integer;
begin;
Bukva.Left := 2000;
Bukva.Right := -1;
Bukva.Top := 2000;
Bukva.Bottom := -1;
y := 0;
repeat
x := 0;
repeat
if Pixels[x, y] = BukvaColor then
begin
if Bukva.Left > x then
Bukva.Left:=x;
if Bukva.Right < x then
Bukva.Right:=x;
if Bukva.Top > y then
Bukva.Top:=y;
if Bukva.Bottom < y then
Bukva.Bottom:=y;
end;
inc(x);
until x = Canvas.Width - 1;
inc(y);
until y = Canvas.Height - 1;
end;
Скорее всего, я тоже ошибся где-нибудь. А возможно ошибок у меня больше, чем в предыдущем ответе. Но попытка не пытка :)
← →
KilkennyCat © (2004-12-19 04:17) [3]а я всегда парился с условиями завершения цикла :) никак не могу запомнить, то ли он выполняется пока условие истинно, то ли пока не станет истинным...
← →
Fedia © (2004-12-19 04:36) [4]Я с этим тоже мучился, а потом как-то, по дороге с работы домой просто выучил наизусть :) Почему-то, во время написания кода такие вещи трудно запоминаются (это я знаю и по себе, и по мнению коллег).
← →
GrayFace © (2004-12-19 10:18) [5]Странно. У меня никогда таких проблем не было.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.01.02;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.036 c