Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Sharpen a Bitmap 
:(
    Опции темы
Poseidon
Дата 19.5.2005, 01:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: нет
Всего: 133



Код
procedure Sharpen(sbm, tbm: TBitmap; alpha: Single); 
//to sharpen, alpha must be >1. 
//pixelformat pf24bit 
//sharpens sbm to tbm 
var 
  i, j, k: integer; 
  sr: array[0..2] of PByte; 
  st: array[0..4] of pRGBTriple; 
  tr: PByte; 
  tt, p: pRGBTriple; 
  beta: Single; 
  inta, intb: integer; 
  bmh, bmw: integer; 
  re, gr, bl: integer; 
  BytesPerScanline: integer; 

begin 
  //sharpening is blending of the current pixel 
  //with the average of the surrounding ones, 
  //but with a negative weight for the average 
  Assert((sbm.Width > 2) and (sbm.Height > 2), 'Bitmap must be at least 3x3'); 
  Assert((alpha > 1) and (alpha < 6), 'Alpha must be >1 and <6'); 
  beta := (alpha - 1) / 5; //we assume alpha>1 and beta<1 
  intb := round(beta * $10000); 
  inta := round(alpha * $10000); //integer scaled alpha and beta 
  sbm.PixelFormat := pf24bit; 
  tbm.PixelFormat := pf24bit; 
  tbm.Width := sbm.Width; 
  tbm.Height := sbm.Height; 
  bmw := sbm.Width - 2; 
  bmh := sbm.Height - 2; 
  BytesPerScanline := (((bmw + 2) * 24 + 31) and not 31) div 8; 

  tr := tbm.Scanline[0]; 
  tt := pRGBTriple(tr); 

  sr[0] := sbm.Scanline[0]; 
  st[0] := pRGBTriple(sr[0]); 
  for j := 0 to bmw + 1 do 
  begin 
    tt^ := st[0]^; 
    inc(tt); inc(st[0]); //first row unchanged 
  end; 

  sr[1] := PByte(integer(sr[0]) - BytesPerScanline); 
  sr[2] := PByte(integer(sr[1]) - BytesPerScanline); 
  for i := 1 to bmh do 
  begin 
    Dec(tr, BytesPerScanline); 
    tt := pRGBTriple(tr); 
    st[0] := pRGBTriple(integer(sr[0]) + 3); //top 
    st[1] := pRGBTriple(sr[1]); //left 
    st[2] := pRGBTriple(integer(sr[1]) + 3); //center 
    st[3] := pRGBTriple(integer(sr[1]) + 6); //right 
    st[4] := pRGBTriple(integer(sr[2]) + 3); //bottom 
    tt^ := st[1]^; //1st col unchanged 
    for j := 1 to bmw do 
    begin 
    //calcutate average weighted by -beta 
      re := 0; gr := 0; bl := 0; 
      for k := 0 to 4 do 
      begin 
        re := re + st[k]^.rgbtRed; 
        gr := gr + st[k]^.rgbtGreen; 
        bl := bl + st[k]^.rgbtBlue; 
        inc(st[k]); 
      end; 
      re := (intb * re + $7FFF) shr 16; 
      gr := (intb * gr + $7FFF) shr 16; 
      bl := (intb * bl + $7FFF) shr 16; 

    //add center pixel weighted by alpha 
      p := pRGBTriple(st[1]); //after inc, st[1] is at center 
      re := (inta * p^.rgbtRed + $7FFF) shr 16 - re; 
      gr := (inta * p^.rgbtGreen + $7FFF) shr 16 - gr; 
      bl := (inta * p^.rgbtBlue + $7FFF) shr 16 - bl; 

    //clamp and move into target pixel 
      inc(tt); 
      if re < 0 then 
        re := 0 
      else 
        if re > 255 then 
          re := 255; 
      if gr < 0 then 
        gr := 0 
      else 
        if gr > 255 then 
          gr := 255; 
      if bl < 0 then 
        bl := 0 
      else 
        if bl > 255 then 
          bl := 255; 
      //this looks stupid, but avoids function calls 

      tt^.rgbtRed := re; 
      tt^.rgbtGreen := gr; 
      tt^.rgbtBlue := bl; 
    end; 
    inc(tt); 
    inc(st[1]); 
    tt^ := st[1]^; //Last col unchanged 
    sr[0] := sr[1]; 
    sr[1] := sr[2]; 
    Dec(sr[2], BytesPerScanline); 
  end; 
  // copy last row 
  Dec(tr, BytesPerScanline); 
  tt := pRGBTriple(tr); 
  st[1] := pRGBTriple(sr[1]); 
  for j := 0 to bmw + 1 do 
  begin 
    tt^ := st[1]^; 
    inc(tt); inc(st[1]); 
  end; 
end; 



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!


Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »


 




[ Время генерации скрипта: 0.0572 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.