Ver Mensaje Individual
  #2  
Antiguo 21-02-2005
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.298
Reputación: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Justo hace unos días aquí se estuvo hablando de convertir una imagen (bitmap) a "color Sepia" y salieros varias rutinas para pasar un bitmap a escala de grises. Es sencillo utilizar esa rutina para generar un nuevo componente con la propiedad que necesitas. Aquí tienes un ejemplo.

Pasar un JPEG en color a sepia

Código Delphi [-]
  unit image_Gris;
  
  interface
  
  uses
    Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics;
  
  type
    TImageGris = class(TImage)
    private
      FColorImage:Graphics.TBitmap;
      FEnables: Boolean;
      procedure SetEnabled(const Value: Boolean);
      procedure ConvertBitmapToGrayscale2(const Bmp: TBitmap);
    protected
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;    
    published
      property Enabled:Boolean read FEnables write SetEnabled;
  
    end;
  
  procedure Register;
  
  implementation
  
  procedure Register;
  begin
    RegisterComponents('ImageGris', [TImageGris]);
  end;
  
  constructor TImageGris.Create(AOwner: TComponent);
  begin
    inherited;
  
    Self.FEnables := True;
    Self.FColorImage := TBitmap.Create();
  
  end;
  
  destructor TImageGris.Destroy;
  begin
  
    Self.FColorImage.Free;
  
    inherited;
  end;
  
  procedure TImageGris.ConvertBitmapToGrayscale2(const Bmp: TBitmap);
    {From: Pascal Enz, pascal.enz@datacomm.ch }
  type
    TRGBArray = array[0..32767] of TRGBTriple;
    PRGBArray = ^TRGBArray;
  var
    x, y, Gray: Integer;
    Row: PRGBArray;
  begin
    Bmp.PixelFormat := pf24Bit;
    for y := 0 to Bmp.Height - 1 do
    begin
      Row := Bmp.ScanLine[y];
      for x := 0 to Bmp.Width - 1 do
      begin
        Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
        Row[x].rgbtRed := Gray;
        Row[x].rgbtGreen := Gray;
        Row[x].rgbtBlue := Gray;
      end;
    end;
  end;
  
  procedure TImageGris.SetEnabled(const Value: Boolean);
  begin
    // No ha cambiado?
    if (FEnables = Value) then begin
      Exit;
    end;
  
    Self.FEnables := Value;
    // Pasar a deshabilitado
    if not (Value) then begin
      Self.FColorImage.Assign(Self.Picture.Bitmap);
      ConvertBitmapToGrayscale2(Self.Picture.Bitmap);
    end
    else begin
      Self.Picture.Bitmap.Assign(Self.FColorImage);
    end;
  
    Self.Repaint;
  end;
  
  end.

Ten en cuenta que que está incompleto, pero te puede servir para ampliarlo; Habría que completar el Create/Destroy y añadir los métodos de protección adecuados. Ésta versión sólo funciona con la imagen en formato BitMap, habría que tener en cuenta las otras posibilidades de un TImage.

Espero que te sirva como idea, al menos.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.

Última edición por Neftali [Germán.Estévez] fecha: 21-02-2005 a las 09:55:39. Razón: Link al mensaje de "tonos en Sepia"
Responder Con Cita