Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> разделение image на части, проблема 
:(
    Опции темы
HAS
Дата 29.7.2006, 12:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ing
*


Профиль
Группа: Участник
Сообщений: 170
Регистрация: 1.3.2005
Где: Internet

Репутация: нет
Всего: 2
Здравствуйте. имеем черно-белую картинку в image1 вот надо ее на части разорвать в image2, image3 и т.д.
с отрыванием первого куска проблем нет, а вот со вторым имеются проблемы. код такой:

Код

var
img1: array[0..14,1..17] of byte;
img2: array[15..31,1..17] of byte;
x, y: integer;
begin
Threshold(image1.Picture.Bitmap, 127, clWhite, clBlack); //- это мы ее черно - белой делаем
form1.Repaint;
//далее отрываем первую часть
for x:=0 to 14 do
  for y:=0 to 17 do
    if image1.Canvas.Pixels[x, y]=clWhite then img1[x,y]:=0
    else img1[x, y]:=1;
Image2.Width:=15;
Image2.Height:=17;
for x:=0 to 14 do
  for y:=0 to 17 do
    if img1[x, y]=0 then image2.Canvas.Pixels[x, y]:=clWhite
    else image2.Canvas.Pixels[x, y]:=clblack;
//все нормально

//отрываем вторую часть
for x:=15 to 31 do
  for y:=0 to 17 do
    if image1.Canvas.Pixels[x, y]=clWhite then img1[x,y]:=0
    else img1[x, y]:=1;
Image3.Width:=16;
Image3.Height:=17;
for x:=15 to 31 do
  for y:=0 to 17 do
    if img1[x, y]=0 then image3.Canvas.Pixels[x, y]:=clWhite
    else image3.Canvas.Pixels[x, y]:=clblack;
// и нифига нету  :( 
end;


разделение происходит вдоль картинки (как колбасу режут) smile
где истина?  
PM MAIL   Вверх
Alexeis
Дата 29.7.2006, 14:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
HAS, Зачем так сложно есть функция 
Код

procedure TCanvas.CopyRect(const Dest: TRect; Canvas: TCanvas;
  const Source: TRect);

она копирует фрагмент одного изображения в др. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
HAS
Дата 29.7.2006, 15:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ing
*


Профиль
Группа: Участник
Сообщений: 170
Регистрация: 1.3.2005
Где: Internet

Репутация: нет
Всего: 2
alexeis1, может поможешь разобраться с этим ? А то ниче непойму и в хелпе ниче нет smile 
PM MAIL   Вверх
Albinos_x
Дата 29.7.2006, 17:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 1
Всего: 108
alexeis1, прав... зачем так извращаться...


Цитата(HAS @  29.7.2006,  15:51 Найти цитируемый пост)
 может поможешь разобраться с этим ? А то ниче непойму и в хелпе ниче нет

проблема в самом алгоритме...
Цитата

for x:=15 to 31 do    
  for y:=0 to 17 do    
    if image1.Canvas.Pixels[x, y]=clWhite then img1[x,y]:=0    
    else img1[x, y]:=1;    
Image3.Width:=16;    
Image3.Height:=17;    
for x:=15 to 31 do    
  for y:=0 to 17 do    
    if img1[x, y]=0 then image3.Canvas.Pixels[x, y]:=clWhite    
    else image3.Canvas.Pixels[x, y]:=clblack;

ты же копируешь с 15 пиксела по Х в тоже самое расположение третьего имага, а сам имаг размера-то 16 в ширину, поэтому ничего и не видишь... да сам массив у тебя img1 размерностью тоже не попадпет...

попробуй  так:
Код
...
for x:=15 to 31 do    
  for y:=0 to 17 do    
    if image1.Canvas.Pixels[x, y]=clWhite then img2[x,y]:=0    
    else img2[x, y]:=1;    
Image3.Width:=16;    
Image3.Height:=17;    
for x:=15 to 31 do    
  for y:=0 to 17 do    
    if img2[x, y]=0 then image3.Canvas.Pixels[x-15, y]:=clWhite    
    else image3.Canvas.Pixels[x-15, y]:=clblack;
...


а массив img2 сделай не от 1 , а от 0...

Добавлено @ 17:54 
имею ввиду по Y... 


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
HAS
Дата 30.7.2006, 14:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ing
*


Профиль
Группа: Участник
Сообщений: 170
Регистрация: 1.3.2005
Где: Internet

Репутация: нет
Всего: 2
Вот код получился..
тут есть где-то ошибка, а где незнаю, помогите плиз.

Код

procedure TForm1.Button8Click(Sender: TObject);
var
img1: array[0..14,1..17] of byte;
img2: array[15..31,0..17] of byte;
img3: array[31..46,1..17] of byte;
f: file;
x, y: integer;
s:variant;
begin
Threshold(image1.Picture.Bitmap, 127, clWhite, clBlack);
form1.Repaint;
{s:=image1.Canvas.Pixels[4,4];
showmessage(s);
if  image1.Canvas.Pixels[4,3]=clwhite then  showmessage('white');
if  image1.Canvas.Pixels[4,3]=clblack then  showmessage('black');}
for x:=0 to 14 do
  for y:=0 to 17 do
    if image1.Canvas.Pixels[x, y]=clWhite then img1[x,y]:=0
    else img1[x, y]:=1;
Image2.Width:=15;
Image2.Height:=17;
for x:=0 to 14 do
  for y:=0 to 17 do
    if img1[x, y]=0 then image2.Canvas.Pixels[x, y]:=clWhite
    else image2.Canvas.Pixels[x, y]:=clblack;
///////////////////////////////////////////////////////////
 for x:=15 to 31 do
  for y:=0 to 17 do
    if image1.Canvas.Pixels[x, y]=clWhite then img2[x,y]:=0
    else img2[x, y]:=1;
Image3.Width:=16;
Image3.Height:=17;
for x:=15 to 31 do
  for y:=0 to 17 do
    if img2[x, y]=0 then image3.Canvas.Pixels[x, y]:=clWhite
    else image3.Canvas.Pixels[x-15, y]:=clblack;
////////////////////////////////////////////////////////////
for x:=31 to 46 do
  for y:=0 to 17 do
    if image1.Canvas.Pixels[x, y]=clWhite then img3[x,y]:=0
    else img3[x, y]:=1;
Image4.Width:=15;
Image4.Height:=17;
for x:=31 to 46 do
  for y:=0 to 17 do
    if img3[x, y]=0 then image3.Canvas.Pixels[x, y]:=clWhite
    else image4.Canvas.Pixels[x-31, y]:=clblack;

end;


Добавлено @ 14:40 
или может с CopyRect примерчиком поможете простеньким ?! 

Это сообщение отредактировал(а) HAS - 30.7.2006, 14:39
PM MAIL   Вверх
Albinos_x
Дата 30.7.2006, 15:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 1
Всего: 108
у тебя таже самая ошибка, что я указывал выше...

Цитата
if image1.Canvas.Pixels[x, y]=clWhite then img2[x,y]:=0    
    else img2[x, y]:=1;

ты рисуешь в имаже в невидимой области...

Цитата
for x:=15 to 31 do    
  for y:=0 to 17 do    
    if img2[x, y]=0 then image3.Canvas.Pixels[x, y]:=clWhite    
    else image3.Canvas.Pixels[x-15, y]:=clblack;    
////////////////////////////////////////////////////////////    
for x:=31 to 46 do    
  for y:=0 to 17 do    
    if image1.Canvas.Pixels[x, y]=clWhite then img3[x,y]:=0    
    else img3[x, y]:=1;    
Image4.Width:=15;    
Image4.Height:=17;    
for x:=31 to 46 do    
  for y:=0 to 17 do    
    if img3[x, y]=0 then image3.Canvas.Pixels[x, y]:=clWhite    
    else image4.Canvas.Pixels[x-31, y]:=clblack;


а здесь половину там где надо, а половину опять в невидимой области...

вот пример, в котором есть CopyRect:
http://www.zoforum.zeroes-and-ones.com.ru/...ost&id=2510

когда делал забыл одну фишку, добавь в код ещё:
Код
...
procedure TForm1.FormDestroy(Sender: TObject);
begin
BipK.Free;
end;
...


если не получится скачать по указанной ссылке, то пример выложен здесь 


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0548 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.