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

Cмешение цветов с помощью Delphi

Источник: welikeit
Мороз Олег

Привет всем. Сегодня мы будем писать програмку, которая может размыть картинку.
Бросай на форму Timage и Tbutton имена оставь по умолчанию, создавай событие button1.click вот его код:

procedure TForm1.button1Click(Sender: TObject); 
    var x, y: integer; 
    i, j,h:integer;
    r,g,b,r1,g1,b1,r2,g2,b2,r3,r4,g3,g4,b3,b4,r5,r6,r7,r8,g5,g6,g7,g8,b5,b6,b7,b8:byte;
    c,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10:tcolor;
begin 
 application.ProcessMessages;
 for y := 1 to image1.picture.height-1 do begin 
  application.ProcessMessages;
  for x := 1 to image1.picture.width-1 do begin 
   c1 := (image1.Canvas.Pixels[x-1,y+1]);
   c2 := (image1.Canvas.Pixels[x-1,y-1]);
   c3 := (image1.Canvas.Pixels[x+1,y+1]);
   c4 := (image1.Canvas.Pixels[x+1,y-1]);
   c5 := (image1.Canvas.Pixels[x,y-1]);
   c6 := (image1.Canvas.Pixels[x,y+1]);
   c7 := (image1.Canvas.Pixels[x-1,y]);
   c8 := (image1.Canvas.Pixels[x+1,y]);
   c9:=(image1.Canvas.Pixels[x,y]);////по 9-ий пиксель
   ///////получение значений красного синего
   r:=getrvalue(c7); g:=getgvalue(c7); b:=getbvalue(c7);
   r1:=getrvalue(c8); g1:=getgvalue(c8); b1:=getbvalue(c8);
   r2:=getrvalue(c9); g2:=getgvalue(c9); b2:=getbvalue(c9);
   r3:=getrvalue(c6); g3:=getgvalue(c6); b3:=getbvalue(c6);
   r4:=getrvalue(c5); g4:=getgvalue(c5); b4:=getbvalue(c5);
   r5:=getrvalue(c4); g5:=getgvalue(c4); b5:=getbvalue(c4);
   r6:=getrvalue(c3); g6:=getgvalue(c3); b6:=getbvalue(c3);
   r7:=getrvalue(c2); g7:=getgvalue(c2); b7:=getbvalue(c2);
   r8:=getrvalue(c1); g8:=getgvalue(c1); b8:=getbvalue(c1);
   r:=round((r+r1+r2+r3+r4+r5+r6+r7+r8)/9);
   g:=round((g+g1+g2+g3+g4+g5+g6+g7+g8)/9);
   b:=round((b+b1+b2+b3+b4+b5+b6+b7+b8)/9);
   c10 :=rgb(r,g,b);
   ControlStyle := ControlStyle + [ csOpaque ];
   image1.Canvas.Pixels[x,y] := c10; 
  end; 
 end; 
end;

Вот и все упростите код, введите массивы и т.д.

Ссылки по теме


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

Магазин программного обеспечения   WWW.ITSHOP.RU
Купить Антивирус Dr.Web Server Security Suite для сервера
SAP Crystal Reports XI R2 Dev 2006 INTL WIN NUL License (Version 11)
Microsoft Office 365 Бизнес. Подписка на 1 рабочее место на 1 год
Allround Automation PL/SQL Developer - Annual Service Contract - 5 users
КОМПАС-3D v17 Home
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
СУБД Oracle "с нуля"
Программирование на Visual Basic/Visual Studio и ASP/ASP.NET
Работа в Windows и новости компании Microsoft
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100