procedure RotateRight(BitMap: tImage);
var
  FirstC, LastC, c, r: integer;

  procedure FixPixels(c, r: integer);
  var
    SavePix, SavePix2: tColor;
    i, NewC, NewR: integer;
  begin
    SavePix := Bitmap.Canvas.Pixels[c, r];
    for i := 1 to 4 do
    begin
      newc := BitMap.Height - r + 1;
      newr := c;
      SavePix2 := BitMap.Canvas.Pixels[newc, newr];
      Bitmap.Canvas.Pixels[newc, newr] := SavePix;
      SavePix := SavePix2;
      c := Newc;
      r := NewR;
    end;
  end;

begin
  if BitMap.Width <> BitMap.Height then
    exit;
  BitMap.Visible := false;
  with Bitmap.Canvas do
  begin
    firstc := 0;
    lastc := BitMap.Width;
    for r := 0 to BitMap.Height div 2 do
    begin
      for c := firstc to lastc do
      begin
        FixPixels(c, r);
      end;
      inc(FirstC);
      Dec(LastC);
    end;
  end;
  BitMap.Visible := true;
end;