this slowpoke moves

Bitmap Image with Shadow

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

Beliebte Posts

Translate