[Delphi]Lina

[Toster]

Aloha

Siadlem dzisiaj do napisania liny ale wyszla mi jak na razie guma

podrzuce kod moze ktos bedzie sie nudzil i ulini mi moja linie, tak czy siak bede nad nia jeszcze pracowal, jak skoncze dam znac....

(kod jest smieciowaty bo to wersja mocno zmieniana ale powinniscie sie polapac)

 

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   PaintBox1: TPaintBox;
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 TPlayer = class;
  TLina = class
     public
        constructor    Create(const x,y: integer);
        procedure   Update;
     private
        fx, fy:     real;
        fdx, fdy:   integer;
        fParent:    TPlayer;
        d90:        real;
        fMinY:      real;
  end;

  TPlayer = class
     public
        constructor create;
        procedure   Update;
     private
        fx, fy:     real;
        fvx, fvy:   real;
        fvx1, fvy1: real;    //grawitacja
        fvx2, fvy2: real;    //sila
        fLine:      TLina;
  end;

var
 Form1: TForm1;
 pl: TPlayer;
implementation

{$R *.dfm}

{ TPlayer }

constructor TPlayer.create;
begin
  fLine := TLina.Create(200,60);
  fLine.fParent := self;
end;

procedure TPlayer.Update;
begin
  fLine.Update;

  fvx := fvx + fvx1 + fvx2;
  fvy := fvy + fvy1 + fvy2;

  fx := fx + fvx;
  fy := fy + fvy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  pl := TPlayer.create;
  pl.fx := 300;
  pl.fy := 10;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  x, y, xx, yy: integer;
begin
  pl.fvy1 := 0.98;
  pl.Update;
  x := Round(pl.fx);
  y := Round(pl.fy);
  xx := Round(pl.fLine.fx);
  yy := Round(pl.fLine.fy);
  PaintBox1.Canvas.Brush.Color := 0;
  PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);

  PaintBox1.Canvas.Pen.Color := clWhite;
  PaintBox1.Canvas.MoveTo(x,y);
  PaintBox1.Canvas.LineTo(xx,yy);

  PaintBox1.Canvas.Brush.Color := clYellow;
  PaintBox1.Canvas.FillRect(Rect(x-3,y-3,x+3,y+3));
  caption := Format('vy:%f', [pl.fvy]);

  xx := x + pl.fLine.fdx;
  yy := y + pl.fLine.fdy;
  PaintBox1.Canvas.Pen.Color := clBlue;
  PaintBox1.Canvas.MoveTo(x,y);
  PaintBox1.Canvas.LineTo(xx,yy);

  xx := x + Round(pl.fvx);
  yy := y + Round(pl.fvy);
  PaintBox1.Canvas.Pen.Color := clRed;
  PaintBox1.Canvas.MoveTo(x,y);
  PaintBox1.Canvas.LineTo(xx,yy);

  PaintBox1.Canvas.Pen.Color := clRed;
  PaintBox1.Canvas.FillRect(Rect(400,400,420, Round(400+pl.fvy2*4)));
end;

{ TLina }

constructor TLina.Create(const x, y: integer);
begin
  fx := x;
  fy := y;
end;

procedure TLina.Update;
const
  k = 0.15;
  len = 150;
var
  dist, dx, dy, v, vx, vy : real;
begin
  dx := fx - fParent.fx;
  dy := fy - fParent.fy;
  Dist := Sqrt(dx*dx + dy*dy);
  dx := dx / dist;
  dy := dy / dist;
  if Dist > len then begin
     if Dist > len + 35 then begin
        fParent.fvx := fParent.fvx * 0.86;
        fParent.fvy := fParent.fvy * 0.86;
     end;
     Dist := Dist - len;  //wsp. wydluzenia
     if Dist > 10 then begin
        Dist := 10;
     end;
     if Dist < 2 then begin
        fParent.fvx2 := dx;
        fParent.fvy2 := -fParent.fvy;
     end else begin
        fParent.fvx2 := dx * Dist*k;
        fParent.fvy2 := dy *  Dist*k;
     end;
  end else begin
     fParent.fvx2 := 0;
     fParent.fvy2 := 0;
  end;
end;

end.

 

AAA do pelni szczescia potrzebny wam Paintbox 600x600 i timer 50ms albo cos ...

[Wosiedem]

Wstawisz binarkę? Chcętnie bym obejrzał, a nie mam aktualnie delphi.

[kompustelnik]

Heh

 

Fajne

 

Pozdrawiam!

[Toster]

mozna zaciagnac z http://toster.ps.pl/test

ale nie spodziewaj sie za duzo ujrzec

[Toster]

nom jest maly updacik, bierzemy stary kod i zmieniamy 2 funkcje:

 

procedure TLina.Update;
const
  k = 0.30;
  len = 150;
var
  dist, dx, dy: real;
begin
  dx := fx - fParent.fx;
  dy := fy - fParent.fy;
  Dist := Sqrt(dx*dx + dy*dy);
  dx := dx / dist;
  dy := dy / dist;
  if Dist > len then begin
     Dist := Dist - len;  //wsp. wydluzenia
     if Dist > 4 then begin
        fParent.fx := fx - dx*(Len+4);
        fParent.fy := fy - dy*(Len+4);
     end;
     if Dist > 10 then begin
        Dist := 10;
     end;
     fParent.fvx2 := dx * Dist*k;
     fParent.fvy2 := dy *  Dist*k;
  end else begin
     fParent.fvx2 := 0;
     fParent.fvy2 := 0;
  end;
end;
Ś)QAąUŃ)(Ń)(1UŃ((ŹŹ(źąŹąŃ(ŃĄMĄ(ŹŃ((ŹŹ((Ź(Ź)

i jest duzo ladniej

[Blind]

Troche taka sztywna.

[Toster]

bo zamienilem gume na sznurek

Sproboj skoczyc z 2 giego pietra obwiazany zwykla lina do wspinaczki to szybko zrozumiesz o co mi chodzi :>