procedure ParseBg(var bmp: TBitmap);
var
x, y, i, j, sx, sy: integer;
r1,g1,b1,r,g,b: Byte;
screenb:TBitmap;
begin
screenb := TBitmap.Create;
screenb.Width := bmp.Width;
screenb.Height := bmp.Height;
sx:=(screen.Width-bmp.Width)div 2;
sy:=(screen.Height-bmp.Height)div 2;
BitBlt(screenb.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, GetDC(0), sx, sy, SRCCOPY);
for x:=0 to bmp.Width-1 do
for y:=0 to bmp.Height-1 do begin
i:=bmp.Canvas.Pixels[x,y];
if i=$FFFFFF then continue;
r:=GetRValue(i);
g:=GetGValue(i);
b:=GetBValue(i);
if (r=g)and(g=b) then begin
j:=screenb.Canvas.Pixels[x,y];
r1:=GetRValue(j)*r shr 8;
g1:=GetGValue(j)*g shr 8;
b1:=GetBValue(j)*b shr 8;
i:=RGB(r1,g1,b1);
bmp.Canvas.Pixels[x,y]:=i;
end;
end;
screenb.Free;
end;
procedure TfSplash.FormCreate(Sender: TObject);
var
b: TBitmap;
begin
b:=TBitmap.Create;
b.Assign(Image1.Picture.Graphic);
ParseBg(b);
Image1.Picture.Assign(b);
b.Free;
end;
Совместив два исходника + свои доработки, получил "прозрачные" тени. Работает хорошо, делает всё как надо... но медленно. Подскажите пути оптимизации.