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...
Pergunta
Morphadron
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...
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
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.