اكواد bmp

كود لتكسير الصورة 

//====================================================
 procedure Blocks(Bitmap: TBitmap; Hor, Ver, MaxOffset:
  Integer; BackColor: TColor);
{вырезаем прямоугольники со сторонами Hor Ver
и копируем их в радиусе MaxOffset}

  function RandomInRadius(Num, Radius: Integer): Integer;
  begin
    if Random(2) = 0 then
      Result := Num + Random(Radius)
    else
      Result := Num - Random(Radius);
  end;

var
  x, y, xd, yd: Integer;
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Bitmap);
    Bitmap.Canvas.Brush.Color := BackColor;
    Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
    xd := (Bitmap.Width - 1) div Hor;
    yd := (Bitmap.Height - 1) div Ver;
    Randomize;
    for x := 0 to xd do
      for y := 0 to yd do
        BitBlt(Bitmap.Canvas.Handle,
          RandomInRadius(Hor * x, MaxOffset),
          RandomInRadius(Ver * y, MaxOffset),
          Hor, Ver, Bmp.Canvas.Handle, Hor * x, Ver * y, SRCCOPY);
  finally
    Bmp.Free;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Blocks(Image1.Picture.Bitmap , Image1.Picture.Bitmap.Width div 10,
 Image1.Picture.Bitmap.Height div 10, 4, clWhite);
end;
//====================================================


تاثير تموجات على الصورة  bmp


procedure WaveSin(Bitmap: TBitmap; Frequency, Length:
  Integer; Hor: Boolean; BackColor: TColor);

  function Min(A, B: Integer): Integer;
  begin
    if A < B then
      Result := A
    else
      Result := B;
  end;

  function Max(A, B: Integer): Integer;
  begin
    if A > B then
      Result := A
    else
      Result := B;
  end;

const
  Rad = Pi / 180;
type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;
var
  x, y, f: Integer;
  Dest, Src: pRGB;
  Bmp: TBitmap;
begin
  Bitmap.PixelFormat := pf24Bit;
  Bmp := TBitmap.create;
  try
    Bmp.Assign(Bitmap);
    Bitmap.Canvas.Brush.Color := BackColor;
    Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
    for y := 0 to Bmp.Height - 1 do
    begin
      Src := Bmp.ScanLine[y];
      for x := 0 to Bmp.Width - 1 do
      begin
        if Hor then
        begin
          f := Min(Max(Round(Sin(x * Rad * Length) * Frequency) + y, 0),
            Bitmap.Height - 1);
          Dest := Bitmap.ScanLine[f];
          Inc(Dest, x);
        end
        else
        begin
          f := Min(Max(Round(Sin(y * Rad * Length) * Frequency) + x, 0),
            Bitmap.Width - 1);
          Dest := Bitmap.ScanLine[y];
          Inc(Dest, f);
        end;
        Dest^ := Src^;
        Inc(Src);
      end;
    end;
  finally
    Bmp.free;
  end;
end;

//2222222222222222222222222222222222222222222222222222

procedure TForm1.Button2Click(Sender: TObject);
begin
WaveSin(Image1.Picture.Bitmap,Image1.Picture.Bitmap.Width div 50,
Image1.Picture.Bitmap.Width div 40, True, clWhite);
end;

//222222222222222222222222222222222222222222222//

تشويه الصورة


//***************************************************

procedure Disorder(Bitmap: TBitmap; Hor, Ver: Integer; BackColor: TColor);

  function RandomInRadius(Num, Radius: Integer): Integer;
  begin
    if Random(2) = 0 then
      Result := Num + Random(Radius)
    else
      Result := Num - Random(Radius);
  end;

type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;
var
  x, y, WW, HH, xr, yr: Integer;
  Dest1, Dest2, Src1, Src2: PRGB;
  Bmp: TBitmap;
begin
  Randomize;
  Bitmap.PixelFormat := pf24Bit;
  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Bitmap);
    WW := Bitmap.Width - 1;
    HH := Bitmap.Height - 1;
    Bitmap.Canvas.Brush.Color := BackColor;
    Bitmap.Canvas.FillRect(Rect(0, 0, WW + 1, HH + 1));
    for y := 0 to HH do
    begin
      for x := 0 to WW do
      begin
        xr := RandomInRadius(x, Hor);
        yr := RandomInRadius(y, Ver);
        if (xr >= 0) and (xr < WW) and (yr >= 0) and (yr < HH) then
        begin
          Src1 := Bmp.ScanLine[y];
          Src2 := Bmp.ScanLine[yr];
          Dest1 := Bitmap.ScanLine[y];
          Dest2 := Bitmap.ScanLine[yr];
          Inc(Src1, x);
          Inc(Src2, xr);
          Inc(Dest1, x);
          Inc(Dest2, xr);
          Dest1^ := Src2^;
          Dest2^ := Src1^;
        end;
      end;
    end;
  finally
    Bmp.Free;
  end;
end;
//***************************************************//

procedure TForm1.Button3Click(Sender: TObject);
begin
 Disorder(Image1.Picture.Bitmap, 5, 5, clWhite);
end;
//*****************************************************

تاثير موازييك 
//*******************************************************************

procedure PixelsEffect(Bitmap: TBitmap; Hor, Ver: Word);

  function Min(A, B: Integer): Integer;
  begin
    if A < B then
      Result := A
    else
      Result := B;
  end;

type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;
var
  i, j, x, y, xd, yd,
    rr, gg, bb, h, hx, hy: Integer;
  Dest: pRGB;
begin
  Bitmap.PixelFormat := pf24Bit;
  if (Hor = 1) and (Ver = 1) then
    Exit;
  xd := (Bitmap.Width - 1) div Hor;
  yd := (Bitmap.Height - 1) div Ver;
  for i := 0 to xd do
    for j := 0 to yd do
    begin
      h := 0;
      rr := 0;
      gg := 0;
      bb := 0;
      hx := Min(Hor * (i + 1), Bitmap.Width - 1);
      hy := Min(Ver * (j + 1), Bitmap.Height - 1);
      for y := j * Ver to hy do
      begin
        Dest := Bitmap.ScanLine[y];
        Inc(Dest, i * Hor);
        for x := i * Hor to hx do
        begin
          Inc(rr, Dest^.R);
          Inc(gg, Dest^.G);
          Inc(bb, Dest^.B);
          Inc(h);
          Inc(Dest);
        end;
      end;
      Bitmap.Canvas.Brush.Color := RGB(rr div h, gg div h, bb div h);
      Bitmap.Canvas.FillRect(Rect(i * Hor, j * Ver, hx + 1, hy + 1));
    end;
end;



procedure TForm1.Button4Click(Sender: TObject);
begin
PixelsEffect(Image1.Picture.Bitmap, 8, 8);
end;

//*******************************************************************

دور الصورة بالزاوية التي تريدها 

//*****************************************************

procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
type TRGB = record
       B, G, R: Byte;
     end;
     pRGB = ^TRGB;
     pByteArray = ^TByteArray;
     TByteArray = array[0..32767] of Byte;
     TRectList = array [1..4] of TPoint;

var x, y, W, H, v1, v2: Integer;
    Dest, Src: pRGB;
    VertArray: array of pByteArray;
    Bmp: TBitmap;

  procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
  begin
    ASin := Sin(AngleRad);
    ACos := Cos(AngleRad);
  end;

  function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double): TRectList;
  var DX, DY: Integer;
      SinAng, CosAng: Double;
    function RotPoint(PX, PY: Integer): TPoint;
    begin
      DX := PX - Center.x;
      DY := PY - Center.y;
      Result.x := Center.x + Round(DX * CosAng - DY * SinAng);
      Result.y := Center.y + Round(DX * SinAng + DY * CosAng);
    end;
  begin
    SinCos(Angle * (Pi / 180), SinAng, CosAng);
    Result[1] := RotPoint(Rect.Left, Rect.Top);
    Result[2] := RotPoint(Rect.Right, Rect.Top);
    Result[3] := RotPoint(Rect.Right, Rect.Bottom);
    Result[4] := RotPoint(Rect.Left, Rect.Bottom);
  end;

  function Min(A, B: Integer): Integer;
  begin
    if A < B then Result := A
             else Result := B;
  end;

  function Max(A, B: Integer): Integer;
  begin
    if A > B then Result := A
             else Result := B;
  end;

  function GetRLLimit(const RL: TRectList): TRect;
  begin
    Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x));
    Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y));
    Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x));
    Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y));
  end;

  procedure Rotate;
  var x, y, xr, yr, yp: Integer;
      ACos, ASin: Double;
      Lim: TRect;
  begin
    W := Bmp.Width;
    H := Bmp.Height;
    SinCos(-Angle * Pi/180, ASin, ACos);
    Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0), Angle));
    Bitmap.Width := Lim.Right - Lim.Left;
    Bitmap.Height := Lim.Bottom - Lim.Top;
    Bitmap.Canvas.Brush.Color := BackColor;
    Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
    for y := 0 to Bitmap.Height - 1 do begin
      Dest := Bitmap.ScanLine[y];
      yp := y + Lim.Top;
      for x := 0 to Bitmap.Width - 1 do begin
        xr := Round(((x + Lim.Left) * ACos) - (yp * ASin));
        yr := Round(((x + Lim.Left) * ASin) + (yp * ACos));
        if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then begin
          Src := Bmp.ScanLine[yr];
          Inc(Src, xr);
          Dest^ := Src^;
        end;
        Inc(Dest);
      end;
    end;
  end;

begin
  Bitmap.PixelFormat := pf24Bit;
  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Bitmap);
    W := Bitmap.Width - 1;
    H := Bitmap.Height - 1;
    if Frac(Angle) <> 0.0
      then Rotate
      else
    case Trunc(Angle) of
      -360, 0, 360, 720: Exit;
      90, 270: begin
        Bitmap.Width := H + 1;
        Bitmap.Height := W + 1;
        SetLength(VertArray, H + 1);
        v1 := 0;
        v2 := 0;
        if Angle = 90.0 then v1 := H
                        else v2 := W;
        for y := 0 to H do VertArray[y] := Bmp.ScanLine[Abs(v1 - y)];
        for x := 0 to W do begin
          Dest := Bitmap.ScanLine[x];
          for y := 0 to H do begin
            v1 := Abs(v2 - x)*3;
            with Dest^ do begin
              B := VertArray[y, v1];
              G := VertArray[y, v1+1];
              R := VertArray[y, v1+2];
            end;
            Inc(Dest);
          end;
        end
      end;
      180: begin
        for y := 0 to H do begin
          Dest := Bitmap.ScanLine[y];
          Src := Bmp.ScanLine[H - y];
          Inc(Src, W);
          for x := 0 to W do begin
            Dest^ := Src^;
            Dec(Src);
            Inc(Dest);
          end;
        end;
      end;
      else Rotate;
    end;
  finally
    Bmp.Free;
  end;
end;

//*****************************************************

procedure TForm1.Button5Click(Sender: TObject);
begin
 randomize();
RotateBitmap(Image1.Picture.Bitmap, random(361), clWhite);

end;


//*****************************************************


الدوران حول نقطة معينة 


//=========================================

uses  math

//888888888888888888888888888888888888888888888888

function TForm1.Vektor(FromP, Top: TPoint): TPoint;
 begin
   Result.x := Top.x - FromP.x;
   Result.y := Top.y - FromP.y;
 end;

 // neue x Komponente des Verktors
// new x-component of the vector
function TForm1.xComp(Vektor: TPoint; Angle: Extended): Integer;
 begin
   Result := Round(Vektor.x * cos(Angle) - (Vektor.y) * sin(Angle));
 end;

 // neue Y-Komponente des Vektors
// new y-component of the vector 
function TForm1.yComp(Vektor: TPoint; Angle: Extended): Integer;
 begin
   Result := Round((Vektor.x) * (sin(Angle)) + (vektor.y) * cos(Angle));
 end;


 function TForm1.RotImage(srcbit: TBitmap; Angle: Extended; FPoint: TPoint;
   Background: TColor): TBitmap;
 { 
 srcbit: TBitmap; // Bitmap dass gedreht werden soll; Bitmap to be rotated
 Angle: extended; // Winkel in Bogenma?, angle 
 FPoint: TPoint;  // Punkt um den gedreht wird; Point to be rotated around 
 Background: TColor): TBitmap;  // Hintergrundfarbe des neuen Bitmaps; 
                               // Backgroundcolor of the new bitmap 
}
 var
    highest, lowest, mostleft, mostright: TPoint;
   topoverh, leftoverh: integer;
   x, y, newx, newy: integer;
 begin
   Result := TBitmap.Create;

   // Drehwinkel runterrechnen auf eine Umdrehung, wenn notig 
  // Calculate angle down on one rotation, if necessary 
  while Angle >= (2 * pi) do
   begin
     angle := Angle - (2 * pi);
   end;

   // neue Ausma?e festlegen 
  // specify new size 
  if (angle <= (pi / 2)) then
   begin
     highest := Point(0,0);                        //OL
    Lowest := Point(Srcbit.Width, Srcbit.Height); //UR 
    mostleft := Point(0,Srcbit.Height);            //UL 
    mostright := Point(Srcbit.Width, 0);             //OR 
  end
    else if (angle <= pi) then
   begin
     highest := Point(0,Srcbit.Height);
     Lowest := Point(Srcbit.Width, 0);
     mostleft := Point(Srcbit.Width, Srcbit.Height);
     mostright := Point(0,0);
   end
    else if (Angle <= (pi * 3 / 2)) then
   begin
     highest := Point(Srcbit.Width, Srcbit.Height);
     Lowest := Point(0,0);
     mostleft := Point(Srcbit.Width, 0);
     mostright := Point(0,Srcbit.Height);
   end
    else
   begin
     highest := Point(Srcbit.Width, 0);
     Lowest := Point(0,Srcbit.Height);
     mostleft := Point(0,0);
     mostright := Point(Srcbit.Width, Srcbit.Height);
   end;

   topoverh := yComp(Vektor(FPoint, highest), Angle);
   leftoverh := xComp(Vektor(FPoint, mostleft), Angle);
   Result.Height := Abs(yComp(Vektor(FPoint, lowest), Angle)) + Abs(topOverh);
   Result.Width  := Abs(xComp(Vektor(FPoint, mostright), Angle)) + Abs(leftoverh);

   // Verschiebung des FPoint im neuen Bild gegenuber srcbit 
  // change of FPoint in the new picture in relation on srcbit 
  Topoverh := TopOverh + FPoint.y;
   Leftoverh := LeftOverh + FPoint.x;

   // erstmal mit Hintergrundfarbe fullen 
  // at first fill with background color 
  Result.Canvas.Brush.Color := Background;
   Result.Canvas.pen.Color   := background;
   Result.Canvas.Fillrect(Rect(0,0,Result.Width, Result.Height));

   // Start des eigentlichen Rotierens 
  // Start of actual rotation 
  for y := 0 to srcbit.Height - 1 do
   begin                       // Zeilen ; Rows 
    for x := 0 to srcbit.Width - 1 do
     begin                    // Spalten; Columns 
      newX := xComp(Vektor(FPoint, Point(x, y)), Angle);
       newY := yComp(Vektor(FPoint, Point(x, y)), Angle);
       newX := FPoint.x + newx - leftoverh;
       // Verschieben wegen der neuen Ausma?e 
      newy := FPoint.y + newy - topoverh;
       // Move beacause of new size
      Result.Canvas.Pixels[newx, newy] := srcbit.Canvas.Pixels[x, y];
       // auch das Pixel daneben fullen um Leerpixel bei Drehungen zu verhindern 
      // also fil lthe pixel beside to prevent empty pixels 
      if ((angle < (pi / 2)) or
         ((angle > pi) and
         (angle < (pi * 3 / 2)))) then
       begin
         Result.Canvas.Pixels[newx, newy + 1] := srcbit.Canvas.Pixels[x, y];
       end
        else
        begin
         Result.Canvas.Pixels[newx + 1,newy] := srcbit.Canvas.Pixels[x, y];
       end;
     end;
   end;
 end;

//888888888888888888888888888888888888888888888888
procedure TForm1.Button7Click(Sender: TObject);
var
   mybitmap, newbit: TBitMap;
 begin
   if OpenDialog1.Execute then
   begin
     mybitmap := TBitmap.Create;
     mybitmap.LoadFromFile(OpenDialog1.FileName);
     newbit := RotImage(mybitmap, DegToRad(180),
       Point(mybitmap.Width div 2, mybitmap.Height div 2), clBlack);
     Image1.Canvas.Draw(0,0, newBit);
   end;
 end;

 //=========================================


//========================================