Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2005.11.20;
Скачать: [xml.tar.bz2];

Вниз

sepia   Найти похожие ветки 

 
Crazy_Diman ©   (2005-10-30 13:25) [0]

function bmptosepia(const bmp: TBitmap; depth: Integer): Boolean;
var
p0:pbytearray;

color,color2:longint;
r,g,b,rr,gg:byte;
Gray,h,w:integer;
begin
 for h := 0 to bmp.height-1 do
 begin
   p0:=bmp.scanline[h];

   for w := 0 to bmp.width-1 do
   begin

//first convert the bitmap to greyscale
    Gray:=Round(p0[w*3]*0.3+p0[w*3+1]*0.59+p0[w*3+2]*0.11);
    p0[w*3]:=Gray;
     p0[w*3+1]:=Gray;
     p0[w*3+2]:=Gray;
//then convert it to sepia
   color:=colortorgb(bmp.Canvas.pixels[w,h]);
   r:=getrvalue(color);
   g:=getgvalue(color);
   b:=getbvalue(color);
   rr:=r+(depth*2);
   gg:=g+depth;
   if rr <= ((depth*2)-1) then
   rr:=255;
   if gg <= (depth-1) then
   gg:=255;
   bmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
   end;
 end;
end;


нашол пример в Интернете  он  мне понравился решил я отемизировать  
получилась У меня так
function bmptosepiaa(const bmp: TBitmap; depth: Integer): Boolean;
var
p0:pbytearray;

color,color2:longint;
r,g,b,rr,gg:byte;
Gray,h,w:integer;
begin
 for h := 0 to bmp.height-1 do
 begin
   p0:=bmp.scanline[h];

   for w := 0 to bmp.width-1 do
   begin

//first convert the bitmap to greyscale
    Gray:=Round(p0[w*3]+0.81);
    p0[w*3]:=Gray;
     p0[w*3+1]:=Gray;
     p0[w*3+2]:=Gray;
//then convert it to sepia
   color:=colortorgb(bmp.Canvas.pixels[w,h]);
   r:=getrvalue(color);
   g:=getgvalue(color);
   b:=getbvalue(color);
   rr:=r+(depth*2);
   gg:=g+depth;
   if rr <= ((depth*2)-1) then
   rr:=255;
   if gg <= (depth-1) then
   gg:=255;
   bmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
   end;
 end;
end;
но он мне выдает не тот результат   на рисунке

помогите найти Ошибку


 
Antonn ©   (2005-10-30 15:02) [1]

замени bmp.canvas.Pixels[w,h] сканлайном

procedure PrepareBitmapSerpia(_B_out:Tbitmap);
const
 Pixels = MaxInt div SizeOf(TRGBTriple);
type
 PRGBArray = ^TRGBArray;
 TRGBArray = array[0..Pixels-1] of TRGBTriple;
var x, y: Integer; RowOut: PRGBArray;
   _r,_b,_g:integer;
begin
 _B_out.PixelFormat:=pf24bit;
 for y:=0 to _B_out.Height-1 do begin
    RowOut:= _B_out.ScanLine[y];
   for x:=0 to _B_out.Width-1 do begin
         _r:=trunc( RowOut[x].rgbtRed*0.393+RowOut[x].rgbtGreen*0.769+RowOut[x].rgbtBlue*0.189);
        if _r>255 then _r:=255; if _r<0 then _r:=0;
         _g:=trunc( RowOut[x].rgbtRed*0.349+RowOut[x].rgbtGreen*0.686+RowOut[x].rgbtBlue*0.168);
        if _g>255 then _g:=255; if _g<0 then _g:=0;
         _b:=trunc( RowOut[x].rgbtRed*0.272+RowOut[x].rgbtGreen*0.534+RowOut[x].rgbtBlue*0.131);
        if _b>255 then _b:=255; if _b<0 then _b:=0;
         RowOut[x].rgbtRed:=_r;
         RowOut[x].rgbtGreen:=_g;
         RowOut[x].rgbtBlue:=_b;
   end;
 end
end;


 
Antonn ©   (2005-10-30 15:03) [2]

к [1]
ах да, ее тоже можно оптимизировать:)


 
Crazy_Diman ©   (2005-10-30 15:13) [3]

:)   все переписал   я просто хадел как быстро получиль ху*ня
procedure bmptosepia( Bm:TBitmap;width:Integer);
var
 TargetRow             :pRGBArray;
 r,g,b     :Integer;
 Row,Col     :Integer;

begin
for Row := 0 to Bm.Height - 1 do
     begin
        TargetRow:=Bm.ScanLine[Row];
          for Col := 0 to Bm.Width - 1 do
       begin
         r:=0;g:=0;b:=0;
         r:=trunc( TargetRow[Col].rgbtRed*0.393+TargetRow[Col].rgbtGreen*0.769+TargetRow[Col].rgbtBlue*0.189);
 if r>255 then r:=255;
         g:=trunc( TargetRow[Col].rgbtRed*0.349+TargetRow[Col].rgbtGreen*0.686+TargetRow[Col].rgbtBlue*0.168);
        if g>255 then g:=255;
         b:=trunc( TargetRow[Col].rgbtRed*0.272+TargetRow[Col].rgbtGreen*0.534+TargetRow[Col].rgbtBlue*0.131);
        if b>255 then b:=255;
    TargetRow[Col].rgbtRed  := r;
         TargetRow[Col].rgbtGreen  := g;
         TargetRow[Col].rgbtBlue  := b;
         TargetRow[Col].rgbtRed:=r+(width*2);
      TargetRow[Col].rgbtGreen:=g+width;
      if  TargetRow[Col].rgbtRed <= ((width*2)-1) then
  TargetRow[Col].rgbtRed:=255;
  if TargetRow[Col].rgbtGreen <= (width-1) then
  TargetRow[Col].rgbtGreen:=255;
end;
          end;
           end;


 
Antonn ©   (2005-10-30 16:11) [4]

Crazy_Diman ©   (30.10.05 15:13) [3]
TargetRow[Col].rgbtRed:=r+(width*2);
     TargetRow[Col].rgbtGreen:=g+width;
     if  TargetRow[Col].rgbtRed <= ((width*2)-1) then
 TargetRow[Col].rgbtRed:=255;
 if TargetRow[Col].rgbtGreen <= (width-1) then
 TargetRow[Col].rgbtGreen:=255;

а это зачем?


 
Crazy_Diman ©   (2005-10-31 10:38) [5]

нужно  а твой пример глючит  бывает какуето ху*ню показывает


 
Antonn ©   (2005-10-31 11:17) [6]

Crazy_Diman ©   (31.10.05 10:38) [5]
бывает какуето ху*ню показывает

да ну?


 
Crazy_Diman ©   (2005-10-31 11:35) [7]

смотри www.program2006.narod.ru/2.jpg   зайдив чат поговорим


 
Crazy_Diman ©   (2005-10-31 11:59) [8]

Antonn ©   мне лично похуй каким примером пользовется суравно  буду переписывать   . Спасибо  за точто помог



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2005.11.20;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.04 c
2-1130589369
Herbariun
2005-10-29 16:36
2005.11.20
Длина строки


6-1123706619
Trojan_nt
2005-08-11 00:43
2005.11.20
Помогите создать статистику DSN Инета


2-1131051786
StasStas
2005-11-04 00:03
2005.11.20
Не сделать элементарную вещь ...


2-1130483841
Dron_
2005-10-28 11:17
2005.11.20
Удаление символов из строки


1-1130077478
users
2005-10-23 18:24
2005.11.20
Чем упаковать несколько файлов в один архив, не используя DLL ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский