VPF::[Delphi] Вращение графического сегмента

kawak

Дата 16.12.2012, 17:42 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 16.12.2012

Репутация: 1
Всего: 1

Здравствуйте!

Помогите, пожалуйста, написать программу вращения графического сегмента вокруг указанной точки.
Варианты графического сегмента: стрелка, эллипс, прямоугольник.

Есть пример с вращением:

Код


unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
 
    private
      { Private declarations }
    public
      { Public declarations }
end;
 
var
  Form1: TForm1;
  i: extended;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  i:=0;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  x1,y1,x2,y2: extended;
begin
  x1:=125+125*cos(i);
  y1:=125+125*sin(i);
  x2:=125+125*cos(i+5);
  y2:=125+125*sin(i+5);
  with PaintBox1, Canvas do
    begin
      Brush.Color:=clWhite;
      Rectangle(0,0,ClientWidth,ClientHeight);
      Brush.Color:=clRed;
      Pie(0,0,300,300,trunc(x1),trunc(y1),trunc(x2),trunc(y2));
    end;
  i:=i+0.2;
end;
 
end.

Попытался нарисовать вместо Pie прямоугольник или эллипс, но в итоге получается какая то ерунда... :(

Это сообщение отредактировал(а) kawak - 18.12.2012, 02:08

kawak

Дата 18.12.2012, 02:08 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 16.12.2012

Репутация: 1
Всего: 1

Можете подсказать, как сделать подобное, например с прямоугольником?

orthrus

Дата 18.12.2012, 05:56 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 400
Регистрация: 30.10.2007
Где: г. Усть-Илимск(Ир кутская обл.)

Репутация: 5
Всего: 16

Код


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.

процедура RotateBitmap_ads была нагуглена и чуть модернизирована

--------------------

kawak

Дата 18.12.2012, 19:45 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 6
Регистрация: 16.12.2012

Репутация: 1
Всего: 1

orthrus, спасибо! smile

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »