Здравствуйте
У меня ест следний проблем. Мне надо загрузти .bmp каторое надо изпользуват как heightmap. Ето чорно-белое изображение, и самая светлий пиксел - ето самая високая точка поверхности, а самая темная - самая ниская Мне надо сделат из етого изображения текстовий файл в котором написани для каждой точки ее висота. Я пробувал изпользую TImage и свойства Pixels[] TCanvas-a сделат ето, имеея ввиду че белий пиксел ето 255,255,255 (или TColor=16777216), а чорний - 0. Но я не могу сделать его работат как надо.
Мнен нужда опредлит в програме самой большой и самой маленкой висотой, но програма никагда не работает как надо и я не могу понять почему. Лудче всего работала какда я проста записивал стойност цвета пиксела div 29 000.... но надо же параметрам определит интервал висоти поверхностти
Сейчаш я польуя следущий код:

Код

procedure TForm1.GenerateTerrain1Click(Sender: TObject); var i,j: integer; temp:longint; tempp:longint; temp2:string; begin ProgressBar1.Position:=0; ProgressBar1.Max:=strtoint(Edit3.Text); if SaveDialog1.Execute then begin  temp2:=Edit1.Text+','+Edit2.Text;  Memo1.Lines.Add(temp2);  temp2:=Edit3.Text+','+Edit4.Text;  Memo1.Lines.Add(temp2);  for i:=1 to strtoint(Edit3.Text) do    begin    ProgressBar1.position:=i;    for j:=1 to strtoint(Edit4.Text)  do      begin        temp:=Image1.Picture.Bitmap.Canvas.Pixels[i,j];        if temp>0 then begin        Memo1.Lines.Add(inttostr(i-1));        Memo1.Lines.Add(inttostr(j-1));        tempp:=round(16777216/max(SpinEdit1.value, SpinEdit2.value));        temp:=round(temp/tempp);        if temp<min(spinEdit3.value, SpinEdit2.Value) then temp :=min(spinEdit3.value, SpinEdit2.Value);                if CheckBox2.Checked then temp:=temp div spinedit1.Value;        if CheckBox1.Checked then temp:=SpinEdit2.Value-temp;        Memo1.Lines.Add(inttostr(temp));     end;     end;   end;  Memo1.Lines.SaveToFile(SaveDialog1.FileName);  end; end;

А первий код, которий работал лудче всех (но от неотговаревает стандарту файла, его надо немного изменит):

Код

procedure TForm1.GenerateTerrain1Click(Sender: TObject); var i,j: integer; begin if SaveDialog1.Execute then begin for i:=1 to Image1.Picture.height do for j:=1 to Image1.Picture.width do  begin  Memo1.Lines.Add(inttostr(i*10-1));  Memo1.Lines.Add(inttostr(j*10-1));  Memo1.Lines.Add(inttostr((Image1.Picture.Bitmap.Canvas.Pixels[i,j] div 29000) - 100)) end; Memo1.Lines.SaveToFile(SaveDialog1.FileName); end; end;

Первий код намного сложнее потому что там ест 4 параметра - максималная висота, минимальная, flip (високии становятся нискии и наоборот) и Skip - т.е. не проверят каждий пиксел а пропускат определенноя количество

DarkLight Честно говоря, читать твою орфографию очень сложно. Если ты прикалываешься, то это ИМХО перебор; если нет, то сделай одолжение, проверь текст с помощьб MSWord. Я когда дочитал пост до конца, забыл, что было в начале.

December, МС-вордом - болгарский текст?

// угорает

Представь себе, что у тебя есть TImage по имени HeightMap, т.е.

Код

HeightMap: TImage

Есть максимальная и минимальная высота МaxHeight и MinHeight соответсвенно, т.е.

Код

MaxHeight, MinHeight: Real

Есть признак инвертирования высот

Код

flip: booolean

Есть некоторое условие Skip, которое принимает значение true, если надо проверять пиксел, и false иначе.
Тогда процедура создания текстового файла будет выглядеть примено так...

Код

procedure Convert; const  FileName = 'height.txt'; var  i,j: cardinal;  Diff: real; // Относительная разница макс и мин высот  f: TextFile; // Файл для записи  H: real; begin  AssignFile(F,FileName);  Rewrite(F);  try    Diff := (MaxHeight-MinHeight)/$FF;    for i := 0 to HeightMap.Picture.Height-1 do      begin        for j := 0 to HeightMap.Picture.Width-1 do          if <Skip> then with HeightMap.Picture.Bitmap do            begin              if  flip                then H := ($FF-(Canvas.Pixels[j,i] mod $100))*Diff                else H := (Canvas.Pixels[j,i] mod $100)*Diff;              Write(F,H)            end;        WriteLn(F)      end  finally    CloseFile(f)  end end;

Теперь пояснения...
AssignFile и RewriteFile сам должен знать что такое...
Diff := (MaxHeight-MinHeight)/$FF; относительная высота, т.е. высота приходящаяся на каждую единицу интенсивности цвета ($FF = 255).
Дальше в цикле пробегаешь по Пикселам и присваиваешь переменной H - Интенсивность серого цвета, помноженную на относительную высоту....
H := (Canvas.Pixels[j,i] mod $100)*Diff или, если надо инвертировать поле высот ($FF-(Canvas.Pixels[j,i] mod $100))*Diff
Вот и все...

Если возникнут вопросы по коду - пиши...

P.S. И выучи русский язык...

Ну если скажеш откуда найти програму орфографической проверки для Word я буду писать в Word, редактируват и потом copy&paste

x77 у меня проблем с болгоским текстам нет, но мой руский - я ето очен хорошо знаю, ужасний

December Парень из оказывается из СОФИИ...
DarkLight Сорри за P.S.

У тебя ошибки в тексте были...
Индексация массива пикселей начинается с нуля...
Индексы идет так Pixels[Номер столбца, Номер строки]...

DarkLight,

во-первых, "светлость" точки не определяется значением TColor. строго говоря, цвета FF0000 и 0000FF имеют одинаковую "светлость", а вот по твоей логике - первый гораздо светлее другого. если картинка чёрно-белая, (видимо, имеется в виду, что она greyscale), то значения всех трёх составляющих RGB будут одинаковы. например, 010101, 0F0F0F, FFFFFF и т.д. следовательно, разброс тона будет от 0 до 255 (т.к. для получения картинки в серых тонах, значения всех трёх составляющих RGB меняются синхронно). т.е., тебе нужно взять любую из них и проверить от 0 до FF.

во-вторых, для подобной обработки лучше использовать scanline

в-третьих, TCanvas - это массив от (0 до Width-1) x (0 до Height - 1), а у тебя нумерация с 1.

в-четвёртых, для TCanvas сначала указывается абсцисса, а потом ордината, т.е. это массив вида [X, Y], а у тебя - наоборот.

в-пятый, "белый пиксел" - это совсем не 255,255,255, т.е. не $FFFFFF. цвет хранится, как двойное слово, вида $02FFFFFF, где первый байт определяет, из какой палитры будет браться значение цвета.

в-общем, вот код:

Код

procedure TForm1.Button1Click(Sender: TObject); var  x, y, skip: integer;  l: PByteArray; begin  // шаг по X  skip := StrToInt (Edit1.Text);  for y := 0 to Image1.Picture.height - 1 do begin    // получаем указатель на строку пикселов    l := Image1.Picture.Bitmap.ScanLine [y];    for x := 0 to Image1.Picture.width div skip do begin      // получаем самый младший байт цвета, форматируем, суём в мемо      Memo1.Lines.Add(Format ('(%4d:%4d) - %3d', [x * skip, y, l^[x] and $000000FF]));    end;  end; end;

сохранение в файл делать не буду, это просто, и что такое минимальная - максимальная высота я не понял. картинки? точки? (т.е. её светлость?)

во блин, пока писал - тут уже целый сейшн

x77 Ага, скоро Привет Катрин будет

P.S. Сорри за offtopic

kesh в первих - я знаю что лудче пользувать scanline, но я не знал точна как. Спосибо для код.
Для минимальная и максимальнай висотой - я имел ввиду что потребительъ может сказат:
Самая ниская точка: 100 (т.е. черний цвет)
Самая високая: 1500 (т.е. белий цвет)
И все числа должи бит между 100 и 1500
Сохранения в файл легко, я даже не знаю почиму пользую Memo, но ето пока напишу правилний алгоритм, потом уже напишу с Assign(), Writeln() и Close()
Очен спосибо, я завтро побробую код

DarkLight Извини, я поленился залезть в профайл. Установи себе русскую версию MSWord, в ней по дефаулту есть проверка синтаксиса (F7).

Програма работает
Еще раз спосибо, kesh
December а откуде мне взят рускую версию Word-а?
И можеш мне сказат какой небут англо-руский словар...

DarkLight Всегда рад помочь...

DarkLightЯ пользуюсь Lingvo - ИМХО самый удобный.
Русскую версию Вёрда - у русских друзей. Если хорошо говоришь по-английски, то не стесняйся, спрашивай по-английски.