procedure Shadow(Bmp: TBitmap; Radius: Single);
type
TRGB = packed record b, g, r: Byte end;
TRGBs = packed record b, g, r: Single end;
TRGBArray = array[0..0] of TRGB;
var
MatrixRadius: Byte;
Matrix: array[-100..100] of Single;
procedure CalculateMatrix;
var
x: Integer; Divisor: Single;
begin
radius := radius + 1; // der mittel/nullpunkt muss mitgerechnet werden
MatrixRadius := Trunc(radius);
if Frac(radius) = 0 then Dec(MatrixRadius);
Divisor := 0;
for x := -MatrixRadius to MatrixRadius do begin
Matrix[x] := radius - abs(x);
Divisor := Divisor + Matrix[x];
end;
for x := -MatrixRadius to MatrixRadius do
Matrix[x] := Matrix[x] / Divisor;
end;
var
BmpSL: ^TRGBArray;
BmpRGB: ^TRGB;
BmpCopy: array of array of TRGBs;
BmpCopyRGB: ^TRGBs;
R, G, B: Single;
BmpWidth, BmpHeight: Integer;
x, y, mx: Integer;
begin
Bmp.PixelFormat := pf24bit;
if radius <= 0 then radius := 1 else if radius > 99 then
radius := 99; // radius bereich 0 < radius < 99
CalculateMatrix;
BmpWidth := Bmp.Width;
BmpHeight := Bmp.Height;
SetLength(BmpCopy, BmpHeight, BmpWidth);
// Alle Bildpunkte ins BmpCopy-Array schreiben und gleichzeitig HORIZONTAL blurren
for y := 0 to Pred(BmpHeight) do begin
BmpSL := Bmp.Scanline[y];
BmpCopyRGB := @BmpCopy[y, 0];
for x := 0 to Pred(BmpWidth) do begin
R := 0; G := 0; B := 0;
for Mx := -MatrixRadius to MatrixRadius do begin
if x + mx < 0 then
BmpRGB := @BmpSL^[0] // erster Pixel
else if x + mx >= BmpWidth then
{$R-}
BmpRGB := @BmpSL^[Pred(BmpWidth)] // letzter Pixel
{$R+}
else
{$R-}
BmpRGB := @BmpSL^[x + mx];
{$R+}
B := B + BmpRGB^.b * Matrix[mx];
G := G + BmpRGB^.g * Matrix[mx];
R := R + BmpRGB^.r * Matrix[mx];
end;
BmpCopyRGB^.b := B; // Farbwerte werden im Typ Single zwischengespeichert !
BmpCopyRGB^.g := G;
BmpCopyRGB^.r := R;
Inc(BmpCopyRGB);
end;
end;
// Alle Bildpunkte zurück ins Bmp-Bitmap schreiben und gleichzeitig VERTIKAL blurren
for y := 0 to Pred(BmpHeight) do begin
BmpRGB := Bmp.ScanLine[y];
for x := 0 to Pred(BmpWidth) do begin
R := 0; G := 0; B := 0;
for mx := -MatrixRadius to MatrixRadius do begin
if y + mx <= 0 then
BmpCopyRGB := @BmpCopy[0, x] // erster Pixel
else if y + mx >= BmpHeight then
BmpCopyRGB := @BmpCopy[Pred(BmpHeight), x] // letzter Pixel
else
BmpCopyRGB := @BmpCopy[y + mx, x];
B := B + BmpCopyRGB^.b * Matrix[mx];
G := G + BmpCopyRGB^.g * Matrix[mx];
R := R + BmpCopyRGB^.r * Matrix[mx];
end;
BmpRGB^.b := Round(B);
BmpRGB^.g := Round(G);
BmpRGB^.r := Round(R);
Inc(BmpRGB);
end;
end;
end;
Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
var
bmp: TBitmap;
r: TRect;
begin
bmp := TBitmap.Create;
try
bmp.Width := Image1.Picture.Width + 20;
bmp.Height := Image1.Picture.Height + 20;
//Untergrund
bmp.Canvas.Brush.Color := Self.Color; // FARBE DES SCHATTEN
bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
// Schatten
r := RECT(5, 5, // SCHATTEN VERSCHIEBUNG
Image1.Picture.Width, Image1.Picture.Height);
bmp.Canvas.Brush.Color := clBlack;
OffsetRect(r,
10, // VERTIKAL SCHATTEN
10); // HORIZONTAL SCHATTEN
bmp.Canvas.FillRect(r);
Shadow(bmp, 5.5); // SCHATTEN DICHTE
bmp.Canvas.Draw(5, 5, Image1.Picture.Graphic);
Image1.Picture.Assign(bmp);
finally
bmp.free;
end;
end;
Keine Kommentare:
Kommentar veröffentlichen