Ir para conteúdo
Fórum Script Brasil
  • 0

Saturar Imagem


Morphadron

Pergunta

Olá pessoal, tudo beleza?

Bom, o lance é o seguinte, eu preciso saturar uma imagem, dar brilho nela, saca? existe uma unit chamda GraphUtils, e uma função chamada ColorAdjustLuma, q estou utilizando mas... não estah das mil maravilhas, e quero apagar todas as linhas e contruir algo mais "inteligente", daí escrevi o seguinte...

 
unit Unit1; 

interface 

uses 
  Windows, Forms, Controls, StdCtrls, Buttons, Graphics, Classes, ExtCtrls, 
  SysUtils, GraphUtil; 

type 
  TForm1 = class(TForm) 
    Image1: TImage; 
    BitBtn1: TBitBtn; 
    BitBtn2: TBitBtn; 
    BitBtn3: TBitBtn; 
    procedure FormCreate(Sender: TObject); 
    procedure BitBtn1Click(Sender: TObject); 
    procedure BitBtn2Click(Sender: TObject); 
    procedure BitBtn3Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    Bmp: TBitmap; 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.dfm} 

function ColorAddChannel(C: TColor; N: Integer): TColor; 
asm 
    pxor        mm0, mm0 
    movd        mm1, C 
    movd        mm2, N 
    punpcklbw   mm1, mm0 
    packuswb    mm2, mm2 
    packuswb    mm2, mm2 

    paddusb     mm2, mm1 
    packuswb    mm2, mm0 

    movd        eax, mm2 
    and         eax, $ffffff 

    emms 
end; 

procedure ColorAddChannelArray32(A, B: PIntegerArray; Size, N: Integer); 
asm 
    pxor        mm0, mm0 
    movd        mm2, N 
    packuswb    mm2, mm2 
    packuswb    mm2, mm2 

@loop: 
    movd        mm1, [A] 
    punpcklbw   mm1, mm0 
    paddusb     mm1, mm2 
    packuswb    mm1, mm0 
    movd        [B], mm1 
    and         [B], $ffffff 
    add         A, 4 
    add         B, 4 
    dec         Size 
    jnz         @loop 

    emms 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
var 
  A: TColor; 
  X, Y: TColor; 
begin 
  A := clRed; 
  X := ColorAddChannel(A, 30); 
  ColorAddChannelArray32(@A, @Y, 1, 30); 
  Caption := Format('%x - %x', [X, Y]); 

  Image1.Picture.Bitmap.PixelFormat := pf32bit; 
  Bmp := TBitmap.Create; 
  Bmp.Assign(Image1.Picture.Graphic); 
  Image1.Picture.Assign(Bmp); 
end; 

procedure TForm1.BitBtn1Click(Sender: TObject); 
var 
  X, Y: Integer; 
begin 
  for X := 0 to Bmp.Width - 1 do 
    for Y := 0 to Bmp.Height - 1 do 
      Image1.Canvas.Pixels[X, Y] := ColorAddChannel(Bmp.Canvas.Pixels[X, Y], 90); 
end; 

procedure TForm1.BitBtn2Click(Sender: TObject); 
var 
  I: Integer; 
  A, B: Pointer; 
  S, F: Int64; 
begin 
  QueryPerformanceCounter(S); 

//  A := Bmp.ScanLine[Image1.Height - 1]; 
//  B := Image1.Picture.Bitmap.ScanLine[Image1.Height - 1]; 
//  ColorAddChannelArray32(A, B, Bmp.Width * Bmp.Height, 90); 

  for I := 0 to Bmp.Height - 1 do 
  begin 
    A := Bmp.ScanLine[I]; 
    B := Image1.Picture.Bitmap.ScanLine[I]; 
    ColorAddChannelArray32(A, B, Bmp.Width, 90); 
  end; 

  QueryPerformanceCounter(F); 
  Caption := IntToStr(F - S); 
end; 

procedure TForm1.BitBtn3Click(Sender: TObject); 
var 
  X, Y: Integer; 
begin 
  for X := 0 to Bmp.Width - 1 do 
    for Y := 0 to Bmp.Height - 1 do 
      Image1.Canvas.Pixels[X, Y] := GetHighLightColor(Bmp.Canvas.Pixels[X, Y]); 
end; 

end.

O resultado é mais "eficiente", bom pessoal, mtas vezes eu acabo m perdendo nas minhas próprias rotinas, e talvez vc's m ajudem, pois é mta linha de programação... concordam?

alguém sabe c existe uma função, para isso, ou algo parecido?

tipo...

imagem.saturar; hehehe

Mas gostaria d agradecer só pelo tempo perdido lendo esse "tópico", valeu pessoal...

Abraços, Iter Vinícius

Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

  • 0

Cria um componente com o seu código!!!

Depois quando você precisar usar Imagem.Saturar é sopa!!!

Além do mais, quando tiver um tempinho. Lê com calma seu código pra eliminar as possíveis "Linhas Sujas".

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,4k
×
×
  • Criar Novo...