|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
||||
|
||||
Процедуры по обработке изображений.
Если кто может, пожалуйста, выложите какие-нибудь процедуры для обработки изображений, типа Motion Blur, Smart Blur, уменьшение шума и др.
Что делать, когда сломался комп: 1. Если вы юзер - делать ноги. 2. Если ремонтник - делать деньги. 3. Если вы программист - делать вид, что так было задумано. |
#2
|
||||
|
||||
http://delphisources.ru/pages/faq/graph_games.html
Смотри разделы Графика и Изображения. Не профи, но и не чайник . D6 - лучше не придумали. Пока. |
#3
|
||||
|
||||
Это юнит для Блура:
Код:
unit DGraphBlur; interface uses Windows, Graphics; type PRGBTriple = ^TRGBTriple; TRGBTriple = packed record b: byte; //легче для использования чем типа rgbtBlue... g: byte; r: byte; end; PRow = ^TRow; TRow = array[0..1000000] of TRGBTriple; PPRows = ^TPRows; TPRows = array[0..1000000] of PRow; const MaxKernelSize = 100; type TKernelSize = 1..MaxKernelSize; TKernel = record Size: TKernelSize; Weights: array[-MaxKernelSize..MaxKernelSize] of single; end; //идея заключается в том, что при использовании TKernel мы игнорируем //Weights (вес), за исключением Weights в диапазоне -Size..Size. procedure GBlur(theBitmap: TBitmap; radius: double); implementation uses SysUtils; procedure MakeGaussianKernel(var K: TKernel; radius: double; MaxData, DataGranularity: double); //Делаем K (гауссово зерно) со среднеквадратичным отклонением = radius. //Для текущего приложения мы устанавливаем переменные MaxData = 255, //DataGranularity = 1. Теперь в процедуре установим значение //K.Size так, что при использовании K мы будем игнорировать Weights (вес) //с наименее возможными значениями. (Малый размер нам на пользу, //поскольку время выполнения напрямую зависит от //значения K.Size.) var j: integer; temp, delta: double; KernelSize: TKernelSize; begin for j := Low(K.Weights) to High(K.Weights) do begin temp := j / radius; K.Weights[j] := exp(-temp * temp / 2); end; //делаем так, чтобы sum(Weights) = 1: temp := 0; for j := Low(K.Weights) to High(K.Weights) do temp := temp + K.Weights[j]; for j := Low(K.Weights) to High(K.Weights) do K.Weights[j] := K.Weights[j] / temp; //теперь отбрасываем (или делаем отметку "игнорировать" //для переменной Size) данные, имеющие относительно небольшое значение - //это важно, в противном случае смазавание происходим с малым радиусом и //той области, которая "захватывается" большим радиусом... KernelSize := MaxKernelSize; delta := DataGranularity / (2 * MaxData); temp := 0; while (temp < delta) and (KernelSize > 1) do begin temp := temp + 2 * K.Weights[KernelSize]; dec(KernelSize); end; K.Size := KernelSize; //теперь для корректности возвращаемого результата проводим ту же //операцию с K.Size, так, чтобы сумма всех данных была равна единице: temp := 0; for j := -K.Size to K.Size do temp := temp + K.Weights[j]; for j := -K.Size to K.Size do K.Weights[j] := K.Weights[j] / temp; end; function TrimInt(Lower, Upper, theInteger: integer): integer; begin if (theInteger <= Upper) and (theInteger >= Lower) then result := theInteger else if theInteger > Upper then result := Upper else result := Lower; end; function TrimReal(Lower, Upper: integer; x: double): integer; begin if (x < upper) and (x >= lower) then result := trunc(x) else if x > Upper then result := Upper else result := Lower; end; procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow); var j, n: integer; tr, tg, tb: double; //tempRed и др. w: double; begin for j := 0 to High(theRow) do begin tb := 0; tg := 0; tr := 0; for n := -K.Size to K.Size do begin w := K.Weights[n]; //TrimInt задает отступ от края строки... with theRow[TrimInt(0, High(theRow), j - n)] do begin tb := tb + w * b; tg := tg + w * g; tr := tr + w * r; end; end; with P[j] do begin b := TrimReal(0, 255, tb); g := TrimReal(0, 255, tg); r := TrimReal(0, 255, tr); end; end; Move(P[0], theRow[0], (High(theRow) + 1) * Sizeof(TRGBTriple)); end; procedure GBlur(theBitmap: TBitmap; radius: double); var Row, Col: integer; theRows: PPRows; K: TKernel; ACol: PRow; P: PRow; begin if (theBitmap.HandleType <> bmDIB) or (theBitmap.PixelFormat <> pf24Bit) then raise exception.Create('GBlur может работать только с 24-битными изображениями'); MakeGaussianKernel(K, radius, 255, 1); GetMem(theRows, theBitmap.Height * SizeOf(PRow)); GetMem(ACol, theBitmap.Height * SizeOf(TRGBTriple)); //запись позиции данных изображения: for Row := 0 to theBitmap.Height - 1 do begin theRows[Row] := theBitmap.Scanline[Row]; //Filters.ProgressBar.StepIt; //Filters.ProgressBar.Update; end; //размываем каждую строчку: P := AllocMem(theBitmap.Width * SizeOf(TRGBTriple)); for Row := 0 to theBitmap.Height - 1 do begin BlurRow(Slice(theRows[Row]^, theBitmap.Width), K, P); //Filters.ProgressBar.StepIt; //Filters.ProgressBar.Update; end; //теперь размываем каждую колонку ReAllocMem(P, theBitmap.Height * SizeOf(TRGBTriple)); for Col := 0 to theBitmap.Width - 1 do begin //Filters.ProgressBar.StepIt; //Filters.ProgressBar.Update; //- считываем первую колонку в TRow: for Row := 0 to theBitmap.Height - 1 do ACol[Row] := theRows[Row][Col]; BlurRow(Slice(ACol^, theBitmap.Height), K, P); //теперь помещаем обработанный столбец на свое место в данные изображения: for Row := 0 to theBitmap.Height - 1 do theRows[Row][Col] := ACol[Row]; end; FreeMem(theRows); FreeMem(ACol); ReAllocMem(P, 0); end; end. THE CRACKER IS OUT THERE |
#4
|
||||
|
||||
Цитата:
Последний раз редактировалось Winny, 08.10.2007 в 15:20. |
#5
|
||||
|
||||
Нет. Не MotionBlur'а. Это скорее GaussianBlur. А MotionBlur - это размытие в движение.
Что делать, когда сломался комп: 1. Если вы юзер - делать ноги. 2. Если ремонтник - делать деньги. 3. Если вы программист - делать вид, что так было задумано. |
#6
|
||||
|
||||
В аттаче модуль DGraphBlur - его можно на прямую не использовать, т.к. в аттаче есть еще небольшой мой модуль DGraphFunctions для работы с эффектами, в нем и DGraphBlur используется.
Вот список процедур и ф-ий: Код:
////////////////////////////////////////////////////////////////////////////// // процедуры ////////////////////////////////////////////////////////////////////////////// procedure Sharpen(sbm, tbm: TBitmap; alpha: Single); procedure Contrast(Bitmap: TBitmap; Value: Integer; Local: Boolean); procedure PutImageToImage(bmLogo,bmOutput: TBitmap; iX,iY: Integer; bTransp: Boolean; colTransp: TColor); procedure Brightness(const Bmp: TBitmap; iValue: Smallint); procedure Blur(Bmp: TBitmap; fValue: Double); procedure Bevel(Bmp: TBitmap; iRadius: Integer; colColor: TColor); procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor); ////////////////////////////////////////////////////////////////////////////// // функции ////////////////////////////////////////////////////////////////////////////// function BmpToSepia(const Bmp: TBitmap; Depth: Integer): Boolean; function DoGrayScale(const Bmp: TBitmap): Boolean; function PutTextToImage(Bitmap: TBitmap; iX,iY: Integer; sText: String; colBackColor: TColor; bBackTransp: Boolean; fFont: TFont): Boolean; function GetPixelColor: String; function SimpleResize(bmpIn,bmpOut: TBitmap; iHeight,iWidth: Integer; btSide{1-by Width,2-by Height,3-Proportional}: Byte): Boolean; function CustomResize(sImagePath,sSavingType,sDestImagePath: String; iHeight,iWidth: Integer; btSide{1-by Width,2-by Height,3-Proportional}: Byte): Boolean; Если будет не понятно, как пользоваться какими-то ф-ми или процедурами, пишите, покажу на примере. THE CRACKER IS OUT THERE Последний раз редактировалось 4kusNick, 07.10.2007 в 19:04. |
#7
|
||||
|
||||
Вот еще один пример.
Компонент от Babak Sateli (там все наглядно показано): |
#8
|
||||
|
||||
Можешь еще и тут глянуть:
Единая база процедур и функций для Delphi |
#9
|
||||
|
||||
А SmartBlur'а и MotionBlur'а нет ни у кого?
Что делать, когда сломался комп: 1. Если вы юзер - делать ноги. 2. Если ремонтник - делать деньги. 3. Если вы программист - делать вид, что так было задумано. |