كود  لتحويل ICO الى bmp 


procedure TForm1.Button2Click(Sender: TObject);
var
Icon   : TIcon;
Bitmap : TBitmap;
   begin
       if OpenDialog1.Execute then  begin
       Icon   := TIcon.Create;
       Bitmap := TBitmap.Create;
       Icon.LoadFromFile(OpenDialog1.FileName);
       Bitmap.Width := Icon.Width;
       Bitmap.Height := Icon.Height;
       Bitmap.Canvas.Draw(0, 0, Icon);
       Bitmap.SaveToFile('c:\picture.bmp');
       Icon.Free;
       Bitmap.Free;
   end;
end;

//==========================================================
وبالتالي  
كود لاستخراج  ico  من ملف bmp


procedure TForm1.Button1Click(Sender: TObject);
var
IconSizeX: integer;
IconSizeY: integer;

XOrMask: TBitmap;
IconInfo: TIconInfo;
Icon: TIcon;
begin
IconSizeX := GetSystemMetrics(SM_CXICON);
IconSizeY := GetSystemMetrics(SM_CYICON);
XOrMask := TBitmap.Create;
XOrMask.Width := IconSizeX;
XOrMask.Height := IconSizeY;
XOrMask.LoadFromFile('C:\picture.bmp');{}

Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);
{Create a icon}
Icon := TIcon.Create;
IconInfo.fIcon := true;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := XOrMask.Handle;
IconInfo.hbmColor := XOrMask.Handle;
Icon.Handle := CreateIconIndirect(IconInfo);
{Destroy the temporary bitmaps}
// AndMask.Free;
XOrMask.Free;
{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);
{Assign the application icon}
Application.Icon := Icon;
{Force a repaint}
InvalidateRect(Application.Handle, nil, true);
{Free the icon}
Icon.Free;
end;
طبعا لازم يكون الملف عبارة من ملف ايونة تم حفظه على بالتنسيق 

//============================================================
كود يحول الbmp    الى  jpg 
uses JPEG;

procedure TForm1.Button2Click(Sender: TObject);
var
 JPEG: TJPEGImage;
 Bitmap: TBitmap;
begin
 if OpenDialog1.Execute then
 begin
 JPEG := TJPEGImage.Create;
 Bitmap := TBitmap.Create;
 try
   Bitmap.LoadFromFile(OpenDialog1.FileName);
   JPEG.Assign(Bitmap);
   Image1.Picture.Assign(JPEG);
 finally
     JPEG.SaveToFile('C:\E.jpg');
     JPEG.Free;
   Bitmap.Free;
 end;
end;


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

وهذا كود يحول ال jpg  الى bmp 

uses JPEG;

procedure TForm1.Button3Click(Sender: TObject);
var
 jpeg: TJPEGImage;
 bmp:  TBitmap;
begin
 if OpenDialog1.Execute then
 begin
 jpeg := TJPEGImage.Create;
 try
   jpeg.CompressionQuality := 100; {Default Value}
   jpeg.LoadFromFile(OpenDialog1.FileName);
   bmp := TBitmap.Create;
   try
     bmp.Assign(jpeg);
     bmp.SaveTofile('c:\3.bmp');
   finally
     bmp.Free
   end;
 finally
   jpeg.Free
 end;
 end;
end;

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

كود لتغيير حجم الصورة

function TForm1.ResizeBmp(bitmp: TBitmap; wid, hei: Integer): Boolean;
var
   TmpBmp: TBitmap;
  ARect: TRect;
begin
  Result := False;
  try
    TmpBmp := TBitmap.Create;
    try
      TmpBmp.Width  := wid;
      TmpBmp.Height := hei;
      ARect := Rect(0,0, wid, hei);
      TmpBmp.Canvas.StretchDraw(ARect, Bitmp);
      bitmp.Assign(TmpBmp);
    finally
      TmpBmp.Free;
    end;
    Result := True;
  except
    Result := False;
  end;
end;

//***************************************************
procedure TForm1.Button2Click(Sender: TObject);
begin
 ResizeBmp(Image1.Picture.Bitmap,200,700)
end;
//***********************************************************************//






الفورم على شكل صوره  

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

type
  TRGBArray = array[0..32767] of TRGBTriple;
  PRGBArray = ^TRGBArray;

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   { Private declarations }
   FRegion: THandle;
    function CreateRegion(Bmp: TBitmap): THandle;


 public
   { Public declarations }
 end;
//=======================================================

function TForm1.CreateRegion(Bmp: TBitmap): THandle;
var
  X, Y, StartX: Integer;
  Excl: THandle;
  Row: PRGBArray;
  TransparentColor: TRGBTriple;
begin
  Bmp.PixelFormat := pf24Bit;

  Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);

  for Y := 0 to Bmp.Height - 1 do
  begin
    Row := Bmp.Scanline[Y];

    StartX := -1;

    if Y = 0 then
      TransparentColor := Row[0];

    for X := 0 to Bmp.Width - 1 do
    begin
      if (Row[X].rgbtRed = TransparentColor.rgbtRed) and
        (Row[X].rgbtGreen = TransparentColor.rgbtGreen) and
        (Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
      begin
        if StartX = -1 then StartX := X;
      end
      else
      begin
        if StartX > -1 then
        begin
          Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
          try
            CombineRGN(Result, Result, Excl, RGN_DIFF);
            StartX := -1;
          finally
            DeleteObject(Excl);
          end;
        end;
      end;
    end;

    if StartX > -1 then
    begin
      Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
      try
        CombineRGN(Result, Result, Excl, RGN_DIFF);
      finally
        DeleteObject(Excl);
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromFile('E:\prgramm\change form\Eagle.bmp');
    FRegion := CreateRegion(Bmp);
    SetWindowRGN(Handle, FRegion, True);
  finally
    Bmp.Free;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteObject(FRegion);
end;

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

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

//====================================================
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;

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


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