this slowpoke moves

Calculate Emboss to Bitmap

procedure Emboss(ABitmap : TBitmap; AMount : Integer);
var
  x1, y1, i : integer;
  p1, p2: PByteArray;
begin
  for i := 0 to AMount do
  begin
    for y1 := 0 to ABitmap.Height-2 do
    begin
      p1 := ABitmap.ScanLine[y1];
      p2 := ABitmap.ScanLine[y1+1];
      for x1 := 0 to ABitmap.Width do
      begin
        p1[x1*3]   := (p1[x1*3]+(p2[(x1+3)*3]     xor $FF)) shr 1;
        p1[x1*3+1] := (p1[x1*3+1]+(p2[(x1+3)*3+1] xor $FF)) shr 1;
        p1[x1*3+2] := (p1[x1*3+1]+(p2[(x1+3)*3+1] xor $FF)) shr 1;
      end;
    end;
  end;
end;
Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
var bmp : TBitmap;
begin
  bmp := TBitmap.Create;
  Bmp.Assign(Image1.Picture.Bitmap);
  try
    Emboss(bmp, 1);
    Image1.Picture.Bitmap.Assign(bmp);
  finally
  bmp.Free;
  end;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate