Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.11.20;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.033 c
1-1130322509
G0ga
2005-10-26 14:28
2005.11.20
Работа с TObjectList


4-1126712775
Delphir
2005-09-14 19:46
2005.11.20
Explorer Toolbar


14-1130737263
Ega23
2005-10-31 08:41
2005.11.20
С днем рождения! 31 октября


14-1130748519
Gydvin
2005-10-31 11:48
2005.11.20
UserGate - Help me


14-1130501973
NiGGa
2005-10-28 16:19
2005.11.20
Компонента графика