Ver Mensaje Individual
  #3  
Antiguo 30-08-2007
Avatar de paldave
paldave paldave is offline
Miembro
 
Registrado: ago 2007
Ubicación: Uruguay
Posts: 148
Reputación: 17
paldave Va por buen camino
Fijate en estas rutinas relacionadas al manejo de color de una imagen llamadas ConvertToGrayScale, ConvertToMonocrome, Iluminate y Negativize:
Código Delphi [-]
procedure TosImage.ConvertToGrayScale(Light:Integer=0;Tint:TColor=clBlack);
var f,n:Integer;
c:TColor;
bm:TBitmap;
begin
  if not (Picture.Graphic is TBitmap) then
  begin
    raise EInvalidGraphicOperation.Create('Image must be a bitmap.');
    exit;
  end;

  if Picture.Bitmap =nil then
  begin
    raise EInvalidGraphic.Create('Bitmap do not exists.');
    exit;
  end;

  bm:=TBitmap.Create;
  bm.Width :=Picture.Bitmap.Width;
  bm.Height :=Picture.Bitmap.Height;
  for f:=0 to Picture.Bitmap.Height do
    for n:=0 to Picture.Bitmap.Width do
    begin
      c:=ColorToGrayScale(Canvas.Pixels[n,f]);
      if Light <> 0 then
        c:= ChangeColorLight(c,Light);

      if Tint <> clBlack then
        c:=GrayScaleToColorScale(ColorToGrayValue(c),Tint);

      bm.Canvas.Pixels[n,f]:=c;
    end;
  Picture.Bitmap.Assign(bm);
  bm.free;
end;
Código Delphi [-]
procedure TosImage.ConvertToMonochrome(Range:Byte;ForeColor:TColor=clBlack;BackColor:TColor=clWhite);
var f,n:Integer;
t:Byte;
bm:TBitmap;
begin
  if not (Picture.Graphic is TBitmap) then
  begin
    raise EInvalidGraphicOperation.Create('Image must be a bitmap.');
    exit;
  end;

  if Picture.Bitmap =nil then
  begin
    raise EInvalidGraphic.Create('Bitmap do not exists.');
    exit;
  end;

  bm:=TBitmap.Create;
  bm.Width :=Picture.Bitmap.Width;
  bm.Height:=Picture.Bitmap.Height;
  for f:=0 to Picture.Bitmap.Height do
    for n:=0 to Picture.Bitmap.Width do
    begin
      t:=ColorToGrayValue(Canvas.Pixels[n,f]);
      if t <= Range then
         bm.Canvas.Pixels[n,f]:=ForeColor
       else
         bm.Canvas.Pixels[n,f]:=BackColor;
    end;
  Picture.Bitmap.Assign(bm);
  bm.free;
end;
Código Delphi [-]
procedure TosImage.Iluminate(Light:Integer);
var f,n:Integer;
c:TColor;
bm:TBitmap;
begin
  if not (Picture.Graphic is TBitmap) then
  begin
    raise EInvalidGraphicOperation.Create('Image must be a bitmap.');
    exit;
  end;

  if Picture.Bitmap =nil then
  begin
    raise EInvalidGraphic.Create('Bitmap do not exists.');
    exit;
  end;

  bm:=TBitmap.Create;
  bm.Width :=Picture.Bitmap.Width;
  bm.Height :=Picture.Bitmap.Height;
  for f:=0 to Picture.Bitmap.Height do
    for n:=0 to Picture.Bitmap.Width do
    begin
      c:=Canvas.Pixels[n,f];
      if Light <> 0 then
        c:= ChangeColorLight(c,Light);

      bm.Canvas.Pixels[n,f]:=c;
    end;
  Picture.Bitmap.Assign(bm);
  bm.free;
end;
Código Delphi [-]
procedure TosImage.Negativize;
var f,n:Integer;
r,g,b:Byte;
bm:TBitmap;
begin
  if not (Picture.Graphic is TBitmap) then
  begin
    raise EInvalidGraphicOperation.Create('Image must be a bitmap.');
    exit;
  end;

  if Picture.Bitmap =nil then
  begin
    raise EInvalidGraphic.Create('Bitmap do not exists.');
    exit;
  end;

  bm:=TBitmap.Create;
  bm.Width :=Picture.Bitmap.Width;
  bm.Height :=Picture.Bitmap.Height;
  for f:=0 to Picture.Bitmap.Height do
    for n:=0 to Picture.Bitmap.Width do
    begin
      DecodeColor(Canvas.Pixels[n,f],r,g,b);
      r:=255-r;
      g:=255-g;
      b:=255-b;
      bm.Canvas.Pixels[n,f]:=EncodeColor(r,g,b);
    end;
  Picture.Bitmap.Assign(bm);
  bm.free;
end;
Código Delphi [-]
procedure TosImage.Negativize;
var f,n:Integer;
r,g,b:Byte;
bm:TBitmap;
begin
  if not (Picture.Graphic is TBitmap) then
  begin
    raise EInvalidGraphicOperation.Create('Image must be a bitmap.');
    exit;
  end;

  if Picture.Bitmap =nil then
  begin
    raise EInvalidGraphic.Create('Bitmap do not exists.');
    exit;
  end;

  bm:=TBitmap.Create;
  bm.Width :=Picture.Bitmap.Width;
  bm.Height :=Picture.Bitmap.Height;
  for f:=0 to Picture.Bitmap.Height do
    for n:=0 to Picture.Bitmap.Width do
    begin
      DecodeColor(Canvas.Pixels[n,f],r,g,b);
      r:=255-r;
      g:=255-g;
      b:=255-b;
      bm.Canvas.Pixels[n,f]:=EncodeColor(r,g,b);
    end;
  Picture.Bitmap.Assign(bm);
  bm.free;
end;
Puedes agregarlas en un control que sea descendiente directo de TImage;
También necesitarás agregar en ese control estas otras rutinas que son llamadas por las anteriores:
Código Delphi [-]
procedure DecodeCMYK(CMYKColor:Integer; var C,M,Y,K:Byte);
begin
  C:= GetCValue(CMYKColor);
  M:= GetMValue(CMYKColor);
  Y:= GetYValue(CMYKColor);
  K:= GetKValue(CMYKColor);
end;
Código Delphi [-]
function EncodeColor(R,G,B:Byte):TColor;
begin
   Result:= RGB(R,G,B);
end;
Código Delphi [-]
procedure DecodeColor(Color:TColor; var R,G,B:Byte);
begin
  Color:=ColorToRGB(Color);
  R:= GetRValue(Color);
  G:= GetGValue(Color);
  B:= GetBValue(Color);
end;
Código Delphi [-]
procedure DecodeRGB(RGBColor:Integer; var R,G,B:Byte);
begin
  R:= GetRValue(RGBColor);
  G:= GetGValue(RGBColor);
  B:= GetBValue(RGBColor);
end;
Código Delphi [-]
function ColorToGrayScale(Color:TColor):TColor;
var R,G,B:Byte;
begin
  DecodeColor(Color,R,G,B);
  R:=R*76 div 255;
  G:=G*152 div 255;
  B:=B*24 div 255;
  R:=R+G+B;
  Result:=EncodeColor(R,R,R);
end;
Código Delphi [-]
function ColorToGrayValue(Color:TColor):Byte;
var r,g,b:Byte;
begin
  DecodeColor(Color,R,G,B);
  R:=R*76 div 255;
  G:=G*152 div 255;
  B:=B*24 div 255;
  Result:=R+G+B;
end;
Código Delphi [-]
function BrightenColor(Color:TColor; Change:Byte):TColor;
var r,g,b:Integer;
begin
  result:=ColorToRGB(color);
  r:= GetRValue(result);
  g:= GetGValue(result);
  b:= GetBValue(result);

  inc(r,Change);
  inc(g,Change);
  inc(b,Change);

  if r>255 then r:=255;
  if g>255 then g:=255;
  if b>255 then b:=255;

  result:= RGB(r,g,b);
end;
Código Delphi [-]
function DarkenColor(Color:TColor; Change:Byte):TColor;
var r,g,b:Integer;
begin
  result:=ColorToRGB(color);
  r:= GetRValue(result);
  g:= GetGValue(result);
  b:= GetBValue(result);

  dec(r,Change);
  dec(g,Change);
  dec(b,Change);

  if r < 0 then r:=0;
  if g < 0 then g:=0;
  if b < 0 then b:=0;

  result:= RGB(r,g,b);
end;
Código Delphi [-]
function ChangeColorLight(Color:TColor;Change:Integer):TColor;
begin
  if Change>0 then
    result:=BrightenColor(Color,Change)
  else if Change < 0 then
    result:=DarkenColor(Color,abs(Change));
end;
Código Delphi [-]
function GrayScaleToColorScale(GrayValue:Byte;Color:TColor):TColor;
var r,g,b:Byte;
begin
  DecodeColor(Color,r,g,b);
  r:= r+((GrayValue*(256-r))div 256);
  g:= g+((GrayValue*(256-g))div 256);
  b:= b+((GrayValue*(256-b))div 256);
  result:=EncodeColor(r,g,b);
end;
Código Delphi [-]
function ApproachColor(FromColor,ToColor:TColor;Approach:Byte):TColor;
var r1,r2,g1,g2,b1,b2:Byte;
begin
  DecodeColor(FromColor,r1,g1,b1);
  DecodeColor(ToColor,r2,g2,b2);

  if r1 < r2 then
  begin
    if r1+Approach < r2 then
      r1:=r1+Approach
    else
      r1:=r2;
  end
  else
  begin
    if r1-Approach>r2 then
      r1:=r1-Approach
    else
      r1:=r2;
  end;

  if g1 < g2 then
  begin
    if g1+Approach < g2 then
      g1:=g1+Approach
    else
      g1:=g2;
  end
  else
  begin
    if g1-Approach>g2 then
      g1:=g1-Approach
    else
      g1:=g2;
  end;


  if b1 < b2 then
  begin
    if b1+Approach < b2 then
      b1:=b1+Approach
    else
      b1:=b2;
  end
  else
  begin
    if b1-Approach>b2 then
      b1:=b1-Approach
    else
      b1:=b2;
  end;

  result:=EncodeColor(r1,g1,b1);
end;
No están optimizadas para velocidad (no me tomé ese trabajo al escribirlas) pero no son muy lentas

Última edición por paldave fecha: 30-08-2007 a las 23:02:34. Razón: El formateador del foro cambiaba el código!!!!!
Responder Con Cita