(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Cтерео изображения в Delphi

Источник: welikeit

Помните, раньше была такая штука, стереоскоп назывался. Ну так вот, данная штука могла делать из просто картинки стерео картинку (аля ОБЪЕМНУЮ КАРТИНКУ):) И я вдруг заинтересовался: "Каким же способом сделать такую штуку на наших боевых конях?". Прошел месяц. На руках программа и данный расказ:) Ну слушайте и внимайте слову божию:)

"Зрительные пигменты глаза состоят из колбочек трёх типов, чувствительных к синему, зелёному и красному цвету."(с)Учебник биологии. Ну вот, на основе данного утверждения господа ученые разработали систему цветности для наших ПК. И получила название данная система RGB. В этой системе все цвета получаються путем смешивания синего, зеленого и красного цвета. Смесь синего и зеленого, например, даёт голубой цвет.Таким образом, все цвета можно засунуть в прямоугольную систему координат x,y,z. Где у всех координат максимальная цифра - 255.

Оси, такие как WIN или Linux, позваляют устанавливать разные цветовые режимы:

1.16-цветный режим.

2.256 цветный.

3.режим High Color, при котором для хранения цвета каждой точки выделяеться 2 байта, что соответсвенно даёт 65000 цветов.

4.Режим True Color, предпологает выделение четыре байта под каждый цвет, что позволяет изменять доли составляющих красного, синего и зеленого в диапазоне от 0 до 255 (RGB).

У данной системы есть всего два недостатка (ну у кого их нет:)). Намбер ван - зависимость от аппаратуры, намбер ту - невозможность получить ВСЕ цвета путем смешения синего, зеленого и красного. Теперь по поводу стерео. Стерео картинку можно имитировать (к сожелению именно имитировать) тремя способами:

1.Использовать стерео очки и специальную видео карту:) (NVIDIA вам поможет).

2.Купить специальный монитор (супер-пупер разработка буржуев,только у нас вы можете приобрести ЭТО всего за $6999).

3.Ну и собственно самый русский способ: смещение по красному цвету:) Потребуються красно-синие очки(ищи в инете, ну или 15 вечнодеревянных) и драйвер, сами знаете какой:)

Как это все сделать в Дельфи?-спросите вы. Проще,чем Дуську тискать!- отвечу я.

В дельфи компонент TImage (картинки где хранишь) имеет свойство Canvas (или полотно). Полотно-это прямоугольная сетка, состоящая из маленьких квадратов, у которых кличка пиксели (Свойство Pixels[x,y]:TColor). Каждый пиксель содержит в себе координату на твоём экране и свой цвет. Левый верхний пиксель полотна считаеться нулевым. Общее количество пикселей по горизонтали определяется свойством - Width, а по вертикали - свойством Height. (всё выше и ниже сказанное можно отнести и к типу TBitmap). Таким образом, если:

var
color:Tcolor;
Image1:TImage;
begin
//то на картинке пиксель с координатоми (100;100) окраситься в синий цвет.
Image1.Canvas.Pixels[100,100]:=rgb(0,0,255);

//теперь переменная color содержит цвет пикселя.
color:=Image1.Canvas.Pixels[100,100];

//теперь соседний пиксель тоже стал голубеньким:)
Image1.Canvas.Pixels[100,101]:=color;
end;  

Теперь рассмотрим данную конструкцию:

var
x,y:integer;//обьявлем переменные типа integer(просто число).
h,w:integer;
begin
h:=500;//присваиваем значения.
w:=500;
for x := 1 to 500 do
begin
for y := 1 to 500 do
begin
//делаем что-нибудь.
end;
end;
end;

Таким образом мы пройдём квадрат 500x500. Это контрукция-основная по работе с цветом. В WinAPI есть такие функции как GetRvalue(),getBvalue(),getGvalue() - они возвращают номер оттенка (0-255) в виде integer в переменную. Например:

var
i:integer;
begin
//даст в переменную i оттенок синего в цвете clBlue.
i:=getBvalue(clBlue);
end;

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

Исходник можно взять тут: http://deadrabbit.by.ru/stereo_his.rar.Там всё подробно откоментировано, разберёшься:) Там же готовая прога : stereo3D_dez.rar. С базой все, перейдем к кодингу. (*Следующий раздел можно реализовать если вы решитесь публиковать исходные коды.)
Шкодинг - кодинг все дела:

Создай новый проэкт, сразу же сохрани его.

Итого:

1.Две панели(Panel) - закладка Standard. Свойство Caption меняй.

2.Два Image (лепяться поверх панели) - закладка Additional. Ничего менять не надо:)

3.Пять Button - закладка Standard, меняй Caption, как показано на рисунке. Кнопки распологать по возрастанию вниз.

4.два Label - закладка Standard, меняй Caption.

5.Два Edit - закладка та же, менять Text.

6.Два OpenPictureDialog и SavePictureDialog - закладка Dialogs.

У TForm1 поменяй свойство Caption и свойство WindowState в ws_Maximized (тогда прога будет грузиться в развёрнутом виде).

Теперь в Events создай у первой кнопки обработчик события на клик (кстати кнопка, для соответствия, называеться "Открыть Левую") и напиши туда следующий текст:

procedure TForm1.Button1Click(Sender: TObject);
begin
if Openpicturedialog1.Execute then //Если Диалог активирован,то...
begin
//загружаем в Bitmap выбранную картинку.
Bitmap.LoadFromFile(Openpicturedialog1.FileName);
end;
Image1.Canvas.StretchDraw(rect(0,0,Image1.Width,Image1.Height),Bitmap);
//отображаем Bitmap в Image1
end;

Теперь сделай то же самое с Буттоном2, где написано "Открыть правую", и напиши туда следующее:

procedure TForm1.Button2Click(Sender: TObject);
begin
if Openpicturedialog2.Execute then //процедура индентична верхней.
begin
Bitmap2.LoadFromFile(Openpicturedialog2.FileName);
end;
Image2.Canvas.StretchDraw(rect(0,0,Image2.Width,Image2.Height),Bitmap2);
end;

Теперь тот же обработчик, но на кнопку намбер 3, где написано "Убрать красный":

procedure TForm1.Button3Click(Sender: TObject);
var //объявляем переменные.
herR,herB,herG:integer;
color:TColor; //сюда будем сувать цвет.
x,y:integer; //координаты картинки.
h,w:integer; //высота,ширина картинки.
count:integer; //переменная для ProgressBar
begin
x:=0; //инициализация координат.
y:=0;
h:=Bitmap2.Height + 500; //высота кар. плюс + запас,известный глюк дельфи,нужно
чтоб полностью прошла картинку.
w:=Bitmap2.Width + 500;
ProgressBar2.Max:=Bitmap.Height + 500; //максимальное значение ProgressBar.
ProgressBar2.Min:=0; //минимальное.
count:=0;
for x := 1 to h do //цикл,подробнее в статье(выше).
begin
count:=count+1; //увеличиваем счётчик прогрессбара
ProgressBar2.Position:=count;
for y := 1 to w do
begin
//присваиваем цвет пикселя с координатами x,y.
color:=Bitmap2.Canvas.Pixels[x,y];

//разбиваем по частям,на синий,красный и зеленый.
herR:=GetRvalue(color);
herB:=GetBvalue(color);
herG:=GetGvalue(color);

//убиваем красный,предыдущей картинки.
Bitmap2.Canvas.Pixels[x,y]:=rgb(255,herG,herB);
end;
end;
Image2.Canvas.StretchDraw(rect(0,0,Image2.Width,Image2.Height),Bitmap2);
//отображаем результаты.
end;

Ну держись ещё чуть-чуть и у тебя собственная уникальная прога! Теперь вешай обработчик на самую главную кнопку нашего проэкта или Button4 (звать её "Сделать стерео"), и пиши:

procedure TForm1.Button4Click(Sender: TObject);
var //обявляем переменные.
herR1,herB1,herG1:integer;//два разных типа под разные картинки.
herR2,herB2,herG2:integer;
color,color2:tcolor;//цвета тоже под разные.
x,y:integer; //координаты первой картинки.
x1,y1:integer; //координаты второй.
h,w:integer; //ширина,высота.
count:integer; //для ProgressBar
g:integer; //сдвигив координатах.
d:integer;
begin
x:=0; //инициализация перемен
y:=0;
x1:=1;
y1:=1;
h:=Bitmap.Height + 500; //вышина,присваимое значение.
w:=Bitmap.Width + 500;
ProgressBar1.Max:=Bitmap.Height + 500;
ProgressBar1.Min:=0;
count:=0;

// сдвиг,определение в зависимости от введенного пользователя.
g:=StrToInt(Edit1.Text);
d:=StrToInt(Edit2.Text);
for x := 1 to h do //цикл
begin
x1:=x; //вторая координата, но уже со сдвигом.
x1:=x1+g;
count:=count+1;
ProgressBar1.Position:=count;

for y := 1 to w do
begin
y1:=y; // то же что и с x.
y1:=y1+d;

//присваиваем и разбиваем цвет по переменным.
color:=Bitmap.Canvas.Pixels[x,y];
herR1:=GetRvalue(color);
herB1:=GetBvalue(color);
herG1:=GetGvalue(color);

//обрабатываем, оставляем один красный на "левой"
Bitmap.Canvas.Pixels[x,y]:=rgb(herR1,0,0);

color2:=Bitmap2.Canvas.Pixels[x1,y1]; //разбиваем цвет.
herR2:=GetRvalue(color2);
herB2:=GetBvalue(color2);
herG2:=GetGvalue(color2);

//присваиваем красный "Левой" картинке "Правой",соблюдая пропорции:)
Bitmap2.Canvas.Pixels[x1,y1]:=rgb(herR1,herG2,herB2);
end;
end;
Image1.Canvas.StretchDraw(rect(0,0,Image1.Width,Image1.Height),Bitmap);
//отображаем всё получившееся.
Image2.Canvas.StretchDraw(rect(0,0,Image2.Width,Image2.Height),Bitmap2);
end;

Ну всё уже практически финишь:) Последняя кнопка номер 5, тот же обработчик на клик и текст:

procedure TForm1.Button5Click(Sender: TObject);
begin
if Savepicturedialog2.Execute then //cохраняем в ИСХОДНЫХ размерах.
begin
Bitmap2.SaveToFile(Savepicturedialog2.FileName);
end;
end;

Чуть не забыл, у Form1 в Events сделай обработчик события на OnCreate и пиши ниже следующие:

procedure tform1.FormCreate(Sender: TObject);
begin
Bitmap:=TBitmap.Create; //Подготавливаем Битмапы для работы;
Bitmap2:=TBitmap.Create;
end;

Фух, ну как довлен? Надеюсь да, для тебя старался:)



 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 25.12.2006 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
SAP Crystal Reports XI R2 Dev 2006 INTL WIN NUL License (Version 11)
Microsoft Windows Professional 10, Электронный ключ
Quest Software. TOAD for Oracle Edition
ABViewer Enterprise пользовательская
SmartBear AQtime Pro - Node-Locked License (Includes 1 Year Maintenance)
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
СУБД Oracle "с нуля"
Все о PHP и даже больше
3D и виртуальная реальность. Все о Macromedia Flash MX.
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100