Показать сообщение отдельно
  #7  
Старый 28.02.2012, 02:16
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Нужно ещё исправлять, но для начала пойдёт:
Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Start: TButton;
    exit: TButton;
    Timer1: TTimer;
    EditSpeed: TLabeledEdit;
    EditAlpha: TLabeledEdit;
    procedure StartClick(Sender: TObject);
    procedure exitClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure EditKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;

implementation

uses
  unit2;

var
  B     : TBabina;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  B := TBabina.Create(PaintBox1.Canvas);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  B.Free;
end;

procedure TForm1.FormResize(Sender: TObject);   //ñìåíà ìàñøòàáà ïðè ñìåíå ðàçìåðà ôîðìû
begin
  if (PaintBox1.Width / 400 > PaintBox1.Height / 300) then
    B.Scale := PaintBox1.Height / 300
  else
    B.Scale := PaintBox1.Width / 400 - 0.03;

  if (B.Speed = 0) then
    B.Draw;
end;

procedure TForm1.StartClick(Sender: TObject);    //óñòàíîâêà íîâûõ çíà÷åíèé
var
  n    : Integer;
  Buff : Single;
begin
  PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);
  val(EditSpeed.Text, Buff, n);
  B.Speed := Buff;
  val(EditAlpha.Text, Buff, n);
  B.Alpha := Buff;
  B.Drift := 0;
  if (B.Speed = 0) then
    Timer1.Enabled := False
  else
    Timer1.Enabled := True;
  Timer1Timer(self);
end;

procedure TForm1.exitClick(Sender: TObject);     //âûõîä
begin
  Application.Terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);   //"îáíîâëåíèå ðèñóíêà"
begin
  B.Draw;
end;

procedure TForm1.EditKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);                          //îáðàáîòêà íàæàòèÿ enter
begin
  if Key = 13 then
    StartClick(self);
end;

end.

Код:
unit Unit2;
 
interface

uses
  Windows, Messages, SysUtils, Graphics;

type
  TBabina       = class
  private
    fCanvas     : TCanvas;
    fAlpha,
    fSpeed,
    fDrift,
    fScale     : Single;
  protected
    procedure Babina(a : Single; wid, x, y, r : Integer);
    procedure Line(x1, y1, x2, y2, wid : Integer);
  public
    constructor Create(Canvas : TCanvas);
    procedure Draw;

    property Alpha : Single read fAlpha write fAlpha;
    property Speed : Single read fSpeed write fSpeed;
    property Drift : Single read fDrift write fDrift;
    property Scale : Single read fScale write fScale;
  end;

implementation

constructor TBabina.Create(Canvas : TCanvas);
begin
  fCanvas := Canvas;
end;

procedure TBabina.Draw;                               //ðàñ÷åò íîâûõ çíà÷åíèé
var
  l1, l2 : Single;
begin
  l1 := 7 - Round(fDrift / 1.5) mod 25;
  Line(75 + Round(l1), 206, 300 + Round(l1), 206, 7);
  l1 := Frac(fDrift / 200 / Pi) * Pi;
  Babina(fAlpha / 180 * Pi + l1, 10, 300, 100, 100);
  l2 := Frac(fDrift / 150 / Pi) * Pi;
  Babina(fAlpha / 180 * Pi + l2, 10, 75, 125, 75);
  if (Round(l1 * 1000) = 0) and (Round(l2 * 1000) = 0) then
    fDrift := 0;
  fDrift := fDrift + fSpeed;
end;

procedure TBabina.Line(x1, y1, x2, y2, wid : Integer);    //ðèñîâàíèå òîëñòîé ïóíêòèðíîé ëèíèè
var
  I : Integer;
begin
  with fCanvas do
  begin
    Pen.Width := 1;
    Pen.Style := psDash;
    Pen.Color := clBlack;
    for I := 0 to wid - 1 do
    begin
      MoveTo(Round(x1 * fScale), Round(y1 * fScale) - I);
      LineTo(Round(x2 * fScale), Round(y2 * fScale) - I);
    end;
  end;
end;

procedure TBabina.Babina(a : Single; wid, x, y, r : Integer); //ðèñîâàíèå áàáèíû(êîëåñî ñ 4 ñïèöàìè)
begin
  with fCanvas do
  begin
    Pen.Color := clMaroon;
    Pen.Width := wid;
    wid := wid div 2;
    Brush.Color := clBtnFace;
    Ellipse(Round((x + wid - r) * fScale), Round((y + wid - r) * fScale), Round((x + wid + r) * fScale), Round((y + wid + r) * fScale));
    Dec(r);
    MoveTo(Round((x + wid + Round(r * Sin(a))) * fScale), Round((y + wid - Round(r * Cos(a))) * fScale));
    LineTo(Round((x + wid - Round(r * Sin(a))) * fScale), Round((y + wid + Round(r * Cos(a))) * fScale));
    MoveTo(Round((x + wid - Round(r * Cos(a))) * fScale), Round((y + wid - Round(r * Sin(a))) * fScale));
    LineTo(Round((x + wid + Round(r * Cos(a))) * fScale), Round((y + wid + Round(r * Sin(a))) * fScale));
  end;
end;

end.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием