|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#16
|
||||
|
||||
спасибо огромное!!!
буду разбираться. |
#17
|
|||
|
|||
Цитата:
Просьба выслать исходник программы на jaguar-16_rus@list.ru. заранее благодарю |
#18
|
||||
|
||||
я бы вместо массивов использовал класс TList, удобное управление содержимым, да и скорость не особо падает (на глаз в такой программе точно не заметно будет). всегда этим классом пользуюсь и автору темы советую (юнит Classes)
TAleD = class(TUser) public function HelpMe(ASubject, ARequest: String): String; function GiveMeExample(ASubject: String): TStringList; procedure WriteReview(APost: Integer; ADescription: TStringList); end; |
#19
|
||||
|
||||
Код:
Просьба выслать исходник программы на jaguar-16_rus@list.ru. заранее благодарю Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#20
|
|||
|
|||
Цитата:
Последний раз редактировалось jaguar16rus, 27.10.2009 в 23:07. |
#21
|
||||
|
||||
Да зачем вам депозит? Тут http://www.delphisources.ru/forum/sh...3&postcount=17 полный исходняк.
Цитата:
Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#22
|
|||
|
|||
Цитата:
Все, "догнал". Теперь бьюсь над "совершенствованием" данной проги. Пытаюсь реализовать слияние пузырьков при соприкосновении. С центром в точке соприкосновения Последний раз редактировалось jaguar16rus, 28.10.2009 в 08:18. |
#23
|
||||
|
||||
Так там не только слияние, но и увеличение радиуса нового пузыря согласно добавленного объема должно быть, и возможно и ускорение всплытия засчет повышения плавучести, но тут могу и ошибаться.
Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#24
|
||||
|
||||
В общем сам процесс слияния и увеличения радиуса пузыря засчет слияния площадей я вроде сделал, но теперь надо артефакты устранять.
Добавил еще плавный разогрев/остывание плитки. Код:
unit Unit27; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms, ExtCtrls, Buttons, StdCtrls, ComCtrls, Controls; type TBubble = class Size,MaxSize: Integer; Pos: TPoint; constructor Create; procedure PullUp; procedure Paint; procedure Free; end; TForm27 = class(TForm) PaintBox1: TPaintBox; Button1: TButton; BubbleTimer: TTimer; Label1: TLabel; TrackBar1: TTrackBar; HotTimer: TTimer; Label2: TLabel; procedure PaintBox1Paint(Sender: TObject); procedure Button1Click(Sender: TObject); procedure BubbleTimerTimer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure HotTimerTimer(Sender: TObject); private ABubbles: Array of TBubble; HotColor: Byte; end; Const H = 400; W = 400; D = 10; PX = 50; PY = 50; T = 1; R = 25; var Form27: TForm27; implementation {$R *.dfm} procedure TForm27.Button1Click(Sender: TObject); begin if Button1.Caption = 'Выкл.' then begin PaintBox1.Canvas.Brush.Color := clBlack; Button1.Caption := 'Вкл.'; TrackBar1.Position := 20; HotColor := 150; end else begin Button1.Caption := 'Выкл.'; TrackBar1.Position := 100; end; end; procedure TForm27.FormCreate(Sender: TObject); begin SetLength(ABubbles, 0); end; procedure TForm27.HotTimerTimer(Sender: TObject); begin if TrackBar1.SelEnd > TrackBar1.Position then begin TrackBar1.SelEnd := TrackBar1.SelEnd - 1; Dec(HotColor,1); end else begin TrackBar1.SelEnd := TrackBar1.SelEnd + 1; Inc(HotColor,3); end; PaintBox1.Canvas.Brush.Color := RGB(HotColor,0,0); PaintBox1.Canvas.Brush.Style := bsSolid; PaintBox1.Canvas.FillRect(Rect(PX,PY+H+3*D,PX+W+4*D,PY+H+4*D)); if TrackBar1.Position = TrackBar1.SelEnd then HotTimer.Enabled := False; Label2.Caption := IntToStr(TrackBar1.SelEnd)+#$B0; end; procedure TForm27.PaintBox1Paint(Sender: TObject); begin // Кастрюлька PaintBox1.Canvas.Pen.Width := T; PaintBox1.Canvas.Pen.Color := clBlack; PaintBox1.Canvas.MoveTo(PX,PY); PaintBox1.Canvas.LineTo(PX+D,PY+D); PaintBox1.Canvas.LineTo(PX+D,PY+H+D); PaintBox1.Canvas.LineTo(PX+2*D,PY+H+2*D); PaintBox1.Canvas.LineTo(PX+2*D+W,PY+H+2*D); PaintBox1.Canvas.LineTo(PX+3*D+W,PY+H+D); PaintBox1.Canvas.LineTo(PX+3*D+W,PY+D); PaintBox1.Canvas.LineTo(PX+4*D+W,PY); PaintBox1.Canvas.LineTo(PX+3*D+W,PY); PaintBox1.Canvas.LineTo(PX+2*D+W,PY+D); PaintBox1.Canvas.LineTo(PX+2*D+W,PY+H+D); PaintBox1.Canvas.LineTo(PX+2*D,PY+H+D); PaintBox1.Canvas.LineTo(PX+2*D,PY+D); PaintBox1.Canvas.LineTo(PX+D,PY); PaintBox1.Canvas.LineTo(PX,PY); PaintBox1.Canvas.Brush.Style := bsBDiagonal; PaintBox1.Canvas.Brush.Color := clRed; PaintBox1.Canvas.FloodFill(PX+D+T+1,PY+D,clBlack,fsBorder); // Жидкость PaintBox1.Canvas.Brush.Style := bsSolid; PaintBox1.Canvas.Brush.Color := clAqua; PaintBox1.Canvas.FillRect(Rect(PX+2*D+T,PY+3*D-T,PX+W+2*D,PY+H+D)); // Плитка PaintBox1.Canvas.Brush.Style := bsSolid; PaintBox1.Canvas.Brush.Color := clBlack; PaintBox1.Canvas.FillRect(Rect(PX,PY+H+3*D,PX+W+4*D,PY+H+4*D)); end; procedure TForm27.TrackBar1Change(Sender: TObject); begin HotTimer.Enabled := True; end; procedure TForm27.BubbleTimerTimer(Sender: TObject); Var i,j,n,m: Integer; B0,B1,B2: TRect; begin Randomize; for i := 0 to Length(ABubbles)-1 do ABubbles[i].PullUp; if TrackBar1.SelEnd > 40 then case Random(TrackBar1.Max - TrackBar1.SelEnd) of 0: begin SetLength(ABubbles, Length(ABubbles)+1); ABubbles[High(ABubbles)] := TBubble.Create; ABubbles[High(ABubbles)].Pos := Point(PX+2*D+Random(W-R),PY+H+D); ABubbles[High(ABubbles)].Paint; end; end; i := 0; while i <= Length(ABubbles)-1 do begin if ABubbles[i].Pos.Y < PX+2*D+T+R then begin ABubbles[i].Free; for n := i+1 to Length(ABubbles)-1 do ABubbles[n-1] := ABubbles[n]; SetLength(ABubbles,Length(ABubbles)-1); end; n := 0; while n <= Length(ABubbles)-2 do begin with ABubbles[n] do B1 := Rect(Pos.X-1,Pos.Y-Size-1,Pos.X+Size+1,Pos.Y+1); m := n+1; while m <= Length(ABubbles)-1 do begin with ABubbles[m] do B2 := Rect(Pos.X-1,Pos.Y-Size-1,Pos.X+Size+1,Pos.Y+1); if IntersectRect(B0,B1,B2) then begin if ABubbles[n].Size >= ABubbles[m].Size then begin ABubbles[m].Free; for j := m+1 to Length(ABubbles)-1 do ABubbles[j-1] := ABubbles[j]; SetLength(ABubbles,Length(ABubbles)-1); ABubbles[n].MaxSize := Round(Sqrt((Pi*Sqr(ABubbles[n].Size)+Pi*Sqr(ABubbles[m].Size))/Pi)); end else begin ABubbles[n].Free; for j := n+1 to Length(ABubbles)-1 do ABubbles[j-1] := ABubbles[j]; SetLength(ABubbles,Length(ABubbles)-1); ABubbles[m].MaxSize := Round(Sqrt((Pi*Sqr(ABubbles[n].Size)+Pi*Sqr(ABubbles[m].Size))/Pi)); end; end; Inc(m); end; Inc(n); end; Inc(i); end; Label1.Caption := Format('Напузыряли: %d',[Length(ABubbles)]); end; constructor TBubble.Create; begin Size := 0; MaxSize := R; inherited; end; procedure TBubble.Free; begin Paint; inherited; end; procedure TBubble.Paint; begin Form27.PaintBox1.Canvas.Pen.Width := 1; Form27.PaintBox1.Canvas.Pen.Mode := pmXor; Form27.PaintBox1.Canvas.Pen.Color := clRed; Form27.PaintBox1.Canvas.Brush.Style := bsClear; Form27.PaintBox1.Canvas.Ellipse(Pos.X,Pos.Y-Size,Pos.X+Size,Pos.Y); end; procedure TBubble.PullUp; begin Paint; Dec(Pos.Y,2); if Size < MaxSize then Inc(Size); if Size < MaxSize then Inc(Size); Paint; end; end. Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. Последний раз редактировалось Страдалецъ, 29.10.2009 в 21:01. |