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

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

помогите найти косяк

Страницы:   < 1 2 >

Вова ©   (2013-10-24 00:34:00) 

TSimpleSearchArray = array of word;

Вообщем первая процедура  берет бмп в котором только белые и черные точки, и копируем его в одномерный массив, в котором сохраняем только смещения относительно x=0 для черных точек. А окончание строки помечено числом High(xmin). Также в первом элементе массива сохраняем ширину строки, во втором высоту колонки, попутно обрезая незначащие строки и колонки по краям картинки (т.е. в восстановленной картинке пустых строк и колонок по краям быть не должно)


function ScanLineArray(SearchingBmp: Tbitmap;
 var searchArray: TSimpleSearchArray): boolean;
var
 x, xmin, xmax: word;
 ymin,ymax, y: word;
 i: integer;
 Start, Stop: pInteger;
begin
 result := false;
 if SearchingBmp = nil then
   exit;

 if (SearchingBmp.Height > 0) then
 begin

   Start := SearchingBmp.ScanLine[SearchingBmp.Height - 1];
   Stop := SearchingBmp.ScanLine[0];
   inc(Stop, SearchingBmp.Width);

   // сначала найдем 0.0, т.к. в шаблоне могут быть пустые строки и колонки,
   // то вычисляем минимальные x и y для непустой строки и колонки

   x := 0;
   xmax := 0;
   ymax := 0;
   xmin := High(xmin);
   y := 0;
   ymin := High(ymin);
   repeat
     if Byte(Start^) = 0 then
     begin
       if xmin > x then
         xmin := x;
       if ymin > y then
         ymin := y;
       if xmax < x then
         xmax := x;
       if ymax < y then
         ymax := y;
     end;
     inc(x);
     inc(Start);
     if x > (SearchingBmp.Width - 1) then
     begin
       x := 0;
       inc(y);
     end;
   until Start = Stop;
   if xmax = 0 then
   begin
     SearchingBmp.free;
     exit;
   end;

   Start := SearchingBmp.ScanLine[SearchingBmp.Height - 1];
   // восстанавливаем старт
   // и переводим его в 0.0
   inc(Start, (xmin + ymin * SearchingBmp.Width));
   SetLength(searchArray, 2);
   searchArray[0] := xmax - xmin + 1;  // в первую ячейку мы запишем реальную ширину шаблона
   searchArray[1] := ymax - ymin + 1;  // а во вторую мы запишем реальную высоту шаблона

   // строим шаблон
   x := 0;
   i := 1;
   repeat
     if Byte(Start^) = 0 then
     begin
       inc(i);
       SetLength(searchArray, i + 1);
       searchArray[i] := x;
     end;
     inc(Start);
     inc(x);
     if x > (searchArray[0] - 1) then
     begin
       x := 0;
       inc(i);
       SetLength(searchArray, i+1);
       searchArray[i] := High(searchArray[i]);//пометка о конце строки
     end;
   until Start = Stop;

   result := true;
 end;
 SearchingBmp.free;
end;



А во второй процедуре я пытаюсь получить исходный рисунок из массива полученного в предыдущей процедуре, а получаю какую то фигню.

Procedure Restore(bufX : TSimpleSearchArray);
var
tbmp :TBitmap;
 i: integer;
 Start,p: pInteger;
 x: word;
 y: word;
begin

 tbmp := Tbitmap.Create;
 tbmp.PixelFormat := pf32bit;
 tbmp.Width := bufX[0];
 tbmp.Height:= bufX[1];

 Start := tbmp.ScanLine[tbmp.Height-1];
 p:= Start;
 
 i:=2;
 y:=0;
 x:=0;
 repeat
   if bufX[i] = High(bufX[i]) then //если мы наткнулись на перевод строки, то и переводим ее
   begin
     inc(y);//т.е. добавляем Y
     inc(i);
     continue;
   end;

   inc(p,y*bufX[0] + bufX[i]);
   p^ := 0;
   p  := Start;

   inc(i);
 until y = (bufX[1]-1);

 tbmp.SaveToFile('C:\3.bmp');

end;

Где косяк?

---

Вова   (2013-10-25 14:03:00) [21]

хм, видимо я уже профи, если пишу код похожий на скопипастенный )

---

Inovet   (2013-10-25 13:28:00) [22]

> [3] Вова   (24.10.13 12:18)
> Я уже 2 дня втыкаю в этот код, ничего не втыкается

Так код, значит, скопипастченыей.

---

Вова   (2013-10-25 02:38:00) [23]

все....помог себе сам.

---

Вова   (2013-10-24 22:44:00) [24]

оказалось, что в этом коде ошибок нет существенных :-D т.к. если грузить из картинки на диске, то все нормально восстанавливается. а вот если из блоба, то шляпа. Вот так я засовываю и высовываю из  блоба. Что не так то? (

  vBlob := ClientDataSet3.CreateBlobStream
         (Form3.ClientDataSet3.FieldByName('massSample'), bmWrite);
       vBlob.Seek(0, soFromBeginning);
       vBlob.WriteBuffer(searchArray[0], Length(searchArray) * SizeOf(searchArray[0]));
       vBlob.free;

 vBlob := ClientDataSet3.CreateBlobStream
   (ClientDataSet3.FieldByName('massSample'), bmRead);
   TempL := trunc(vBlob.Size/sizeof(word));
   SetLength(bufX,TempL);
 try
   vBlob.Seek(0, soFromBeginning); // sереход в начало потока BLOB
   SizeL := vBlob.Size;
   vBlob.ReadBuffer(bufX[0],SizeL);
 finally
   vBlob.free;
 end;
 if SizeL= 0 then
   exit;

---

Вова   (2013-10-24 12:28:00) [25]

ой....АААА он указывает на верхний правый ноль ) во....

---

Вова   (2013-10-24 12:27:00) [26]

10
01

Где 1 - черный, т.е. со значением цвета 0.

причем вот в такой картинке
Start := tbmp.ScanLine[tbmp.Height-1];  вроде как должен указывать на нижнюю единицу, но вместо этого там не 0 совсем, а ноль только после inc(Start), т.е. в левом нижнем углу. Похоже я опять что то не могу понять в этих битмапах.

---

Вова   (2013-10-24 12:18:00) [27]

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

---

Cobalt   (2013-10-24 11:51:00) [28]

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

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

---

Туповатый   (2013-10-24 03:40:00) [29]

> помогите найти косяк

чтобы биться головой? скурить? сделать консервы?

---

Страницы:   < 1 2 >

Наверх