converting a BMP image to gray scale...
Hi guys!
I need a very fast routine to convert a colour bmp picture to gray scale... Any suggestions?
Best regards,
Manuel López (lopem)
I need a very fast routine to convert a colour bmp picture to gray scale... Any suggestions?
Best regards,
Manuel López (lopem)
I meant "how fast the stuff is", of course...
Earl's got some good stuff - as Madshi pointed out. When doing this sort of processing there are some considerations about speed though. About the simplest means is to try something like this:
for every pixel[x,y][r,g,b], your greyscale pixel[x,y] = sqrt(r*r+g*g+b*b)
there are optomizations you can do with this, depending on how accurat you want your sqrt() to be. For instance:
pixel[x,y] = (r+g+b)/3;
pixel[x,y] = (r*r+g*g+b*b)/(3*256)
The problem with this type of solution is that you tend to loose contrast. A red pixel (255,0,0) would have the same luminosity as a blue one (0,0,255), but _should_ have different greyscale values. The about algo's (no matter about the sqrt opt's) won't do this. Instead you'd have to compare each pixel to it's surrounding ones. Think of each pixel as being a 3d point - (r,g,b) instead of (x,y,z). The you can give it a grey scale value based on how 'far' away it is from the surounding pixels:
r(x,y) = pixel[x,y][r];g(x,y) = pixel[x,y][g];b(x,y) = pixel[x,y][b];
f(x,y,xb,yb) = sqrt( (r(x,y)-r(xb-yb))^2 + (g(x,y)-g(xb-yb))^2 + (b(x,y)-b(xb-yb))^2 )/sqrt(3);
dist = 0;
for iy := -1 to 1 do
for ix := -1 to 1 do
dist := dist + f(x,y,x+ix,y+iy);
pixel[x,y] := dist/8;
The above would def. give better results, but would take _much_ longer.
The other option, which isn't really fast but prob. good enough, is to use a TJPEGImage. Copy the bmp to the jpeg, set the jpeg to be greyscale, then read off the resulting bmp. This will look very good, but you wouldn't want to attempt to do it like a couple frames per second cause it ain't gonna happen.
GL
Mike
for every pixel[x,y][r,g,b], your greyscale pixel[x,y] = sqrt(r*r+g*g+b*b)
there are optomizations you can do with this, depending on how accurat you want your sqrt() to be. For instance:
pixel[x,y] = (r+g+b)/3;
pixel[x,y] = (r*r+g*g+b*b)/(3*256)
The problem with this type of solution is that you tend to loose contrast. A red pixel (255,0,0) would have the same luminosity as a blue one (0,0,255), but _should_ have different greyscale values. The about algo's (no matter about the sqrt opt's) won't do this. Instead you'd have to compare each pixel to it's surrounding ones. Think of each pixel as being a 3d point - (r,g,b) instead of (x,y,z). The you can give it a grey scale value based on how 'far' away it is from the surounding pixels:
r(x,y) = pixel[x,y][r];g(x,y) = pixel[x,y][g];b(x,y) = pixel[x,y][b];
f(x,y,xb,yb) = sqrt( (r(x,y)-r(xb-yb))^2 + (g(x,y)-g(xb-yb))^2 + (b(x,y)-b(xb-yb))^2 )/sqrt(3);
dist = 0;
for iy := -1 to 1 do
for ix := -1 to 1 do
dist := dist + f(x,y,x+ix,y+iy);
pixel[x,y] := dist/8;
The above would def. give better results, but would take _much_ longer.
The other option, which isn't really fast but prob. good enough, is to use a TJPEGImage. Copy the bmp to the jpeg, set the jpeg to be greyscale, then read off the resulting bmp. This will look very good, but you wouldn't want to attempt to do it like a couple frames per second cause it ain't gonna happen.
GL
Mike
I havent had the chance to try these two out...but here goes:
procedure TForm1.Button1Click(Sender
var
X, Y : Integer;
Gray : byte;
begin
with Image1.Picture.Bitmap do
begin
for X := 0 to Width do
begin
for Y := 0 to Height do
begin
Gray := Round((0.30 * GetRValue(Canvas.Pixels[X,
(0.59 * GetGValue(Canvas.Pixels[X,
(0.11 * GetBValue(Canvas.Pixels[X,
Image1.Picture.Bitmap.Canv
end;
end;
end;
end;
or
procedure TForm1.Button1Click(Sender
var
Gray, X, Y : Integer;
PByte : PByteArray;
begin
with Image1.Picture.Bitmap do
begin
for Y := 0 to Height -1 do
begin
PByte := ScanLine[Y];
for X := 0 to Width -1 do
begin
Gray := Round(PByte[X * 3] * 0.3 + PByte[X * 3 + 1] * 0.59 + PByte[X * 3 + 2] * 0.11);
PByte[X * 3] := Gray;
PByte[X * 3 + 1] := Gray;
PByte[X * 3 + 2] := Gray;
end;
end;
end;
Image1.Refresh;
end;
Cheers,
Alan
procedure TForm1.Button1Click(Sender
var
X, Y : Integer;
Gray : byte;
begin
with Image1.Picture.Bitmap do
begin
for X := 0 to Width do
begin
for Y := 0 to Height do
begin
Gray := Round((0.30 * GetRValue(Canvas.Pixels[X,
(0.59 * GetGValue(Canvas.Pixels[X,
(0.11 * GetBValue(Canvas.Pixels[X,
Image1.Picture.Bitmap.Canv
end;
end;
end;
end;
or
procedure TForm1.Button1Click(Sender
var
Gray, X, Y : Integer;
PByte : PByteArray;
begin
with Image1.Picture.Bitmap do
begin
for Y := 0 to Height -1 do
begin
PByte := ScanLine[Y];
for X := 0 to Width -1 do
begin
Gray := Round(PByte[X * 3] * 0.3 + PByte[X * 3 + 1] * 0.59 + PByte[X * 3 + 2] * 0.11);
PByte[X * 3] := Gray;
PByte[X * 3 + 1] := Gray;
PByte[X * 3 + 2] := Gray;
end;
end;
end;
Image1.Refresh;
end;
Cheers,
Alan
There is an exact algorhitm for conversion of RGB picture to Grayscale. Red, green and blue colors do not have the same luminosity. That means that bar in red color do not look the same in grayscale as bar in green or blue color. Formula for calculation of intensity of grayscale image pixel is:
Intensity := 0.299*Red + 0.587*Green + 0.114*Blue
If Image1 is in color and you want to convert it to grayscale you can use this code:
With Image1 do
For I:=0 to Width-1 do
For J:=0 to Height-1 do
Begin
Red := Pixels [I,J] and $FF;
Green := (Pixels [I,J] shr 8) and $ff;
Blue := (Pixels [I,J] shr 16) and $ff;
Int := Round (0.299*Red + 0.587*Green + 0.114*Blue);
Pixels [I,J]:=Int shl 16+Int shl 8+Int
End
If you need a faster way you have to use ScanLine. You may want to research a little about the scanline() routines... They pretty much bypass all conversion routines and other time consuming code.
For detailed information about Scanline take a look at
http://www.efg2.com/lab/ImageProcessing/Scanline.htm
Intensity := 0.299*Red + 0.587*Green + 0.114*Blue
If Image1 is in color and you want to convert it to grayscale you can use this code:
With Image1 do
For I:=0 to Width-1 do
For J:=0 to Height-1 do
Begin
Red := Pixels [I,J] and $FF;
Green := (Pixels [I,J] shr 8) and $ff;
Blue := (Pixels [I,J] shr 16) and $ff;
Int := Round (0.299*Red + 0.587*Green + 0.114*Blue);
Pixels [I,J]:=Int shl 16+Int shl 8+Int
End
If you need a faster way you have to use ScanLine. You may want to research a little about the scanline() routines... They pretty much bypass all conversion routines and other time consuming code.
For detailed information about Scanline take a look at
http://www.efg2.com/lab/ImageProcessing/Scanline.htm
Hi adlabac,
may I friendly lead your attention to an important issue? Here in the Delphi forum it is common practice to lock questions with an answer only if you are the first expert in the thread, or if all other comments are evidently wrong. Otherwise it is usual to post a *comment* only. This way the questioner can later easily choose which expert helped most. Additionally, using comments only is more polite because:
- the question can easily be deleted if necessary
- it cannot happen that an answer is accidentally accepted
- you show that you acknowledge the work already done
- you give other experts the chance to post a better answer
Thank you for listening... (-:
Regards, Madshi.
may I friendly lead your attention to an important issue? Here in the Delphi forum it is common practice to lock questions with an answer only if you are the first expert in the thread, or if all other comments are evidently wrong. Otherwise it is usual to post a *comment* only. This way the questioner can later easily choose which expert helped most. Additionally, using comments only is more polite because:
- the question can easily be deleted if necessary
- it cannot happen that an answer is accidentally accepted
- you show that you acknowledge the work already done
- you give other experts the chance to post a better answer
Thank you for listening... (-:
Regards, Madshi.
Hi,
here is very fast routines that convert 65536 (565) or 32768 (555) color bitmap to grayscaled variant. It doesn't used right luminocity weights to speedup process. Formula is 0.286*R+0.571*G+0.143*B (very closer to real).
I did it and opimized by myself, seems it really fastest conversions.
Conversion of image 800x600 takes about 24 msec on 300Mhz processor.
Cheers,
Igor.
// 1/3.5 matrix, used to avoid of DIV operator.
procedure XTAB; register;
asm
db $00,$00,$01,$01,$01,$01,$0
db $05,$05,$05,$05,$06,$06,$0
db $09,$09,$0A,$0A,$0A,$0B,$0
db $0E,$0E,$0E,$0F,$0F,$0F,$0
db $12,$13,$13,$13,$13,$14,$1
db $17,$17,$17,$18,$18,$18,$1
db $1B,$1C,$1C,$1C,$1D,$1D,$1
db $20,$20,$21,$21,$21,$21,$2
db $25,$25,$25,$25,$26,$26,$2
db $29,$29,$2A,$2A,$2A,$2B,$2
db $2E,$2E,$2E,$2F,$2F,$2F,$2
db $32,$33,$33,$33,$33,$34,$3
db $37,$37,$37,$38,$38,$38,$3
db $3B,$3C,$3C,$3C,$3D,$3D,$3
db $40,$40,$41,$41,$41,$41,$4
db $45,$45,$45,$45,$46,$46,$4
end;
procedure GrayScale565(Data: pointer; Size: Integer); register;
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab
@0:
lodsw
mov dx, ax
and ax, $007E0
shr ax, 5
and dl, $1F
shr dl, 1
add al, dl
shr dh, 3
add al, dh
xlat
xor ah, ah
mov dx, ax
shl dx, 6
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
end;
procedure GrayScale555(Data: pointer; Size: Integer); register;
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab
@0:
lodsw
mov dx, ax
and ax, $003E0
shr ax, 4
and dl, $1F
shr dl, 1
add al, dl
shr dh, 2
add al, dh
xlat
xor ah,ah
mov dx, ax
shl dx, 5
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
end;
procedure TForm1.SpeedButton1Click(S
var I: Integer;
begin
with Image1.Picture.Bitmap do
begin
for I := 0 to Height - 1 do
if PixelFormat = pf16bit then
GrayScale565(Scanline[I], Width)
else
GrayScale555(Scanline[I], Width);
end;
Image1.Repaint;
end;
here is very fast routines that convert 65536 (565) or 32768 (555) color bitmap to grayscaled variant. It doesn't used right luminocity weights to speedup process. Formula is 0.286*R+0.571*G+0.143*B (very closer to real).
I did it and opimized by myself, seems it really fastest conversions.
Conversion of image 800x600 takes about 24 msec on 300Mhz processor.
Cheers,
Igor.
// 1/3.5 matrix, used to avoid of DIV operator.
procedure XTAB; register;
asm
db $00,$00,$01,$01,$01,$01,$0
db $05,$05,$05,$05,$06,$06,$0
db $09,$09,$0A,$0A,$0A,$0B,$0
db $0E,$0E,$0E,$0F,$0F,$0F,$0
db $12,$13,$13,$13,$13,$14,$1
db $17,$17,$17,$18,$18,$18,$1
db $1B,$1C,$1C,$1C,$1D,$1D,$1
db $20,$20,$21,$21,$21,$21,$2
db $25,$25,$25,$25,$26,$26,$2
db $29,$29,$2A,$2A,$2A,$2B,$2
db $2E,$2E,$2E,$2F,$2F,$2F,$2
db $32,$33,$33,$33,$33,$34,$3
db $37,$37,$37,$38,$38,$38,$3
db $3B,$3C,$3C,$3C,$3D,$3D,$3
db $40,$40,$41,$41,$41,$41,$4
db $45,$45,$45,$45,$46,$46,$4
end;
procedure GrayScale565(Data: pointer; Size: Integer); register;
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab
@0:
lodsw
mov dx, ax
and ax, $007E0
shr ax, 5
and dl, $1F
shr dl, 1
add al, dl
shr dh, 3
add al, dh
xlat
xor ah, ah
mov dx, ax
shl dx, 6
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
end;
procedure GrayScale555(Data: pointer; Size: Integer); register;
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab
@0:
lodsw
mov dx, ax
and ax, $003E0
shr ax, 4
and dl, $1F
shr dl, 1
add al, dl
shr dh, 2
add al, dh
xlat
xor ah,ah
mov dx, ax
shl dx, 5
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
end;
procedure TForm1.SpeedButton1Click(S
var I: Integer;
begin
with Image1.Picture.Bitmap do
begin
for I := 0 to Height - 1 do
if PixelFormat = pf16bit then
GrayScale565(Scanline[I], Width)
else
GrayScale555(Scanline[I], Width);
end;
Image1.Repaint;
end;
Adlabac...
Im looking for all the answers... As soon I have all the possible answers I will give the points to the best solution to my problem...
Thanks
Manuel López (lopem)
Im looking for all the answers... As soon I have all the possible answers I will give the points to the best solution to my problem...
Thanks
Manuel López (lopem)
Itugay,
I tried your solution and didn't work. I used 256 colour bmp's images and I only got noise when the picture was processed... I changed the pixelformat definition to pf24bit, pf16bit, pf8bit and didn't work too... Any ideas?
best regards,
Manuel López (Lopem)
I tried your solution and didn't work. I used 256 colour bmp's images and I only got noise when the picture was processed... I changed the pixelformat definition to pf24bit, pf16bit, pf8bit and didn't work too... Any ideas?
best regards,
Manuel López (Lopem)
Both my examples work but my second one seems to work faster than the first...
Hi guys,
I've worked a bit and finally have a function ready, which converts 15bit, 16bit, 24bit and 32bit bitmaps to grayscale in quite high speed. Here are my test results, all from my PII-350:
32bit: 160ms
24bit: 140ms
16bit: 245ms (355ms for the non-asm variant)
15bit: not supported by my graphics card
For hicolor (15/16) I've taken Igor's optimized asm functions (quite good, Igor!) and made them even a bit faster: By only calling "ScanLine" twice instead of for every row I saved about 25ms in all tests.
Igor, your xtab table made not too much sense for me in that form. I saw from your sources that you calculate the index into the tab by "r + g*2 + b/2". So the max index is "31 + 31*2 + 31/2", which is 108. So the fields 109-255 of your array are useless. I changed your code slightly by using "r*2 + g*4 + b" as the index. Furthermore in 16bit I use all the 6 green bits. As a result my arrays are "31*2 + 31*4 + 31" long in 15bit, and "31*2 + 63*2 + 31" in 16bit. My changes make the grayscale images look slightly better.
Igor, perhaps you've fun to convert the 24+32bit functions to assembler, too? I've tried - but the results were slower than Delphi's code... :-) But I think a good asm programmer should be able to make at least the 32bit code faster.
unit ugrayscale;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$define useAsm}
{$Q-,R-}
var xtab32 : array [0..2*255 + 4*255 + 1*255] of byte;
xtab16 : array [0..2*031 + 2*063 + 1*031] of byte;
xtab15 : array [0..2*031 + 4*031 + 1*031] of byte;
xtab32Ready : boolean = false;
xtab16Ready : boolean = false;
xtab15Ready : boolean = false;
procedure GrayScaleLine32(line: PByteArray; width: integer);
var ix : integer;
gray : byte;
begin
for ix := 0 to width - 1 do begin
gray := xtab32[line[ix * 4] * 2 + line[ix * 4 + 1] * 4 + line[ix * 4 + 2]];
line[ix * 4 + 0] := gray;
line[ix * 4 + 1] := gray;
line[ix * 4 + 2] := gray;
end;
end;
procedure GrayScaleLine24(line: PByteArray; width: integer);
var ix : integer;
gray : byte;
begin
for ix := 0 to width - 1 do begin
gray := xtab32[line[ix * 3] * 2 + line[ix * 3 + 1] * 4 + line[ix * 3 + 2]];
line[ix * 3 + 0] := gray;
line[ix * 3 + 1] := gray;
line[ix * 3 + 2] := gray;
end;
end;
procedure GrayScaleLine16(line: PByteArray; width: integer);
{$ifndef useAsm}
var ix : integer;
gray : byte;
line2 : PWordArray absolute line;
pix : word;
begin
for ix := 0 to width - 1 do begin
pix := line2[ix];
gray := xtab16[(pix and $F800) shr 10 +
(pix and $07E0) shr 4 +
(pix and $001F) ];
line2[ix] := (gray shl 11) + (gray shl 6) + gray;
end;
{$else}
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab16
@0:
lodsw
mov dx, ax
and ax, $007E0
shr ax, 4
and dx, $F81F
add al, dl
shr dh, 2
add al, dh
xlat
xor ah, ah
mov dx, ax
shl dx, 6
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
{$endif}
end;
procedure GrayScaleLine15(line: PByteArray; width: integer);
{$ifndef useAsm}
var ix : integer;
gray : byte;
line2 : PWordArray absolute line;
pix : word;
begin
for ix := 0 to width - 1 do begin
pix := line2[ix];
gray := xtab16[(pix and $7C00) shr 9 +
(pix and $03E0) shr 3 +
(pix and $001F) ];
line2[ix] := (gray shl 10) + (gray shl 5) + gray;
end;
{$else}
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab15
@0:
lodsw
mov dx, ax
and ax, $003E0
shr ax, 3
and dx, $7C1F
add al, dl
shr dh, 1
add al, dh
xlat
xor ah, ah
mov dx, ax
shl dx, 5
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
{$endif}
end;
procedure GrayScale(bmp: TBitmap);
procedure PrepareXtab(var xtabReady: boolean; var xtab: array of byte; maxOutput: integer);
var fl : extended;
i1 : integer;
begin
fl := maxOutput / high(xtab);
for i1 := 0 to high(xtab) do
xtab[i1] := round(i1 * fl);
xtabReady := true;
end;
var iy, iw, ih : integer;
gsl : procedure (line: PByteArray; width: integer);
sl : pointer;
sld : integer;
begin
if not (bmp.PixelFormat in [pf15bit, pf16bit, pf24bit, pf32bit]) then
bmp.PixelFormat := pf32bit;
case bmp.PixelFormat of
pf32bit : begin
if not xtab32Ready then PrepareXtab(xtab32Ready, xtab32, 255);
gsl := GrayScaleLine32;
end;
pf24bit : begin
if not xtab32Ready then PrepareXtab(xtab32Ready, xtab32, 255);
gsl := GrayScaleLine24;
end;
pf16bit : begin
if not xtab16Ready then PrepareXtab(xtab16Ready, xtab16, 031);
gsl := GrayScaleLine16;
end;
pf15bit : begin
if not xtab15Ready then PrepareXtab(xtab15Ready, xtab15, 031);
gsl := GrayScaleLine15;
end;
else exit;
end;
with bmp do begin
iw := Width;
ih := Height;
if (iw > 0) and (ih > 0) then begin
sl := ScanLine[0];
if ih > 1 then
sld := integer(ScanLine[1]) - integer(sl)
else sld := 0;
for iy := 0 to Height - 1 do begin
gsl(sl, iw);
inc(integer(sl), sld);
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender
var i1 : integer;
time : dword;
begin
if not (Image1.Picture.Bitmap.Pix
Image1.Picture.Bitmap.Pixe
time := GetTickCount;
for i1 := 1 to 100 do
GrayScale(Image1.Picture.B
time := GetTickCount - time;
Form1.Caption := IntToStr(time);
end;
end.
I've worked a bit and finally have a function ready, which converts 15bit, 16bit, 24bit and 32bit bitmaps to grayscale in quite high speed. Here are my test results, all from my PII-350:
32bit: 160ms
24bit: 140ms
16bit: 245ms (355ms for the non-asm variant)
15bit: not supported by my graphics card
For hicolor (15/16) I've taken Igor's optimized asm functions (quite good, Igor!) and made them even a bit faster: By only calling "ScanLine" twice instead of for every row I saved about 25ms in all tests.
Igor, your xtab table made not too much sense for me in that form. I saw from your sources that you calculate the index into the tab by "r + g*2 + b/2". So the max index is "31 + 31*2 + 31/2", which is 108. So the fields 109-255 of your array are useless. I changed your code slightly by using "r*2 + g*4 + b" as the index. Furthermore in 16bit I use all the 6 green bits. As a result my arrays are "31*2 + 31*4 + 31" long in 15bit, and "31*2 + 63*2 + 31" in 16bit. My changes make the grayscale images look slightly better.
Igor, perhaps you've fun to convert the 24+32bit functions to assembler, too? I've tried - but the results were slower than Delphi's code... :-) But I think a good asm programmer should be able to make at least the 32bit code faster.
unit ugrayscale;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$define useAsm}
{$Q-,R-}
var xtab32 : array [0..2*255 + 4*255 + 1*255] of byte;
xtab16 : array [0..2*031 + 2*063 + 1*031] of byte;
xtab15 : array [0..2*031 + 4*031 + 1*031] of byte;
xtab32Ready : boolean = false;
xtab16Ready : boolean = false;
xtab15Ready : boolean = false;
procedure GrayScaleLine32(line: PByteArray; width: integer);
var ix : integer;
gray : byte;
begin
for ix := 0 to width - 1 do begin
gray := xtab32[line[ix * 4] * 2 + line[ix * 4 + 1] * 4 + line[ix * 4 + 2]];
line[ix * 4 + 0] := gray;
line[ix * 4 + 1] := gray;
line[ix * 4 + 2] := gray;
end;
end;
procedure GrayScaleLine24(line: PByteArray; width: integer);
var ix : integer;
gray : byte;
begin
for ix := 0 to width - 1 do begin
gray := xtab32[line[ix * 3] * 2 + line[ix * 3 + 1] * 4 + line[ix * 3 + 2]];
line[ix * 3 + 0] := gray;
line[ix * 3 + 1] := gray;
line[ix * 3 + 2] := gray;
end;
end;
procedure GrayScaleLine16(line: PByteArray; width: integer);
{$ifndef useAsm}
var ix : integer;
gray : byte;
line2 : PWordArray absolute line;
pix : word;
begin
for ix := 0 to width - 1 do begin
pix := line2[ix];
gray := xtab16[(pix and $F800) shr 10 +
(pix and $07E0) shr 4 +
(pix and $001F) ];
line2[ix] := (gray shl 11) + (gray shl 6) + gray;
end;
{$else}
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab16
@0:
lodsw
mov dx, ax
and ax, $007E0
shr ax, 4
and dx, $F81F
add al, dl
shr dh, 2
add al, dh
xlat
xor ah, ah
mov dx, ax
shl dx, 6
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
{$endif}
end;
procedure GrayScaleLine15(line: PByteArray; width: integer);
{$ifndef useAsm}
var ix : integer;
gray : byte;
line2 : PWordArray absolute line;
pix : word;
begin
for ix := 0 to width - 1 do begin
pix := line2[ix];
gray := xtab16[(pix and $7C00) shr 9 +
(pix and $03E0) shr 3 +
(pix and $001F) ];
line2[ix] := (gray shl 10) + (gray shl 5) + gray;
end;
{$else}
asm
pushad
mov esi, eax
mov edi, eax
mov ecx, edx
lea ebx, xtab15
@0:
lodsw
mov dx, ax
and ax, $003E0
shr ax, 3
and dx, $7C1F
add al, dl
shr dh, 1
add al, dh
xlat
xor ah, ah
mov dx, ax
shl dx, 5
or ax, dx
shl dx, 5
or ax, dx
stosw
loop @0
popad
{$endif}
end;
procedure GrayScale(bmp: TBitmap);
procedure PrepareXtab(var xtabReady: boolean; var xtab: array of byte; maxOutput: integer);
var fl : extended;
i1 : integer;
begin
fl := maxOutput / high(xtab);
for i1 := 0 to high(xtab) do
xtab[i1] := round(i1 * fl);
xtabReady := true;
end;
var iy, iw, ih : integer;
gsl : procedure (line: PByteArray; width: integer);
sl : pointer;
sld : integer;
begin
if not (bmp.PixelFormat in [pf15bit, pf16bit, pf24bit, pf32bit]) then
bmp.PixelFormat := pf32bit;
case bmp.PixelFormat of
pf32bit : begin
if not xtab32Ready then PrepareXtab(xtab32Ready, xtab32, 255);
gsl := GrayScaleLine32;
end;
pf24bit : begin
if not xtab32Ready then PrepareXtab(xtab32Ready, xtab32, 255);
gsl := GrayScaleLine24;
end;
pf16bit : begin
if not xtab16Ready then PrepareXtab(xtab16Ready, xtab16, 031);
gsl := GrayScaleLine16;
end;
pf15bit : begin
if not xtab15Ready then PrepareXtab(xtab15Ready, xtab15, 031);
gsl := GrayScaleLine15;
end;
else exit;
end;
with bmp do begin
iw := Width;
ih := Height;
if (iw > 0) and (ih > 0) then begin
sl := ScanLine[0];
if ih > 1 then
sld := integer(ScanLine[1]) - integer(sl)
else sld := 0;
for iy := 0 to Height - 1 do begin
gsl(sl, iw);
inc(integer(sl), sld);
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender
var i1 : integer;
time : dword;
begin
if not (Image1.Picture.Bitmap.Pix
Image1.Picture.Bitmap.Pixe
time := GetTickCount;
for i1 := 1 to 100 do
GrayScale(Image1.Picture.B
time := GetTickCount - time;
Form1.Caption := IntToStr(time);
end;
end.
Hi alanwhincup, BTW, your code needed about 695ms on my PC compared to 140ms of my 24bit code. The biggest speed boost came from using Igor's great idea of avoiding the DIV.
P.S: Of course I measured your second example... :-)
Madshi!
Thanks a lot! I think Igor deserves also some points but unfortunately there is no way to share expert points... :(
Amazing performance of your code Madshi
best regards,
Manuel López (lopem)
Thanks a lot! I think Igor deserves also some points but unfortunately there is no way to share expert points... :(
Amazing performance of your code Madshi
best regards,
Manuel López (lopem)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
trying again! :)
thanks
Manuel Lopez (lopem)
thanks
Manuel Lopez (lopem)
Hi Manuel,
Hi Madshi,
look at the question
https://www.experts-exchange.com/jsp/qShow.jsp?qid=20076000
for 24 bit assembler code.
Cheers,
Igor.
Hi Madshi,
look at the question
https://www.experts-exchange.com/jsp/qShow.jsp?qid=20076000
for 24 bit assembler code.
Cheers,
Igor.
Strange enough Igor had the same problems I've had. All my asm tries were slower than what Delphi's compiler did out of my pure Delphi code. Igor's asm code needs 350ms, while the pure Delphi code from my answer only needs 140ms in the same situation. Delphi's compiler seems to do a great job with optimizing the 24bit Delphi code... :-)
Just a thought on the 24 bit asm code. What if it was rewriten (the table as well) so you used only 32bit registers & 32 bit mem accesses?
GL
Mike
GL
Mike
The problem is that in order to calculate the grayscale, you need to access the single bytes, because each byte represents one color component. So you can't really use pure 32bit logic. Well, maybe with MMX/SSE/3DNow and such stuff you could make that thing light speed fast, but I've no knowledge about MMX/SSE/3DNow.
Hi all,
here is it. It works faster then Delphi did :-)
procedure GrayScaleLine24(Data: pointer; Size: Integer); register;
asm
pushad
mov edi, eax
mov ecx, edx
lea ebx, xtab32
nop //!!!!!!!!!!!!! see comments bellow !!!!!!!!!!
@0:
xor eax, eax
mov al, [edi]
add eax, eax
xor edx, edx
mov dl, [edi+2]
add eax, edx
mov dl, [edi+1]
shl edx, 2
add eax, edx
mov al, [eax+ebx]
mov [edi],al
mov [edi+1],al
mov [edi+2],al
add edi,3
dec ecx
jnz @0
// loop @0 // !!!!!!!!!! another strange thing !!!!!!!!!!!!
popad
end;
Incredible things! After making some tests I noticed that this procedure with uncommented "nop" works about 10% faster (16.3 msec with "nop", and 18.8 msec without). Seems it happen regarding alignment of code to some bounds. Also changing "loop" to "dec-jnz" make procedure faster too! ("loop" - 22.7 msec, "dec-jnz" 16.3 msec). It is exactly opposite that I remembered from the time when I was a student :-)
Madshi, what about some points for explanation of those effects?
Cheers,
Igor.
PS: seems we should avoid "lods" and "stos" operators too :-(
here is it. It works faster then Delphi did :-)
procedure GrayScaleLine24(Data: pointer; Size: Integer); register;
asm
pushad
mov edi, eax
mov ecx, edx
lea ebx, xtab32
nop //!!!!!!!!!!!!! see comments bellow !!!!!!!!!!
@0:
xor eax, eax
mov al, [edi]
add eax, eax
xor edx, edx
mov dl, [edi+2]
add eax, edx
mov dl, [edi+1]
shl edx, 2
add eax, edx
mov al, [eax+ebx]
mov [edi],al
mov [edi+1],al
mov [edi+2],al
add edi,3
dec ecx
jnz @0
// loop @0 // !!!!!!!!!! another strange thing !!!!!!!!!!!!
popad
end;
Incredible things! After making some tests I noticed that this procedure with uncommented "nop" works about 10% faster (16.3 msec with "nop", and 18.8 msec without). Seems it happen regarding alignment of code to some bounds. Also changing "loop" to "dec-jnz" make procedure faster too! ("loop" - 22.7 msec, "dec-jnz" 16.3 msec). It is exactly opposite that I remembered from the time when I was a student :-)
Madshi, what about some points for explanation of those effects?
Cheers,
Igor.
PS: seems we should avoid "lods" and "stos" operators too :-(
trying to accept the answer again
Hi Igor!
Thanx for the new asm version... :-)
When changing "shl edx, 2" to "shl dx, 2" in your new code, it seems to be even a bit faster (120ms, before 130ms). Strange. Changing "shl eax, 1" to "shl ax, 1" makes it slower...
Regards, Madshi.
Thanx for the new asm version... :-)
When changing "shl edx, 2" to "shl dx, 2" in your new code, it seems to be even a bit faster (120ms, before 130ms). Strange. Changing "shl eax, 1" to "shl ax, 1" makes it slower...
Regards, Madshi.
I wonder, too, about this part:
mov al, [eax+ebx]
mov [edi],al
mov [edi+1],al
mov [edi+2],al
add edi,3
perhaps if the table XTab32 contained int's, instead of groups of (3) bytes you could fill eax with 4xal & mov once?
GL
Mike
mov al, [eax+ebx]
mov [edi],al
mov [edi+1],al
mov [edi+2],al
add edi,3
perhaps if the table XTab32 contained int's, instead of groups of (3) bytes you could fill eax with 4xal & mov once?
GL
Mike
Hey Mike - good idea! I'll give it a try... :-)
In 32bit it brings a lot, so it will most probably in 16bit. But in 24bit it's slower, because there 3 bytes must be moved. But I've found another optimization possibility by using "movsz" instead of "xor + mov". I'll post my results later, want to do some 16bit optimization tomorrow...
Here comes my new code. It's gotten faster a lot - thanx to Mike for his idea! The xtables now don't contain only a gray byte, they now contain the whole gray dword (32/24) or word (16/15). That gives a huge performance boost in 32/16/15 modes. Unfortunately it doesn't bring much in 24.
Furthermore the new code supports not only 100% grayscaling, but it also supports 75% and 50% grayscaling. The speed there is also very high, but 100% is the fastest mode.
Here are my benchmarks, the first column are the old values:
240x180 bitmap, 100x grayed, PII-350:
32bit: 160ms -> 100ms (75%: 130ms; 50%: 125ms)
24bit: 140ms -> 120ms (75%: 165ms; 50%: 155ms)
16bit: 245ms -> 100ms (75%: 130ms; 50%: 140ms)
15bit: ? -> 100ms (75%: 130ms; 50%: 170ms)
As you can see the new code is MUCH faster. Especially the 16+15bit code is more than twice as fast than before. The 32bit code is also more than 60% faster than it was before.
Enjoy! :-)
Regards, Madshi.
{$Q-,R-}
type
TGrayPercent = (gp100, gp75, gp50);
TXtab32 = array [0..2*255 + 4*255 + 1*255] of integer;
TXtab16 = array [0..2*031 + 2*063 + 1*031] of word;
TXtab15 = array [0..2*031 + 4*031 + 1*031] of word;
var
xtab32 : array [TGrayPercent] of TXtab32;
xtab16 : array [TGrayPercent] of TXtab16;
xtab15 : array [TGrayPercent] of TXtab15;
xtab32Ready : array [TGrayPercent] of boolean = (false, false, false);
xtab16Ready : array [TGrayPercent] of boolean = (false, false, false);
xtab15Ready : array [TGrayPercent] of boolean = (false, false, false);
procedure GrayScale(bmp: TBitmap; percent: TGrayPercent = gp100);
procedure GrayScaleLine15_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
shl ebx, 1
add ebx, eax
@0:
movzx eax, word[edi]
mov edx, eax
and eax, $000003E0
shr eax, 3
and edx, $0000001F
add eax, edx
movzx edx, word[edi]
shr edx, 9
and edx, $FE
add eax, edx
mov ax, [eax*2+ecx]
mov [edi], ax
add edi, 2
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine15_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 2
and ebx, $1CE7
and edx, $0000001F
and eax, $000003E0
shr eax, 3
add edx, eax
movzx eax, word[edi]
shr eax, 9
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine15_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 1
and ebx, $3DEF
and edx, $0000001F
and eax, $000003E0
shr eax, 3
add edx, eax
movzx eax, word[edi]
shr eax, 9
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine16_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
shl ebx, 1
add ebx, eax
@0:
movzx eax, word[edi]
mov edx, eax
and eax, $000007E0
shr eax, 4
and edx, $0000001F
add eax, edx
movzx edx, word[edi]
shr edx, 10
and edx, $FE
add eax, edx
mov ax, [eax*2+ecx]
mov [edi], ax
add edi, 2
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine16_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 2
and ebx, $39E7
and edx, $0000001F
and eax, $000007E0
shr eax, 4
add edx, eax
movzx eax, word[edi]
shr eax, 10
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine16_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 1
and ebx, $7BEF
and edx, $0000001F
and eax, $000007E0
shr eax, 4
add edx, eax
movzx eax, word[edi]
shr eax, 10
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine24_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
add ebx, edx
add ebx, edx
add ebx, eax
@0:
movzx edx, byte[edi+2]
movzx eax, byte[edi+1]
shl eax, 2
add edx, eax
movzx eax, byte[edi]
add edx, eax
add edx, eax
mov edx, [edx*4+ecx]
mov [edi], dl
mov [edi+1], dl
mov [edi+2], dl
add edi, 3
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine24_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
add esi, edx
add esi, edx
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 2
and ebx, $003F3F3F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], bl
shr ebx, 8
mov [edi+1], bl
mov [edi+2], bh
add edi, 3
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine24_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
add esi, edx
add esi, edx
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 1
and ebx, $007F7F7F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], bl
shr ebx, 8
mov [edi+1], bl
mov [edi+2], bh
add edi, 3
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine32_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
shl ebx, 2
add ebx, eax
@0:
movzx eax, byte[edi+2]
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
mov eax, [eax*4+ecx]
mov [edi], eax
add edi, 4
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine32_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 2
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 2
and ebx, $003F3F3F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], ebx
add edi, 4
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine32_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 2
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 1
and ebx, $007F7F7F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], ebx
add edi, 4
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure CheckXTab32(gp: TGrayPercent);
var i1 : integer;
gray : integer;
begin
if not xtab32Ready[gp] then begin
for i1 := 0 to high(xtab32[gp]) do begin
gray := round(i1 / 7);
case gp of
gp50 : gray := gray div 2;
gp75 : gray := gray - gray div 4;
end;
xtab32[gp][i1] := gray shl 16 + gray shl 8 + gray;
end;
xtab32Ready[gp] := true;
end;
end;
procedure CheckXTab16(gp: TGrayPercent);
var i1 : integer;
gray : integer;
begin
if not xtab16Ready[gp] then begin
for i1 := 0 to high(xtab16[gp]) do begin
gray := round(i1 * 31 / high(xtab16[gp]));
case gp of
gp50 : gray := gray div 2;
gp75 : gray := gray - gray div 4;
end;
xtab16[gp][i1] := gray shl 11 + gray shl 6 + gray;
end;
xtab16Ready[gp] := true;
end;
end;
procedure CheckXTab15(gp: TGrayPercent);
var i1 : integer;
gray : integer;
begin
if not xtab15Ready[gp] then begin
for i1 := 0 to high(xtab15[gp]) do begin
gray := round(i1 * 31 / high(xtab15[gp]));
case gp of
gp50 : gray := gray div 2;
gp75 : gray := gray - gray div 4;
end;
xtab15[gp][i1] := gray shl 10 + gray shl 5 + gray;
end;
xtab15Ready[gp] := true;
end;
end;
var iy, iw, ih : integer;
line : PByteArray;
lineDif : integer;
casei : integer;
begin
with bmp do begin
iw := Width;
ih := Height;
if (iw > 0) and (ih > 0) then begin
if PixelFormat < pf15bit then PixelFormat := pf32bit;
case PixelFormat of
pf15bit : begin casei := $150; CheckXTab15(percent) end;
pf16bit : begin casei := $160; CheckXTab16(percent) end;
pf24bit : begin casei := $240; CheckXTab32(percent) end;
pf32bit : begin casei := $320; CheckXtab32(percent) end;
else exit;
end;
inc(casei, ord(percent));
line := ScanLine[0];
if ih > 1 then lineDif := integer(ScanLine[1]) - integer(line)
else lineDif := 0;
for iy := 0 to Height - 1 do begin
case casei of
$150 : GrayScaleLine15_100(line, iw, xtab15[gp100]);
$151 : GrayScaleLine15_75 (line, iw, xtab15[gp75 ]);
$152 : GrayScaleLine15_50 (line, iw, xtab15[gp50 ]);
$160 : GrayScaleLine16_100(line, iw, xtab16[gp100]);
$161 : GrayScaleLine16_75 (line, iw, xtab16[gp75 ]);
$162 : GrayScaleLine16_50 (line, iw, xtab16[gp50 ]);
$240 : GrayScaleLine24_100(line, iw, xtab32[gp100]);
$241 : GrayScaleLine24_75 (line, iw, xtab32[gp75 ]);
$242 : GrayScaleLine24_50 (line, iw, xtab32[gp50 ]);
$320 : GrayScaleLine32_100(line, iw, xtab32[gp100]);
$321 : GrayScaleLine32_75 (line, iw, xtab32[gp75 ]);
$322 : GrayScaleLine32_50 (line, iw, xtab32[gp50 ]);
end;
inc(integer(line), lineDif);
end;
end;
end;
end;
Furthermore the new code supports not only 100% grayscaling, but it also supports 75% and 50% grayscaling. The speed there is also very high, but 100% is the fastest mode.
Here are my benchmarks, the first column are the old values:
240x180 bitmap, 100x grayed, PII-350:
32bit: 160ms -> 100ms (75%: 130ms; 50%: 125ms)
24bit: 140ms -> 120ms (75%: 165ms; 50%: 155ms)
16bit: 245ms -> 100ms (75%: 130ms; 50%: 140ms)
15bit: ? -> 100ms (75%: 130ms; 50%: 170ms)
As you can see the new code is MUCH faster. Especially the 16+15bit code is more than twice as fast than before. The 32bit code is also more than 60% faster than it was before.
Enjoy! :-)
Regards, Madshi.
{$Q-,R-}
type
TGrayPercent = (gp100, gp75, gp50);
TXtab32 = array [0..2*255 + 4*255 + 1*255] of integer;
TXtab16 = array [0..2*031 + 2*063 + 1*031] of word;
TXtab15 = array [0..2*031 + 4*031 + 1*031] of word;
var
xtab32 : array [TGrayPercent] of TXtab32;
xtab16 : array [TGrayPercent] of TXtab16;
xtab15 : array [TGrayPercent] of TXtab15;
xtab32Ready : array [TGrayPercent] of boolean = (false, false, false);
xtab16Ready : array [TGrayPercent] of boolean = (false, false, false);
xtab15Ready : array [TGrayPercent] of boolean = (false, false, false);
procedure GrayScale(bmp: TBitmap; percent: TGrayPercent = gp100);
procedure GrayScaleLine15_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
shl ebx, 1
add ebx, eax
@0:
movzx eax, word[edi]
mov edx, eax
and eax, $000003E0
shr eax, 3
and edx, $0000001F
add eax, edx
movzx edx, word[edi]
shr edx, 9
and edx, $FE
add eax, edx
mov ax, [eax*2+ecx]
mov [edi], ax
add edi, 2
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine15_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 2
and ebx, $1CE7
and edx, $0000001F
and eax, $000003E0
shr eax, 3
add edx, eax
movzx eax, word[edi]
shr eax, 9
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine15_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 1
and ebx, $3DEF
and edx, $0000001F
and eax, $000003E0
shr eax, 3
add edx, eax
movzx eax, word[edi]
shr eax, 9
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine16_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
shl ebx, 1
add ebx, eax
@0:
movzx eax, word[edi]
mov edx, eax
and eax, $000007E0
shr eax, 4
and edx, $0000001F
add eax, edx
movzx edx, word[edi]
shr edx, 10
and edx, $FE
add eax, edx
mov ax, [eax*2+ecx]
mov [edi], ax
add edi, 2
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine16_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 2
and ebx, $39E7
and edx, $0000001F
and eax, $000007E0
shr eax, 4
add edx, eax
movzx eax, word[edi]
shr eax, 10
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine16_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 1
add esi, eax
@0:
movzx eax, word[edi]
mov edx, eax
mov ebx, eax
shr ebx, 1
and ebx, $7BEF
and edx, $0000001F
and eax, $000007E0
shr eax, 4
add edx, eax
movzx eax, word[edi]
shr eax, 10
and edx, $FE
add edx, eax
add bx, [edx*2+ecx]
mov [edi], bx
add edi, 2
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine24_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
add ebx, edx
add ebx, edx
add ebx, eax
@0:
movzx edx, byte[edi+2]
movzx eax, byte[edi+1]
shl eax, 2
add edx, eax
movzx eax, byte[edi]
add edx, eax
add edx, eax
mov edx, [edx*4+ecx]
mov [edi], dl
mov [edi+1], dl
mov [edi+2], dl
add edi, 3
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine24_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
add esi, edx
add esi, edx
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 2
and ebx, $003F3F3F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], bl
shr ebx, 8
mov [edi+1], bl
mov [edi+2], bh
add edi, 3
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine24_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
add esi, edx
add esi, edx
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 1
and ebx, $007F7F7F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], bl
shr ebx, 8
mov [edi+1], bl
mov [edi+2], bh
add edi, 3
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine32_100(line: pointer; width: integer; var xtab);
asm
push edi
push ebx
mov edi, eax
mov ebx, edx
shl ebx, 2
add ebx, eax
@0:
movzx eax, byte[edi+2]
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
mov eax, [eax*4+ecx]
mov [edi], eax
add edi, 4
cmp ebx, edi
jnz @0
pop ebx
pop edi
end;
procedure GrayScaleLine32_75(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 2
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 2
and ebx, $003F3F3F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], ebx
add edi, 4
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure GrayScaleLine32_50(line: pointer; width: integer; var xtab);
asm
push edi
push esi
push ebx
mov edi, eax
mov esi, edx
shl esi, 2
add esi, eax
@0:
movzx eax, byte[edi+2]
mov ebx, [edi]
shr ebx, 1
and ebx, $007F7F7F
movzx edx, byte[edi+1]
shl edx, 2
add eax, edx
movzx edx, byte[edi]
add eax, edx
add eax, edx
add ebx, [eax*4+ecx]
mov [edi], ebx
add edi, 4
cmp esi, edi
jnz @0
pop ebx
pop esi
pop edi
end;
procedure CheckXTab32(gp: TGrayPercent);
var i1 : integer;
gray : integer;
begin
if not xtab32Ready[gp] then begin
for i1 := 0 to high(xtab32[gp]) do begin
gray := round(i1 / 7);
case gp of
gp50 : gray := gray div 2;
gp75 : gray := gray - gray div 4;
end;
xtab32[gp][i1] := gray shl 16 + gray shl 8 + gray;
end;
xtab32Ready[gp] := true;
end;
end;
procedure CheckXTab16(gp: TGrayPercent);
var i1 : integer;
gray : integer;
begin
if not xtab16Ready[gp] then begin
for i1 := 0 to high(xtab16[gp]) do begin
gray := round(i1 * 31 / high(xtab16[gp]));
case gp of
gp50 : gray := gray div 2;
gp75 : gray := gray - gray div 4;
end;
xtab16[gp][i1] := gray shl 11 + gray shl 6 + gray;
end;
xtab16Ready[gp] := true;
end;
end;
procedure CheckXTab15(gp: TGrayPercent);
var i1 : integer;
gray : integer;
begin
if not xtab15Ready[gp] then begin
for i1 := 0 to high(xtab15[gp]) do begin
gray := round(i1 * 31 / high(xtab15[gp]));
case gp of
gp50 : gray := gray div 2;
gp75 : gray := gray - gray div 4;
end;
xtab15[gp][i1] := gray shl 10 + gray shl 5 + gray;
end;
xtab15Ready[gp] := true;
end;
end;
var iy, iw, ih : integer;
line : PByteArray;
lineDif : integer;
casei : integer;
begin
with bmp do begin
iw := Width;
ih := Height;
if (iw > 0) and (ih > 0) then begin
if PixelFormat < pf15bit then PixelFormat := pf32bit;
case PixelFormat of
pf15bit : begin casei := $150; CheckXTab15(percent) end;
pf16bit : begin casei := $160; CheckXTab16(percent) end;
pf24bit : begin casei := $240; CheckXTab32(percent) end;
pf32bit : begin casei := $320; CheckXtab32(percent) end;
else exit;
end;
inc(casei, ord(percent));
line := ScanLine[0];
if ih > 1 then lineDif := integer(ScanLine[1]) - integer(line)
else lineDif := 0;
for iy := 0 to Height - 1 do begin
case casei of
$150 : GrayScaleLine15_100(line, iw, xtab15[gp100]);
$151 : GrayScaleLine15_75 (line, iw, xtab15[gp75 ]);
$152 : GrayScaleLine15_50 (line, iw, xtab15[gp50 ]);
$160 : GrayScaleLine16_100(line, iw, xtab16[gp100]);
$161 : GrayScaleLine16_75 (line, iw, xtab16[gp75 ]);
$162 : GrayScaleLine16_50 (line, iw, xtab16[gp50 ]);
$240 : GrayScaleLine24_100(line, iw, xtab32[gp100]);
$241 : GrayScaleLine24_75 (line, iw, xtab32[gp75 ]);
$242 : GrayScaleLine24_50 (line, iw, xtab32[gp50 ]);
$320 : GrayScaleLine32_100(line, iw, xtab32[gp100]);
$321 : GrayScaleLine32_75 (line, iw, xtab32[gp75 ]);
$322 : GrayScaleLine32_50 (line, iw, xtab32[gp50 ]);
end;
inc(integer(line), lineDif);
end;
end;
end;
end;
Hi Madshi,
now seems it works perfect.
Just one hint. You can call grayscaling procedure only once for all bitmap instead of calling it for every scanline. Scanlines in bitmap is upsidedown, so, send as parameter addres of last scanline in bitmap and size = width*height. May be it increased perfomance again :-)
-------
P := ABitmap.ScanLine[ABitmap.H
N := ABitmap.Width * ABitmap.Height;
case ABitmap.PixelFormat of
pf24bit: GrayScale24(P, N, T);
--------
Cheers,
Igor.
now seems it works perfect.
Just one hint. You can call grayscaling procedure only once for all bitmap instead of calling it for every scanline. Scanlines in bitmap is upsidedown, so, send as parameter addres of last scanline in bitmap and size = width*height. May be it increased perfomance again :-)
-------
P := ABitmap.ScanLine[ABitmap.H
N := ABitmap.Width * ABitmap.Height;
case ABitmap.PixelFormat of
pf24bit: GrayScale24(P, N, T);
--------
Cheers,
Igor.
Hi Igor,
please read here:
http://www.efg2.com/lab/ImageProcessing/Scanline.htm#Optimization
"DIBs can be oriented as "top-down", where the first row of pixels in the bitmap reside in the first bytes of memory in the buffer, or as "bottom-up", where the first row of pixels reside in the last bytes of memory and grow upward in memory."
That means, to go the secure way I should call Scanline twice and calculate the difference. But doesn't matter much, I could call:
GrayScale24(P, N, T, ScanLineDif);
However, I'm not sure whether this will bring so much more performance, perhaps I'll try that later. But for today I'm really tired of graying... :-)
please read here:
http://www.efg2.com/lab/ImageProcessing/Scanline.htm#Optimization
"DIBs can be oriented as "top-down", where the first row of pixels in the bitmap reside in the first bytes of memory in the buffer, or as "bottom-up", where the first row of pixels reside in the last bytes of memory and grow upward in memory."
That means, to go the secure way I should call Scanline twice and calculate the difference. But doesn't matter much, I could call:
GrayScale24(P, N, T, ScanLineDif);
However, I'm not sure whether this will bring so much more performance, perhaps I'll try that later. But for today I'm really tired of graying... :-)
Thanx Madshi,
I didn't know about "top-down" orientation. It's strange that I never met "access violation" regarding "top-down" before. Also thanx for some points :-)
Is that button will be available on your site?
------
Igor.
I didn't know about "top-down" orientation. It's strange that I never met "access violation" regarding "top-down" before. Also thanx for some points :-)
Is that button will be available on your site?
------
Igor.
Or you could, instead of overwriting the source bmp, create a dib. That way you can write directly the the bits in a flat array.
GL
Mike
GL
Mike
Hi Igor.
>> Is that button will be available on your site?
Not yet. Perhaps somewhen in the future. I've no plans for that right now, though. I must clean up a lot of things in the button component before I can publish it. But then it will be a quite good one, I think... :-)
Hi Mike.
>> Or you could, instead of overwriting the source bmp, create a dib. That way you can write directly the the bits in a flat array.
Is that not what Scanline encapsulates? I mean it uses GetDIBits/SetDIBBits...
Regards, Madshi.
>> Is that button will be available on your site?
Not yet. Perhaps somewhen in the future. I've no plans for that right now, though. I must clean up a lot of things in the button component before I can publish it. But then it will be a quite good one, I think... :-)
Hi Mike.
>> Or you could, instead of overwriting the source bmp, create a dib. That way you can write directly the the bits in a flat array.
Is that not what Scanline encapsulates? I mean it uses GetDIBits/SetDIBBits...
Regards, Madshi.
Yeah, I'm just suggesting calling it once and getting all the data. It's my impression that the current scanline arrangment isn't "cast in stone", ie: you can't rely on windows/delphi to "stack" the scanlines or to align them the way they are now. OTOH I would presume that scanline's will prob. make it into Kylix, but get/set DIBits prob. won't.
GL
Mike
GL
Mike
http://www.efg2.com/lab/
http://jansfreeware.com/janfx.zip
I don't know how much the stuff is, though...
Regards, Madshi.