Форум программистов [Powered by Invision Power Board]

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, ExtCtrls;

const
  PixelMax = 32768;

type

  pPixelArray = ^TPixelArray;
  TPixelArray = array [0..PixelMax-1] of TRGBTriple;

  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    bm:TBitmap;
    bm2:TBitmap;
    Angle:Double;
    { Private declarations }
  public
    procedure RotateBitmap_ads(SourceBitmap: TBitmap;
    out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Center : TPoint;

begin
  Center.y := (bm.Height div 2);
  Center.x := (bm.Width div 2);
  RotateBitmap_ads( bm, bm2, Center, Angle);
  Angle := Angle + 5;
  self.Canvas.Draw(10,10,bm2);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Button1Click(self);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  rect:TRect;
begin
  bm := TBitmap.Create;
  bm2 := TBitmap.Create;
  rect.Left := 0;
  rect.Top := 0;
  rect.Right := 140;
  rect.Bottom := 140;
  //bm.Canvas.Create;
  bm.PixelFormat := pf24bit;
  bm.Height := rect.Bottom - rect.Top;
  bm.Width := rect.Right - rect.Left;
  bm.Canvas.Brush.Color := self.Canvas.Brush.Color;
  bm.Canvas.FillRect(rect);
  bm.Canvas.Brush.Color := $00FF00;
  bm.Canvas.Pen.Color := $000000;
  bm.Canvas.Rectangle((bm.Width div 2) - 25,(bm.Height div 2)- 15, (bm.Width div 2) + 25,(bm.Height div 2) + 15);
  bm.Canvas.Brush.Color := $FF0000;
  bm.Canvas.Pen.Color := $00FF00;
  bm.Canvas.Ellipse((bm.Width div 2) - 15,(bm.Height div 2)- 25, (bm.Width div 2) + 15,(bm.Height div 2) + 25);
end;

procedure TForm1.RotateBitmap_ads(SourceBitmap: TBitmap;
    out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
var
  cosRadians : Double;
  inX : Integer;
  inXOriginal : Integer;
  inXPrime : Integer;
  inXPrimeRotated : Integer;
  inY : Integer;
  inYOriginal : Integer;
  inYPrime : Integer;
  inYPrimeRotated : Integer;
  OriginalRow : pPixelArray;
  Radians : Double;
  RotatedRow : pPixelArray;
  sinRadians : Double;
begin
  DestBitmap.Width := SourceBitmap.Width;
  DestBitmap.Height := SourceBitmap.Height;
  DestBitmap.PixelFormat := pf24bit;
  Radians := -(Angle) * PI / 180;
  sinRadians := Sin(Radians);
  cosRadians := Cos(Radians);
  for inX := DestBitmap.Height-1 downto 0 do
  begin
    RotatedRow := DestBitmap.Scanline[inX];
    inXPrime := 2*(inX - Center.y) + 1;
    for inY := DestBitmap.Width-1 downto 0 do
    begin
      inYPrime := 2*(inY - Center.x) + 1;
      inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
      inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
      inYOriginal := (inYPrimeRotated - 1) div 2 + Center.x;
      inXOriginal := (inXPrimeRotated - 1) div 2 + Center.y;
      if (inYOriginal >= 0) and (inYOriginal <= SourceBitmap.Width-1) and
      (inXOriginal >= 0) and (inXOriginal <= SourceBitmap.Height-1) then
      begin
        OriginalRow := SourceBitmap.Scanline[inXOriginal];
        RotatedRow[inY] := OriginalRow[inYOriginal]
      end
    end;
  end;
end;

end.